source: tol/tolbase/lib/toltk/bystext.tcl @ 81d4b20

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

merging from NameBlock/VMatrix branch

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