1package provide simcss 1.0
2
3namespace eval simcss {
4  variable cssDOM
5  array set cssDOM   {}
6  variable cssCASHE
7  array set cssCASHE {}
8  variable colorName
9  variable ID 0
10
11  proc parseCSS { css text } {
12    variable cssDOM
13    variable ID
14
15    regsub -all {\n} $text " " text
16    regsub -all {/\*.*?\*/} $text {} text
17    regsub -all {\s+} $text " " text
18    regsub -all "\}" $text "\}\0" text
19
20    foreach { element } [split $text "\0"] {
21      set for_nodes [set nodes_param {}]
22      regexp -all {^\s*(.*)\{\s*(.*)\}$} $element {} for_nodes nodes_param
23      set nodes_param [string trim $nodes_param]
24
25      foreach { node_info }  [split $for_nodes ","] {
26        set node_info [string trim $node_info]
27
28        # BUG Need more work with attribute and others!!!!!!!
29        foreach { css_param } [split $nodes_param ";"] {
30          regexp {([^:]+):(.*)} $css_param {} css_param_key css_param_value
31          lappend cssDOM($css:[string toupper $node_info]) \
32                              [string trim $css_param_key] \
33                              [string trim [string trim $css_param_value] {"}]
34          set css_param_key   {}
35          set css_param_value {}
36        } ;# foreach all css parameter
37      } ;# foreach all elements split ','
38    } ;# foreach all CSS values
39  } ;# proc parseCSS
40
41
42  proc getAll { css } {
43    variable cssDOM
44
45    foreach { key value } [array get cssDOM] {
46      append text "$key = \t$value\n"
47    } ;# foreach
48
49    return $text
50  } ;# proc getAll (for DEBUG)
51
52
53  proc create { args } {
54    variable colorName
55    variable cssDOM
56    variable ID
57    set a_args(-file) {}
58    array set a_args $args
59
60    incr ID
61
62    foreach { cName cValue } [list aqua   #00a0a0  blue   #0050ff  fuchsia #ff00a0 \
63                                   gray   #a0a0a0  green  #00ff00  lime    #00a000 \
64                                   maroon #b00050  navy   #0000a0  olive   #a0a000 \
65                                   purple #a000a0  red    #ff0050  silver  #d0d0d0 \
66                                   teal   #00a0ff  yellow #ffff00] {
67      set colorName($cName) $cValue
68    } ;# create color table
69
70    # CHECK windows PLATFORM
71    if { $::tcl_platform(platform) == "windows" } {
72      set tagFONT 9  ;  set textFONT 10
73    } else {
74      set tagFONT 10 ;  set textFONT 12
75    } ;# if-else tcl_platform
76    set cssDOM($ID:_DEFAULT_) [list \
77                                tag-openTag              <%N%a> \
78                                tag-closeTag             </%N> \
79                                tag-elementTag           <%N%a/> \
80                                tag-font-family          fixed \
81                                tag-font-size            $tagFONT \
82                                tag-font-weight          normal \
83                                tag-font-style           roman \
84                                tag-color                blue \
85                                tag-background-color     white \
86                                tag-vertical-align       center \
87                                tag-display              block \
88                                font-family              serif \
89                                font-size                $textFONT \
90                                font-weight              normal \
91                                font-style               roman \
92                                text-decoration          none  \
93                                color                    black \
94                                background-color         white \
95                                display                  block \
96                                margin-left              0 \
97                                margin-left              0 \
98                                margin-right             0 \
99                                margin-top               0 \
100                                margin-bottom            0 \
101                                text-align               left \
102                                text-indent              NULL \
103                                list-style               outside \
104                                list-style-type          decimal \
105                               ]
106;# -slant roman=normal
107
108
109    if { ! [string equal $a_args(-file) {}] } {
110      set FILE [open $a_args(-file) RDONLY]
111        parseCSS $ID [read $FILE]
112      close $FILE
113    } ;# if
114    return $ID
115  } ;# proc create
116
117
118  proc getParam { css xml_node param args } {
119    variable cssDOM
120    set a_args(-xml)  {}
121    array set a_args $args
122
123    set xml $a_args(-xml)
124
125    set node [simxml::nodeInfo $xml $xml_node name]
126
127    set need_value {}
128
129# Use standard formating information
130    set css_rules [list _DEFAULT_ * $node]
131    foreach { css_rule } $css_rules {
132      if [info exists cssDOM($css:$css_rule)] {
133        set css_info $cssDOM($css:$css_rule)
134        foreach { t_param t_value } $css_info {
135          if { [string equal $param $t_param] } {
136            set need_value $t_value
137          } ;# if
138        } ;# foreach attribute for current rule
139      } ;# if Rule present for this TAG
140    } ;# foreach ALL rules
141
142    return $need_value
143
144  } ;# proc getParam
145
146
147  proc getStyle { css xml_node args } {
148    variable cssDOM
149    variable cssCASHE
150    set a_args(-xml)          {}
151    set a_args(-attribute)    {}
152    set a_args(-only-one-tag) {false}
153    array set a_args $args
154
155    array set style {}
156    set upper_attr [set lower_attr {}]
157
158    if { [string equal $a_args(-xml) {}] } {
159      set node_name  $xml_node
160      set list_nodes $xml_node
161      set text_attr  $a_args(-attribute)
162      set verbose_path {}
163    } else {
164      set node_name    [simxml::nodeInfo $a_args(-xml) $xml_node name]
165      set list_nodes   [simxml::listNodePath $a_args(-xml) $xml_node -verbose true -only-parent true]
166      set verbose_path [simxml::listNodePath $a_args(-xml) $xml_node -for-css true]
167      set text_attr    [simxml::nodeInfo $a_args(-xml) $xml_node attribute]
168    }
169
170    if { ![string equal $a_args(-only-one-tag) true] } {
171# Use standard formating information
172    if { (![string equal $verbose_path {}]) && \
173         ([info exists cssCASHE($css:$verbose_path)]) } {
174      array set style $cssCASHE($css:$verbose_path)
175      regsub -all {\s} $verbose_path "|" verbose_path
176      set style(styleName) $verbose_path
177
178      # BUG !!! Need change attribute text
179# SET property attribute text
180      foreach { t_param t_value } $text_attr {
181        append upper_attr " [string toupper $t_param]=\"$t_value\""
182        append lower_attr " [string tolower $t_param]=\"$t_value\""
183      }
184      set convert [list "%N" [string toupper $node_name] "%n" [string tolower $node_name] "%a" $lower_attr "%A" $upper_attr]
185      foreach { element text } [list tag-openTag <%N%a> tag-closeTag </%N> tag-elementTag <%N%a/>] {
186          foreach { param value } $convert { regsub -all $param $text $value text } ;#foreach
187          set style($element) $text
188      } ;# foreach
189
190      return [array get style]
191    } else {
192      set css_rules [list _DEFAULT_ *]
193      foreach { css_rule } $css_rules {
194        if [info exists cssDOM($css:$css_rule)] {
195          set css_info $cssDOM($css:$css_rule)
196          foreach { t_param t_value } $css_info {
197            set t_value [checkAttribute  $t_param $t_value]
198            if { ($t_param == "margin-left") && ([info exists style($t_param)]) } {
199              set style($t_param) [expr $style($t_param) + $t_value]
200            } else {
201              set style($t_param) $t_value
202            } ;# if
203          } ;# foreach attribute for current rule
204        } ;# if Rule present for this TAG
205      } ;# foreach _DEFAULT_ * rules
206
207#=================================================
208      foreach { parent_xml_node } $list_nodes {
209        set parent_node $parent_xml_node
210        foreach { t_param t_value } [getStyle $css $parent_xml_node -only-one-tag true] {
211          if { (![string match "tag-*" $t_param]) && \
212               ($t_param != "margin-bottom") && \
213               ($t_param != "margin-top") } {
214            if { ($t_param == "margin-left") && ([info exists style($t_param)]) } {
215              set style($t_param) [expr $style($t_param) + $t_value]
216            } else {
217              set style($t_param) $t_value
218            } ;# if
219          } ;# if
220        } ;# foreach Style value
221      } ;# foreach Parent node
222
223#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
224#      set cssCASHE($css:$verbose_path) [array get style]
225    } ;# if
226    } ;# if SET -only-one-tag
227
228    # ����� ��������� ������������ �������� ���������
229    catch { unset style(content-before) }
230    catch { unset style(content-after)  }
231    catch { unset style(image)          }
232
233    # NORMAL tag
234    foreach { css_rule } $node_name {
235      if [info exists cssDOM($css:$css_rule)] {
236        set css_info $cssDOM($css:$css_rule)
237        foreach { t_param t_value } $css_info {
238          set t_value [checkAttribute $t_param $t_value]
239          if { ($t_param == "margin-left") && ([info exists style($t_param)]) } {
240            set style($t_param) [expr $style($t_param) + $t_value]
241          } else {
242            set style($t_param) $t_value
243          } ;# if
244        } ;# foreach attribute for current rule
245      } ;# if Rule present for this TAG
246    } ;# foreach ALL rules
247
248
249    catch {
250      set lParentNode [simxml::listNodePath $a_args(-xml) $xml_node -verbose true -only-parent true]
251      set css_sim_rule [ set css_rule $node_name ]
252      foreach { parent } [lreverse $lParentNode] {
253        # tag > tag > ... > tag
254        set css_sim_rule "$parent > $css_sim_rule"
255        catch {
256          foreach { t_param t_value } $cssDOM($css:$css_sim_rule) {
257            set t_value [checkAttribute $t_param $t_value]
258            if { ($t_param == "margin-left") && ([info exists style($t_param)]) } {
259              set style($t_param) [expr $style($t_param) + $t_value]
260            } else {
261              set style($t_param) $t_value
262            } ;# if
263          } ;# foreach attribute for (tag > tag > ... > tag)
264        } ;# catch
265
266        # BUG !!!!!!!! �� ��������� �������������� ��������
267        # tag tag ... tag
268        set css_rule     "$parent $css_rule"
269        catch {
270          foreach { t_param t_value } $cssDOM($css:$css_rule) {
271            set t_value [checkAttribute $t_param $t_value]
272            if { ($t_param == "margin-left") && ([info exists style($t_param)]) } {
273              set style($t_param) [expr $style($t_param) + $t_value]
274            } else {
275              set style($t_param) $t_value
276            } ;# if
277          } ;# foreach attribute for (tag tag ... tag)
278        } ;# catch
279
280
281      } ;# foreach ALL parent tag for current node
282    } ;# catch (if true XML)
283
284
285# SET property attribute text
286    foreach { t_param t_value } $text_attr {
287      append upper_attr " [string toupper $t_param]=\"$t_value\""
288      append lower_attr " [string tolower $t_param]=\"$t_value\""
289    }
290    set convert [list "%N" [string toupper $node_name] "%n" [string tolower $node_name] "%a" $lower_attr "%A" $upper_attr]
291    foreach { element text } [list tag-openTag <%N%a> tag-closeTag </%N> tag-elementTag <%N%a/>] {
292        foreach { param value } $convert { regsub -all $param $text $value text } ;#foreach
293        set style($element) $text
294    } ;# foreach
295
296    set cssCASHE($css:$verbose_path) [array get style]
297    catch { unset style({}) }
298
299
300    return [array get style]
301  } ;# proc getStyle
302
303  proc getStyleName { css widget styleName fontStyle tagStyle } {
304    variable cssSTYLE
305      if { ! [info exists cssSTYLE($css:$styleName)] } {
306        set cssSTYLE($css:$styleName) "-font {$fontStyle} $tagStyle"
307        eval $widget tag configure $styleName $cssSTYLE($css:$styleName)
308      } ;# if
309      return $styleName
310  } ;# proc getStyleName
311
312  proc getFontStyle { tStyle args } {
313    variable cssDOM
314    set a_args(-for)      {text}
315    set a_args(-param)    {false}
316    set a_args(-fontSize) 0
317    array set a_args $args
318
319    array set style $tStyle
320    if { $a_args(-for)   == "tag"  } { set preffix "tag-" } else { set preffix "" } ;# if
321    if { $a_args(-param) == "true" } { set param   "-"    } else { set param   "" } ;# if
322
323    set result {}
324    foreach { key name } [list font-family  family \
325                               font-size    size \
326                               font-weight  weight \
327                               font-style   slant] \
328                         {
329      if { [info exists style($preffix$key)] } {
330        if { ($key == "font-size") } {
331          if { [regexp {^(\d+)} $style($preffix$key) -> tmp] } {
332            set style($preffix$key) $tmp
333          } else {
334            #BUG !!!!! Need check _DEFAULT_ font-size and increase with (big, bigger, ...)
335            set style($preffix$key) 20
336          } ;# if font-size
337          set style($preffix$key)  [expr $style($preffix$key) + $a_args(-fontSize)]
338        }
339        lappend result $param$name $style($preffix$key)
340      } ;# if
341    } ;# foreach all needed key
342
343    switch -- $style(text-decoration) {
344      underline {
345        lappend result "${param}underline" true
346      }
347      overline {
348        lappend result "${param}overstrike" true
349      }
350    } ;# switch
351
352    return $result
353  } ;# proc getFontStyle
354
355
356  proc getTagStyle { tStyle args } {
357    variable cssDOM
358    set a_args(-for)    {text}
359    set a_args(-param)  {false}
360    array set a_args $args
361    array set style $tStyle
362    if { $a_args(-for)   == "tag"  } { set preffix "tag-" } else { set preffix "" } ;# if
363    if { $a_args(-param) == "true" } { set param   "-"    } else { set param   "" } ;# if
364
365    set result {}
366    foreach { key name } [list color             foreground \
367                               background-color  background \
368                               text-indent       lmargin1 \
369                               margin-left       lmargin1 \
370                               margin-left       lmargin2 \
371                               margin-right      rmargin \
372                               margin-top        spacing1 \
373                               margin-bottom     spacing3 \
374                               text-align        justify \
375                               ] \
376                         {
377      if { [info exists style($preffix$key)] } {
378        set style($preffix$key) [checkAttribute $key $style($preffix$key)]
379        lappend result $param$name $style($preffix$key)
380      } elseif { [info exists style($key)] } {
381        switch -- $key {
382        text-align    {  set style($preffix$key) $style($key)  }
383        text-indent   -
384        margin-left   -
385        margin-right  -
386        margin-top    -
387        margin-bottom {
388          if { [string equal $style($key) NULL] } {
389            set style($preffix$key) $style(margin-left)
390          } else {
391            regexp {^(\d+)} $style($key) -> tmp
392            set style($preffix$key) $tmp
393          } ;# if
394        }
395        } ;# switch
396        lappend result $param$name $style($preffix$key)
397      };#
398    } ;# foreach all needed key
399
400    return $result
401  } ;# proc getTagStyle
402
403
404  proc checkAttribute { name value } {
405    variable colorName
406    switch -- $name {
407      color            -
408      background-color {
409        if { [string match "rgb*" $value] } {
410          if [regexp {(\d+).*?(\d+).*?(\d+)} $value -> red green blue] {
411            set value [format "#%02x%02x%02x" $red $green $blue]
412            # BUG!!! Need check rgb(100%,0%,35%)
413          } ;# if founded color
414        } elseif { [info exists colorName($value)] }  {
415          set value $colorName($value)
416        } ;# if found RGB setting / color Table
417      }
418      text-indent   -
419      margin-left   -
420      margin-right  -
421      margin-top    -
422      margin-bottom {
423        regexp {^(\d+)} $value -> value
424      }
425      text-align {
426        if { [string equal [string tolower $value] justify] } { set value left }
427      }
428    } ;# switch
429
430    return $value
431  } ;# proc checkAttribute
432
433
434  proc lreverse { list } {
435    set result {}
436    foreach { item } $list {  set result [linsert $result 0 $item]  } ;# foreach
437    return $result
438  } ;# proc lreverse
439}
440
441
442