source: tol/tolbase/lib/toltk/bystext.tcl @ 0e07e12

1941-docker-image-to-testdevel
Last change on this file since 0e07e12 was 0e07e12, checked in by Jorge Pérez <josp.jorge@…>, 15 years ago

fixes #1432, se implementa una opcion de menu contextual "Escape text" que abre una ventana de dialogo para realizar el escape del texto deseado. Si en el momento de seleccionar esta opción de menú hay un texto seleccionado este se utiliza como texto inicial a escapar. La ventana ofrece un botón para sustituir el texto seleccionado por el texto escapado.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4145 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 35.4 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bystext.tol
3# PURPOSE :
4#/////////////////////////////////////////////////////////////////////////////
5
6#/////////////////////////////////////////////////////////////////////////////
7# TESTING
8#/////////////////////////////////////////////////////////////////////////////
9# Put if {1} for testing this file.
10
11package require snit
12
13if {0} {
14  package require Tk
15  package require BWidget
16  set toltk_script_path [file dirname [info script]]
17  package require msgcat
18  namespace import ::msgcat::*
19  ::msgcat::mclocale es
20  ::msgcat::mcload [file join $toltk_script_path msgs]
21 
22}
23
24::snit::widgetadaptor rotext {
25
26  constructor {args} {
27    # Turn off the insert cursor
28    #installhull using text $self -insertwidth 0
29    # DDG the $self gaves an error at least with 0.97 onwards
30    installhull using text -insertwidth 0
31   
32    # Apply an options passed at creation time.
33    $self configurelist $args
34  }
35 
36  # Disable the insert and delete methods, to make this readonly.
37  method insert {args} {}
38  method delete {args} {}
39 
40  # Enable ins and del as synonyms, so the program can insert and
41  # delete.
42  delegate method ins to hull as insert
43  delegate method del to hull as delete
44 
45  # Pass all other methods and options to the real text widget, so
46  # that the remaining behavior is as expected.
47  delegate method * to hull
48  delegate option * to hull
49}
50
51#/////////////////////////////////////////////////////////////////////////////
52# NAMESPACE
53#/////////////////////////////////////////////////////////////////////////////
54
55namespace eval ::BayesText {
56  variable options
57}
58
59
60#/////////////////////////////////////////////////////////////////////////////
61# PROCEDURES
62#/////////////////////////////////////////////////////////////////////////////
63
64#/////////////////////////////////////////////////////////////////////////////
65   proc ::BayesText::FindShow {editor {next 0} {txt ""} {regexp 0}} {
66
67#
68# PURPOSE: This proc mades bla, bla, bla,
69#          and bla, bla, bla, ...
70#
71# ALGORITHM:
72#   Xxx xxxx xx:
73#     Xxxxx xxx xxx.
74#     Xxxxx xxx xxx.
75#   Xxxxx.
76#
77# PARAMETERS:
78#   editor -> text widget where text has to be found
79#   next   ->
80#   txt    ->
81#
82# RETURN:
83#
84#/////////////////////////////////////////////////////////////////////////////
85  variable options
86 
87  ::BayesText::ReadIni
88 
89  set Instance ::BayesText::Find$editor
90  if { [lsearch [namespace children ::BayesText] $Instance] != -1 } {
91     
92  } else  {
93    namespace eval $Instance {
94      variable data
95     
96      #data(find,text) --> texto a buscar
97      #data(find,dir)  --> dirección de búsqueda
98      #data(start)     --> indica desde donde se empieza a buscar
99      #data(find,case) -->
100      #data(editor)    --> el path del widget text en el q buscar
101      #data(path)      --> el path del toplevel que muestra el cuado de búsqueda
102      #data(frm,cad)   --> entry donde se inserta el texto a buscar
103    }
104  }
105  upvar \#0 ${Instance}::data data
106
107  # exists data(find,temp) ?
108  if {!([info exists data(find,temp)])} {
109    set data(find,temp) ""
110  }
111 
112  set data(editor) $editor
113  set data(path)   ${editor}.tFind
114  if [winfo exist $data(path)] {
115    raise $data(path)
116    focus $data(frm,cad)
117  # $data(frm,cad) selection range 0 end
118    $data(frm,cad).e selection range 0 end
119    return
120  }
121 
122  # inizialization values
123  set data(find,dir)    $options(find,dir)
124  set data(find,case)   $options(find,case) 
125  set data(find,regexp) $regexp
126  # text find ?
127  if {[string length $txt]} {
128    set data(find,text) $txt
129  } else {
130    set idxs [$editor tag ranges sel]
131   
132    # next find ?
133    if { $next eq 1 } {
134      set data(find,text) $data(find,temp)
135    } else {
136      # text selected ?
137      if {!(([llength [lindex $idxs 0]] eq 0) && \
138            ([llength [lindex $idxs 1]] eq 0))} {
139        set txt [$editor get [lindex $idxs 0] [lindex $idxs 1]]
140        if {!($txt eq "")} {
141          set txt [lindex [split $txt "\n"] 0]
142          set data(find,text) $txt
143        }
144      }
145    }
146  }
147  # type of find ?
148  if {$next && [info exists ${Instance}::data(find,text)] && ($data(find,text) !="") } {
149    FindNext $Instance
150  } else {
151    FindCreate $Instance
152  }
153  # save teh last search
154  set data(find,temp) $data(find,text)
155}
156
157
158#/////////////////////////////////////////////////////////////////////////////
159proc ::BayesText::SearchShow {instance } {
160#
161# PURPOSE: Shows the form of function search with the first word selected
162#
163# PARAMETERS:
164#   editor -> text widget where text has to be found
165#
166#
167#/////////////////////////////////////////////////////////////////////////////
168  # show find dialog
169  set dialog [::funcSearch::Show]
170  # function find ?
171  set idxs [$instance tag ranges sel]
172  if {!(([llength [lindex $idxs 0]] eq 0) && \
173        ([llength [lindex $idxs 1]] eq 0))} {     
174    set txt [$instance get [lindex $idxs 0] [lindex $idxs 1]]
175    if {!($txt eq "")} {
176      set txt [lindex [split $txt " "] 0]   
177      ::funcSearch::SearchWord $txt
178    }
179  }   
180} 
181
182
183#/////////////////////////////////////////////////////////////////////////////   
184proc ::BayesText::FindPosText { Instance } {
185#
186# PURPOSE: find the next position of text
187#
188#/////////////////////////////////////////////////////////////////////////////     
189  upvar \#0 ${Instance}::data data
190  set start [$data(editor) index insert]
191  if [string equal $data(find,dir) "forward"] {
192    set end [$data(editor) index end]
193  } else {
194    set end "1.0"
195  }
196  set ::_len 0
197  if $data(find,case) {
198    if {[info exist data(find,regexp)] && $data(find,regexp)} {
199      set pos [$data(editor) search -regexp -count ::_len -$data(find,dir) --\
200              $data(find,text) $start $end]
201    } else {
202      set pos [$data(editor) search -count ::_len -$data(find,dir) --\
203              $data(find,text) $start $end]
204    }
205  } else  {
206    set pos [$data(editor) search -count ::_len -nocase -$data(find,dir) --\
207            $data(find,text) $start $end]
208  }
209  #Tolcon_Trace "Devuelvo pos=$pos, len=$::_len"
210  return [list $pos $::_len]
211}
212
213
214#/////////////////////////////////////////////////////////////////////////////
215proc ::BayesText::FindNext { Instance } {
216#
217# PURPOSE: Make the next find in editor
218#
219#///////////////////////////////////////////////////////////////////////////// 
220  upvar \#0 ${Instance}::data data
221  #  Coger la posición actual del cursor en el text y buscar desde ahí,
222  set posOrig [$data(editor) index insert]
223 
224  set res [FindPosText $Instance]
225  set pos [lindex $res 0]
226  set len [lindex $res 1]
227  # comprobamos si ha encontrado algo
228  if { $pos != "" } {
229    if [string equal $data(find,dir) "forward"] {
230        set start "$pos + $len char"
231    } elseif [string equal $data(find,dir) "backward"] {
232        set start "$pos - $len char"
233    }
234    tk::TextSetCursor $data(editor) $start
235    $data(editor) see $pos
236    # Intamos un tag found ya que sel parece no funcionar correctamente en
237    # windows cuando el text pierde el foco
238    $data(editor) tag delete found
239    set fore [$data(editor) tag cget sel -foreground]
240    set back [$data(editor) tag cget sel -background]
241    set bord [$data(editor) tag cget sel -borderwidth]
242    $data(editor) tag configure found -foreground $fore -background $back -borderwidth $bord
243    $data(editor) tag add sel $pos "$pos + $len char"
244    $data(editor) tag add found $pos "$pos + $len char"
245  } else {
246    tk::TextSetCursor $data(editor) $posOrig
247    $data(editor) tag delete sel
248    $data(editor) tag delete found
249    if [string equal $data(find,dir) "forward"] {
250      set msg "[mc SearchUpEndDoc].\n[mc FindFromBegin]"
251    } else {
252      set msg "[mc SearchUpBeginDoc].\n[mc FindFromEnd]"
253    }
254    if [winfo exists $data(path)] {
255      set parent $data(path)
256    } else  {
257      set parent $data(editor)
258    }
259    set rq [tk_messageBox -type okcancel -icon info -parent $parent\
260            -title [mc "Editor"] -message $msg]
261    if {$rq == "ok"} {
262      if [string equal $data(find,dir) "forward"] {
263        tk::TextSetCursor $data(editor) "1.0"
264      } else {
265        tk::TextSetCursor $data(editor) [$data(editor) index end]
266      }
267      FindNext $Instance
268    }
269  }
270  # Debo quedarme yo con el foco, no el editor
271
272  #focus $data(editor)
273}
274
275#/////////////////////////////////////////////////////////////////////////////
276   proc ::BayesText::FindCreate {Instance } {
277#
278# PURPOSE: Creates a Find Dialog given a Instance
279#
280#/////////////////////////////////////////////////////////////////////////////
281  upvar \#0 ${Instance}::data data
282
283  set dialog [Dialog $data(path) -title [mc "Find"]\
284          -default 0 -modal none -parent $data(editor)]
285  wm protocol $dialog WM_DELETE_WINDOW \
286    [list ::BayesText::FindDestroy $Instance $dialog] 
287  set w [$dialog getframe]
288  wm resizable $data(path) 0 0
289 
290  set data(frm,cad) [LabelEntry  $w.eTxt -label "[mc "Find"]: " \
291          -textvariable ${Instance}::data(find,text)]
292  checkbutton $w.case  -text [mc "Case sensitive"] \
293          -variable ${Instance}::data(find,case) -pady 0
294  TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"]
295  set f [$w.dir getframe]
296  radiobutton $f.forward -text [mc "Forward"] -value forward \
297          -variable ${Instance}::data(find,dir)\
298          -highlightthickness 0 -pady 0
299  radiobutton $f.backward -text [mc "Backward"] -value backward \
300          -variable ${Instance}::data(find,dir)\
301          -highlightthickness 0 -pady 0
302  Button $w.findNext -text [mc "Find next"] -width 16 \
303          -command [list ::BayesText::FindNext $Instance] \
304          -helptext [mc "Find next"]
305  Button $w.cancelar -text [mc "Cancel"] -width 16 -helptext "" \
306    -command [list ::BayesText::FindDestroy $Instance $dialog]
307 
308  bind $dialog <Return> [list ::BayesText::FindNext $Instance]
309  bind $dialog <F3>     [list ::BayesText::FindNext $Instance]
310  bind $dialog <Escape> [list ::BayesText::FindDestroy $Instance $dialog]
311
312  # Hemos añadido un tag para la selección, hay que quitarle como el tag sel
313  bind $data(editor) <ButtonPress> +[list $data(editor) tag delete found]
314 
315  grid $f.forward  $f.backward -sticky nw
316 
317  grid $w.eTxt  -       $w.findNext -sticky news -padx 5 -pady 2
318  grid $w.case  $w.dir  $w.cancelar -sticky new  -padx 5
319 
320  grid columnconfigure $w  0 -weight 1
321  grid columnconfigure $w  1 -weight 0
322  grid rowconfigure    $w  0 -weight 0
323  grid rowconfigure    $w  1 -weight 0
324  grid rowconfigure    $w  2 -weight 0
325  grid rowconfigure    $w 10 -weight 1
326 
327  wm geometry $dialog 360x90
328  $dialog draw
329  update
330  focus $data(frm,cad)
331  $data(frm,cad).e selection range 0 end
332}
333
334
335#/////////////////////////////////////////////////////////////////////////////
336proc ::BayesText::FindDestroy {Instance dialog} {
337#
338# PURPOSE: Replace text in editor
339#
340#/////////////////////////////////////////////////////////////////////////////
341  variable options
342
343  upvar \#0 ${Instance}::data data
344  # inizialization values
345  set options(find,dir)  $data(find,dir)
346  set options(find,case) $data(find,case)
347  ::BayesText::WriteIni
348  # destroy
349  destroy $dialog
350}   
351
352
353#/////////////////////////////////////////////////////////////////////////////
354proc ::BayesText::ReplaceShow {editor {next 0}} {
355#
356# PURPOSE: Replace text in editor
357#
358#///////////////////////////////////////////////////////////////////////////// 
359  variable options
360 
361  ::BayesText::ReadIni
362 
363  set Instance ::BayesText::Replace$editor
364  if { [lsearch [namespace children ::BayesText] $Instance] != -1 } {
365     
366  } else  {
367    namespace eval $Instance {
368      variable data
369      #data(find,text)    --> texto a buscar
370      #data(replace,text) --> texto a por el que remplazar
371      #data(replace,dir)  --> dirección de búsqueda
372      #data(replace,case) -->
373      #data(editor)       --> el path del widget text en el q buscar
374      #data(path)         --> el path del toplevel que muestra el cuado de búsqueda
375      #data(frm,cad)      --> entry donde se inserta el texto a buscar
376    }
377  }
378 
379  upvar \#0 ${Instance}::data data
380
381  # inizialization values
382  #set data(replace,dir)    $options(replace,dir)
383  set data(find,dir)       $options(replace,dir)
384  #set data(replace,case)   $options(replace,case)
385  set data(find,case) $options(replace,case)
386 
387  set data(editor) $editor
388  set data(path)   ${editor}.tReplace
389  if [winfo exist $data(path)] {
390    raise $data(path)
391    focus $data(frm,cad)
392    return
393  }
394  if {$next && [info exists ${Instance}::data(find,text)] && \
395     [info exists ${Instance}::data(replace,text)] && ($data(find,text) !="") } {
396    ReplaceNext $Instance
397  } else {
398    ReplaceCreate $Instance
399  }
400}
401
402
403#/////////////////////////////////////////////////////////////////////////////
404proc ::BayesText::ReplaceCreate { Instance } {
405#
406# PURPOSE: Creates a Replace Dialog given a Instance
407#
408#/////////////////////////////////////////////////////////////////////////////   
409  upvar \#0 ${Instance}::data data
410  # opciones de remplazado
411
412  set dialog [Dialog $data(path) -title [mc "Replace"]\
413          -default 0 -modal none -parent $data(editor)]
414  wm protocol $dialog WM_DELETE_WINDOW \
415    [list ::BayesText::ReplaceDestroy $Instance $dialog]   
416 
417  set w [$dialog getframe]
418  wm resizable $data(path) 0 0
419 
420  set data(replace,cad) [LabelEntry  $w.eTxt -width 35 \
421          -label "[mc "Find"]: " -labelwidth 15 \
422          -textvariable ${Instance}::data(find,text)]
423  set data(replace,rem) [LabelEntry  $w.eRem -width 35 -labelwidth 15 \
424          -label "[mc "Replace with"]: " \
425          -textvariable ${Instance}::data(replace,text)]
426  checkbutton $w.case  -text [mc "Case sensitive"] \
427          -variable ${Instance}::data(replace,case) -pady 0
428  Button $w.findNext -text [mc "Find next"] -width 16 \
429          -command [list ::BayesText::FindNext $Instance] \
430          -helptext [mc "Find next"]
431  Button $w.replaceNext -text [mc "Replace"] -width 16 \
432          -command [list ::BayesText::ReplaceNext $Instance] \
433          -helptext [mc "Replace next"]
434  Button $w.replaceAll -text [mc "Replace all"] -width 16 \
435          -command [list ::BayesText::ReplaceAll $Instance] \
436          -helptext [mc "Replace all"]
437  Button $w.cancelar -text [mc "Cancel"] -width 16 -helptext "" \
438    -command [list ::BayesText::ReplaceDestroy $Instance $dialog]
439 
440  bind $dialog <Return> [list ::BayesText::FindNext $Instance]
441  bind $dialog <Escape> [list ::BayesText::ReplaceDestroy $Instance $dialog]
442 
443  grid $w.eTxt   $w.findNext     -sticky nw -padx 5 -pady 2
444  grid $w.eRem   $w.replaceNext  -sticky nw -padx 5 -pady 2
445  grid $w.case   $w.replaceAll   -sticky nw -padx 5 -pady 2
446  grid ^         $w.cancelar     -sticky nw -padx 5 -pady 2
447 
448  wm geometry $dialog 360x90
449  $dialog draw
450  update
451  focus $data(replace,cad)
452}
453
454
455#/////////////////////////////////////////////////////////////////////////////
456proc ::BayesText::ReplaceDestroy {Instance dialog} {
457#
458# PURPOSE: Replace text in editor
459#
460#/////////////////////////////////////////////////////////////////////////////
461  variable options
462
463  upvar \#0 ${Instance}::data data
464  # inizialization values
465  #set options(replace,dir)  $data(replace,dir)
466  #set options(replace,case) $data(replace,case)
467  set options(replace,dir)  $data(find,dir)
468  set options(replace,case) $data(find,case)
469  ::BayesText::WriteIni 
470  # destroy
471  destroy $dialog
472}   
473
474#/////////////////////////////////////////////////////////////////////////////
475proc ::BayesText::ReplaceNext { Instance } {
476#
477# PURPOSE: Replace next ocurrence
478#
479#/////////////////////////////////////////////////////////////////////////////   
480  upvar \#0 ${Instance}::data data
481  # comprobamos que este lleno entry de buscar
482  if {$data(find,text) != ""} {
483    if {[catch "$data(editor) index sel.first" pos] == 0} {
484      set lon    [string length $data(find,text)]
485      set lonRem [string length $data(replace,text)]
486      set posFin "$pos + $lon char"
487      # reemplazamos caracteres seleccionados
488      $data(editor) delete $pos $posFin
489      $data(editor) insert $pos $data(replace,text)
490      #tk::TextSetCursor $data(editor) $pos
491      #tk::TextSetCursor $data(editor) $posFin
492    }
493  }
494  FindNext $Instance
495}
496
497
498#/////////////////////////////////////////////////////////////////////////////
499proc ::BayesText::ReplaceAll { Instance } {
500#
501# PURPOSE: Replace all
502#
503#/////////////////////////////////////////////////////////////////////////////   
504  upvar \#0 ${Instance}::data data
505  # guardamos la posición actual
506  set posOrig [$data(editor) index insert]
507  # nos posicionamos en el principio del texto
508  tk::TextSetCursor $data(editor) "1.0"
509  # mientras posicion actual menor que fin repetimos busqueda
510  set lon    [string length $data(find,text)]
511  set lonRem [string length $data(replace,text)]
512  set res    [FindPosText $Instance]
513  set pos    [lindex $res 0]
514  set lon    [lindex $res 1]
515  set posFin "$pos + $lon char"
516  while {[string length $pos]} {
517    # reemplazamos caracteres seleccionados
518    $data(editor) delete $pos $posFin
519    $data(editor) insert $pos $data(replace,text)
520    tk::TextSetCursor $data(editor) "$pos + $lonRem char"
521    set res [FindPosText $Instance]
522    set pos [lindex $res 0]
523    set lon [lindex $res 1]
524    set posFin "$pos + $lon char"
525  }
526  # recuperamos posicion, si es mayor que fin, ponemos fin
527  set end [$data(editor) index end]
528  if {[$data(editor) compare $posOrig > $end]} {
529    tk::TextSetCursor $data(editor) $end
530  } else  {
531    tk::TextSetCursor $data(editor) $posOrig
532  }
533}
534
535
536#/////////////////////////////////////////////////////////////////////////////
537proc ::BayesText::Open {editor path {pos 1.0}} {
538#
539# PURPOSE:
540#
541#/////////////////////////////////////////////////////////////////////////////   
542  if { ![catch {set fd [open $path r] } msgerr] } {
543    $editor insert $pos [read -nonewline $fd]
544    close $fd
545    $editor mark set insert 1.0
546    return 1
547  }
548  error $msgerr
549}
550
551
552#/////////////////////////////////////////////////////////////////////////////
553proc ::BayesText::SaveTxt {texto path} {
554#
555# PURPOSE: Save text editor
556#
557#/////////////////////////////////////////////////////////////////////////////   
558  if { ![ catch { set fd [open $path w] } msgerr] } {
559    puts -nonewline $fd $texto
560    close $fd
561    return 1
562  }
563  error $msgerr
564}
565
566
567#/////////////////////////////////////////////////////////////////////////////
568proc ::BayesText::Save {editor path} {
569#
570# PURPOSE: Save
571#
572#/////////////////////////////////////////////////////////////////////////////   
573  set texto [$editor get 1.0 end]
574  SaveTxt $texto $path
575}
576
577
578#/////////////////////////////////////////////////////////////////////////////
579proc ::BayesText::Cut {editor} {
580#
581# PURPOSE: Cut text
582#
583#/////////////////////////////////////////////////////////////////////////////   
584  #clipboard clear
585  tk_textCut $editor
586}
587
588
589#/////////////////////////////////////////////////////////////////////////////
590proc ::BayesText::Copy {editor} {
591#
592# PURPOSE: Copy text
593#
594#/////////////////////////////////////////////////////////////////////////////   
595  #clipboard clear
596  tk_textCopy $editor
597}
598
599
600#/////////////////////////////////////////////////////////////////////////////
601proc ::BayesText::Paste {editor} {
602#
603# PURPOSE: Paste text
604#
605#/////////////////////////////////////////////////////////////////////////////   
606  # a partir de la version 8.4
607  tk_textPaste $editor
608  #catch {$editor insert insert [selection get -selection CLIPBOARD]}
609}
610
611
612#/////////////////////////////////////////////////////////////////////////////
613proc ::BayesText::SelectAll {editor} {
614#
615# PURPOSE: Select all text
616#
617#/////////////////////////////////////////////////////////////////////////////   
618  $editor tag add sel 1.0 end
619}
620
621
622#/////////////////////////////////////////////////////////////////////////////
623proc ::BayesText::Delete {editor} {
624#
625# PURPOSE: Delete text selected
626#
627#/////////////////////////////////////////////////////////////////////////////   
628  set state [$editor cget -state]
629  $editor configure -state normal
630 
631  if ![catch {set ini [$editor index sel.first]}] {
632    set fin [$editor index sel.last]
633    $editor delete $ini $fin
634  }
635  $editor configure -state $state
636}
637
638
639#/////////////////////////////////////////////////////////////////////////////
640proc ::BayesText::DeleteAll {editor} {
641#
642# PURPOSE: Delete all
643#
644#/////////////////////////////////////////////////////////////////////////////   
645  set state [$editor cget -state]
646  $editor configure -state normal
647  $editor delete 1.0 end
648  $editor configure -state $state
649}
650
651#/////////////////////////////////////////////////////////////////////////////
652proc ::BayesText::Refresh {editor} {
653#
654# PURPOSE: Refresh highlight
655#
656# PARAMETERS:
657#  editor -> text widget to refresh highlight
658#
659#/////////////////////////////////////////////////////////////////////////////
660  $editor highlight 1.0 end
661}
662
663
664#/////////////////////////////////////////////////////////////////////////////
665proc ::BayesText::Indent {editor chars} {
666#
667# PURPOSE: Indent text
668#
669#/////////////////////////////////////////////////////////////////////////////   
670  if ![catch {set ini [$editor index sel.first]}] {
671    set fin [$editor index sel.last]
672    set lineIni [lindex [split $ini .] 0]
673    set lineFin [lindex [split $fin .] 0]
674     
675    for {set i $lineIni} {$i<= $lineFin} {incr i} {
676      $editor insert $i.0 [string repeat " " $chars]
677    }
678    $editor tag add sel $ini $fin
679  } else {
680    $editor insert {insert linestart} [string repeat " " $chars]
681  }
682}
683
684
685#/////////////////////////////////////////////////////////////////////////////
686proc ::BayesText::UnIndent {editor chars} {
687#
688# PURPOSE: UnIndent text
689#
690#/////////////////////////////////////////////////////////////////////////////   
691  if ![catch {set ini [$editor index sel.first]}] {
692    set fin [$editor index sel.last]
693    set lineIni [lindex [split $ini .] 0]
694    set lineFin [lindex [split $fin .] 0]
695   
696    for {set i $lineIni} {$i<= $lineFin} {incr i} {
697      if [string equal [$editor get $i.0 $i.$chars] [string repeat " " $chars]] {
698        $editor delete $i.0 $i.$chars
699      }
700    }
701    $editor tag add sel $ini $fin
702  } else {
703    if [string equal [$editor get {insert linestart} "insert linestart + $chars c"]\
704       [string repeat " " $chars]] {
705      $editor delete {insert linestart} "insert linestart + $chars c"
706    }
707  }
708}
709
710
711#/////////////////////////////////////////////////////////////////////////////
712proc ::BayesText::GetSelectionOrAll {w} {
713#
714# PURPOSE: Returns selected text in text widget w (or all text if nothing
715#          is selected)
716#
717# PARAMETERS:
718#  w -> text widget to refresh highlight
719#
720#/////////////////////////////////////////////////////////////////////////////
721  set idxs [$w tag ranges sel]
722  if [llength $idxs] {
723    set txt [$w get [lindex $idxs 0] [lindex $idxs 1]]
724  } else {
725    set txt [$w get 0.0 end]
726  }
727  return $txt
728}
729
730
731#/////////////////////////////////////////////////////////////////////////////   
732proc ::BayesText::FontChange {editor} {
733#
734# PURPOSE: Change font text
735#
736#/////////////////////////////////////////////////////////////////////////////     
737  set fnt [SelectFont .sf -title [mc "Select font"] \
738          -parent $editor -font [$editor cget -font]\
739          -sampletext "Bayes Forecast"]
740  if {($fnt != "") && ($editor != "")} {
741    $editor configure -font $fnt
742  }
743  return $fnt
744}
745
746
747#/////////////////////////////////////////////////////////////////////////////   
748proc ::BayesText::MenuCreate {editor} {
749#
750# PURPOSE: Create menu
751#
752#/////////////////////////////////////////////////////////////////////////////     
753  set m [menu $editor.m -tearoff 0 ]
754  set state [$editor cget -state]
755  $m add command -label "[mc Find]..." -accelerator CTRL+F \
756          -command [list ::BayesText::FindShow $editor]
757  $m add command -label "[mc Replace]..." -accelerator CTRL+R -state $state\
758          -command [list ::BayesText::ReplaceShow $editor]
759  $m add command -label [mc "Find next"] -accelerator F3 \
760          -command [list ::BayesText::FindShow $editor 1]
761  $m add command -label [mc "Search function"] -accelerator CTRL+G \
762          -command [list ::BayesText::SearchShow $editor]   
763  $m add separator
764  $m add command -label [mc "Cut"] -accelerator CTRL+X -state $state\
765          -command [list ::BayesText::Cut $editor]
766  $m add command -label [mc "Copy"] -accelerator CTRL+C \
767          -command [list ::BayesText::Copy $editor]
768  $m add command -label [mc "Paste"] -accelerator CTRL+V -state $state \
769          -command [list ::BayesText::Paste $editor]
770  $m add separator
771  $m add command -label [mc "Select all"] -accelerator CTRL+E \
772          -command [list ::BayesText::SelectAll $editor]
773  $m add command -label [mc "Delete"] -accelerator SUPR -state $state\
774          -command [list ::BayesText::Delete $editor]
775  $m add command -label "[mc Font]..." -accelerator CTRL+T \
776          -command [list ::BayesText::FontChange $editor]
777 
778  bind $editor <F3>        [list ::BayesText::FindShow $editor 1]
779  if {[string equal $state "normal"]} {
780    #bind $editor <Delete>    [list ::BayesText::Delete $editor]
781  }
782 
783  bind $editor <Control-KeyRelease> \
784    [list ::BayesText::OnControlKey $editor %K %k]
785 
786  #Por si el text esta desabilitado (para poder seleccionar)
787  bind $editor <Button-1> {focus %W}
788  bind $editor <Button-3> "tk_popup $m %X %Y"
789  #Retornar el menu por si el que lo llama quiere añadir opciones
790  return $m
791}
792
793
794#/////////////////////////////////////////////////////////////////////////////   
795proc ::BayesText::OnControlKey {editor keysym keycode} {
796#
797# PURPOSE: Call of bind associate of letter
798#
799#/////////////////////////////////////////////////////////////////////////////     
800  set state [$editor cget -state]
801  switch [string toupper $keysym] {
802    E { SelectAll $editor}
803    F { FindShow $editor}
804    R { if [string equal $state "normal"] { ReplaceShow $editor }  }
805    T { FontChange $editor}
806    C { if { [string equal $::tcl_platform(platform) "unix"] ||
807             [string equal $keysym "C"] } {
808          Copy $editor
809      }
810    }
811    V { if { ([string equal $::tcl_platform(platform) "unix"] &&
812              [string equal $state "normal"]) ||
813              [string equal $keysym "V"]} {
814          Paste $editor
815      }
816    }
817    X { if { [string equal $keysym "X"] } {
818          Cut $editor
819      }
820    }
821  }
822}
823
824proc ::BayesText::TolEscape { buffer } {
825  return [ string map [ list \n \\n \t \\t \" \\\" \\ \\\\ ] $buffer ]
826}
827
828proc ::BayesText::DlgEscapeTextApply { editor } {
829  set w .dlgescape
830
831  set idxs [ $editor tag ranges sel ]
832  if { [ llength $idxs ] } {
833    foreach {i0 i1} $idxs break
834    $editor configure -undo 0
835    $editor delete $i0 $i1
836    $editor configure -undo 1
837    set f [ $w getframe ]
838    set buffer [ $f.t get 1.0 "end -1 char" ]
839    set len [ string length $buffer ]
840    $editor insert $i0 $buffer
841    $editor tag add sel $i0 "$i0 + $len char"
842  }
843}
844
845proc ::BayesText::DlgEscapeText { editor } {
846  set w .dlgescape
847  if { [ winfo exists $w ] } {
848    set f [ $w getframe ]
849    raise $w
850    focus $f.o
851  } else {
852    Dialog $w -title [ mc "Escape text" ] \
853        -default 2 -modal none -parent $editor -separator 1
854    $w add -text [ mc "Close" ] -command "destroy $w"
855    $w add -text [ mc "Apply" ]
856    set f [ $w getframe ]
857    label $f.lo -text [ mc "Original:" ]
858    text $f.o -width 40 -height 4
859    label $f.lt -text [ mc "Transformed:" ]
860    rotext $f.t -width 40 -height 4
861    bind $f.o <<Modified>> {
862      if { [ %W edit modified ] == 1 } {
863        set f [ winfo parent %W ]
864        set tt $f.t
865        set buffer [ %W get 1.0 "end -1 char" ]
866        $tt del 1.0 end
867        $tt ins end [ ::BayesText::TolEscape $buffer ]
868        %W edit modified 0
869      }
870    }
871    grid $f.lo -row 0 -column 0 -sticky w
872    grid $f.o -row 1 -column 0 -sticky snew
873    grid $f.lt -row 0 -column 1 -sticky w
874    grid $f.t -row 1 -column 1 -sticky snew
875    foreach c {0 1} {
876      grid columnconfigure $f $c -weight 1
877    }
878    grid rowconfigure $f 1 -weight 1
879    $w draw
880  }
881  $f.o delete 1.0 end
882  set idxs [ $editor tag ranges sel ]
883  if { [ llength $idxs ] } {
884    $f.o insert end [ $editor get [ lindex $idxs 0 ] [ lindex $idxs 1 ] ]
885  }
886  $w itemconfigure 1 -command [ list ::BayesText::DlgEscapeTextApply $editor ]
887}
888
889#/////////////////////////////////////////////////////////////////////////////
890proc ::BayesText::TolSyntaxCheck { editor {dir ""} } {
891#/////////////////////////////////////////////////////////////////////////////
892  global toltk_script_path
893
894  set buffer [ GetSelectionOrAll $editor ]
895  if { $dir ne "" } {
896    set cwd [ pwd ]
897    cd $dir
898  }
899
900  if { [ catch { tol::checksyntax $buffer } check ] } {
901    Tolcon_Trace "within ::BayesText::TolSyntaxCheck($editor,$dir): $check"
902    return 0
903  }
904  set check [ string trim $check ]
905  if { $check eq "" } {
906    tk_messageBox -type ok -icon info -title [mc "Syntax Check"] \
907        -parent $editor -message [mc "Syntax check done successfully"]
908  } else {
909    ShowSyntaxErrors $editor $check
910  }
911  return 1
912}
913
914
915#/////////////////////////////////////////////////////////////////////////////
916  proc ::BayesText::ShowSyntaxErrors {parent error} {
917#
918# PURPOSE: Shows syntax errors in a dialog window with a monospaced font
919#
920# PARAMETERS:
921#   parent -> path of dialog parent
922#   error  -> Syntax error to display
923#
924#/////////////////////////////////////////////////////////////////////////////
925  global toltk_options
926
927  set title "[mc "Syntax Check"]. [mc {Syntax errors in file}]"
928  set dialog [Dialog $parent.dsc -title $title -modal local -parent $parent]
929  set w [$dialog getframe]
930 
931  bind $dialog <Escape> [list destroy $dialog] 
932
933  ScrolledWindow $w.sw
934  text $w.sw.t -font $toltk_options(fonts,Fixed) -state normal
935  $w.sw.t insert end $error
936  $w.sw.t configure -state disabled
937  $w.sw setwidget $w.sw.t
938 
939  set w_bbox \
940    [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
941     -homogeneous false]
942  $w_bbox add -text [mc "Accept"] -relief link \
943          -helptext [mc "OK"] \
944          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
945           -command "destroy $dialog"
946   
947  pack $w_bbox -fill x -expand false -side bottom
948  pack $w.sw -fill both -expand yes
949 
950  $dialog draw
951}
952
953
954#/////////////////////////////////////////////////////////////////////////////
955proc ::BayesText::TolFileSyntaxCheck {path} {
956#/////////////////////////////////////////////////////////////////////////////
957  set ok 0
958  # evaluamos el archivo
959  set tolCheck "Text __EditorCheck = ParseError(ReadFile(\"$path\"))"
960  #puts "TolFileSyntaxCheck: tolCheck = $tolCheck"
961  if {[catch {::tol::console eval $tolCheck}]} {
962    Tolcon_Trace "Falla porque TOL está ocupado"
963  } else  {
964    # comprobamos si ha dado algun error
965    if {![catch { set objInfo [::tol::info variable [list Text __EditorCheck]]}]} {
966          #puts "TolFileSyntaxCheck: objInfo = $objInfo"
967      # destruimos la variable creada en TOL
968      ::tol::console stack release __EditorCheck
969      #Tolcon_Trace "ParseError devuelve: [lindex $objInfo 0]"
970      set ok [string equal [lindex $objInfo 2] "\"\""]
971      if !$ok {
972        set ok [list $ok [lindex $objInfo 2]]
973      }
974    }
975  }
976  return $ok
977}
978
979#/////////////////////////////////////////////////////////////////////////////
980proc ::BayesText::CreateHLText {path lang args} {
981#
982# PURSPOSE: Creates a highlighted text.
983#
984# PARAMETERS:
985#    path -> path where text has to be created
986#    lang -> languaje to highlight (TOL, SQL, MSQ)
987#         TOL -> Time Oriented Language
988#         SQL -> SQL ansii 92
989#         MSQ -> SQL for Microsoft SQL Server
990#         ORA -> SQL for Oracle
991#
992#/////////////////////////////////////////////////////////////////////////////
993  global toltk_options   
994
995  array set opts [list \
996    -background    white \
997    -wrap          none  \
998    -font          $toltk_options(fonts,Fixed) \
999    -linemap       0 ]
1000  array set opts $args
1001
1002  set w  [eval ctext $path [array get opts]]
1003  switch [string toupper $lang] {
1004    TOL {
1005          init_tolctext $w
1006        }
1007    SQL {
1008          init_sqlctext $w
1009          init_msqctext $w
1010        }
1011    MSQ {
1012          init_sqlctext $w
1013          init_msqctext $w
1014        }
1015    default {}
1016  }
1017  return $w
1018}
1019
1020
1021
1022#/////////////////////////////////////////////////////////////////////////////
1023proc ::BayesText::init_sqlctext { w } {
1024#/////////////////////////////////////////////////////////////////////////////
1025  set lstSQL1 {\
1026     alter as by cascade commit connect create else end\
1027     from group having max min\
1028     insert into is primary select set table union update when where\
1029  }
1030  set lstSQL2 {and or not null in between outer join}
1031  set lstTypes {\
1032    int integer real float decimal char varchar nvarchar bit varbinary text\
1033    date datetime smalldatetime\
1034  }
1035
1036  set lstSQL1upper {}
1037  foreach it $lstSQL1 {
1038    lappend lstSQL1upper [string toupper $it]
1039  }
1040  set lstSQL2upper {}
1041  foreach it $lstSQL2 {
1042    lappend lstSQL2upper [string toupper $it]
1043  }
1044  set lstTypesUpper {}
1045  foreach it $lstTypes {
1046    lappend lstTypesUpper [string toupper $it]
1047  }
1048
1049  ctext::addHighlightClass $w sql1 blue $lstSQL1
1050  ctext::addHighlightClass $w sql1 blue $lstSQL1upper
1051  ctext::addHighlightClass $w sql2 #777777 $lstSQL2
1052  ctext::addHighlightClass $w sql2 #777777 $lstSQL2upper
1053  ctext::addHighlightClass $w sqlTypes blue $lstTypes
1054  ctext::addHighlightClass $w sqlTypes blue $lstTypesUpper
1055  # Line comments:
1056  ctext::addHighlightClassForRegexp $w comments #558855 {--[^\n^\r]+}
1057}
1058
1059
1060#/////////////////////////////////////////////////////////////////////////////
1061proc ::BayesText::init_msqctext { w } {
1062#/////////////////////////////////////////////////////////////////////////////
1063  set lst {\
1064    avg case cast convert count sum var varp checksum stdev stdevp checksum checksum_agg\
1065    dateadd datediff datename datepart day getdate getutcdate month year\
1066    ascii charindex difference left len lower ltrim  patindex quotename\
1067    replace replicate reverse right rtrim soundex space str stuff substring unicode upper\
1068    abs acos asin atan atn2 ceiling cos cot degrees exp floor\
1069    log log10 pi power radians rand round sign sin square sqrt tan\
1070  }
1071
1072  set lstUpper {}
1073  foreach it $lst {
1074    lappend lstUpper [string toupper $it]
1075  }
1076  ctext::addHighlightClass $w specialMSQ #FF00AA $lst
1077  ctext::addHighlightClass $w specialMSQ #FF00AA $lstUpper
1078
1079}
1080
1081#/////////////////////////////////////////////////////////////////////////////
1082proc ::BayesText::init_tolctext { w } {
1083#/////////////////////////////////////////////////////////////////////////////
1084  ctext::addHighlightClass $w grammars black [list Anything Code Complex \
1085    CDate CTimeSet Date Matrix NameBlock Polyn Ration Real Serie Set Special Struct \
1086    Text TimeSet VMatrix Class \#Embed \#Require Static ] 
1087
1088  ctext::addHighlightClass $w stackControl purple {BinGroup Case Copy Dating\
1089    Do Element Eval EvalArg Field Find Group IF If MakeGlobal PutDescription\
1090    PutName PutValue ReCalc TOLPath While Write WriteLn False True For\
1091    EvalSet \? }
1092
1093  # Line comments:
1094  ctext::addHighlightClassForRegexp $w comments blue {//[^\n^\r]+}
1095}
1096
1097
1098#/////////////////////////////////////////////////////////////////////////////
1099proc ::BayesText::ReadIni {} {
1100#///////////////////////////////////////////////////////////////////////////// 
1101  variable options
1102
1103  set rini ::iniFile::Read
1104  # find and replace dialog
1105  set options(find,dir)     [$rini BayesText FindDir     forward]
1106  set options(find,case)    [$rini BayesText FindCase    1]
1107  set options(replace,dir)  [$rini BayesText ReplaceDir  forward]
1108  set options(replace,case) [$rini BayesText ReplaceCase 1]   
1109}
1110
1111
1112#/////////////////////////////////////////////////////////////////////////////
1113  proc ::BayesText::WriteIni {} {
1114#
1115# PURPOSE: Write common Editor options to .ini file
1116#
1117# PARAMETERS:
1118#   this  -> Instance of editor
1119#
1120#/////////////////////////////////////////////////////////////////////////////
1121  variable options
1122  set wini ::iniFile::Write
1123
1124  # find and replace dialog
1125  $wini BayesText FindDir      $options(find,dir)
1126  $wini BayesText FindCase     $options(find,case)
1127  $wini BayesText ReplaceDir   $options(replace,dir)
1128  $wini BayesText ReplaceCase  $options(replace,case) 
1129  ::iniFile::Flush
1130}
Note: See TracBrowser for help on using the repository browser.