home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / HTML and CSS Modes / hctsmsl.tcl < prev    next >
Encoding:
Text File  |  1999-04-24  |  32.2 KB  |  1,009 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML and CSS mode - tools for editing Cascading Style Sheets
  4.  # 
  5.  #  FILE: "hctsmsl.tcl"
  6.  #                                    created: 97-03-08 19.32.58 
  7.  #                                last update: 99-04-24 13.20.16 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jlinde@telia.com>
  10.  #     www: <http://www.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.4 and 1.1.1
  13.  # 
  14.  # Copyright 1996-1999 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc hctsmsl.tcl {} {}
  25.  
  26. # Units allowed for length.
  27. set cssUnits {em ex px pt cm mm in pc}
  28.  
  29. # These properties can take a number as value.
  30. set cssNumbers {line-height}
  31.  
  32. # These properties can take length values.
  33. set cssLengths {font-size line-height background-position word-spacing letter-spacing
  34. text-indent margin-top margin-right margin-bottom margin-left padding-top padding-right
  35. padding-bottom padding-left border-top-width border-right-width border-bottom-width
  36. border-left-width border-width width height}
  37.  
  38. # These properties can take percentage values.
  39. set cssPercentage {font-size line-height background-position vertical-align text-indent
  40. margin-top margin-right margin-bottom margin-left padding-top padding-right
  41. padding-bottom padding-left width}
  42.  
  43. # These properties can take URL values.
  44. set cssURLs {background-image list-style-image @import}
  45.  
  46. # These properties can take color values.
  47. set cssColors {color background-color border-color}
  48.  
  49. # These properties can take any value.
  50. set cssAny {font-family}
  51.  
  52. # Groups of properties for different dialogs.
  53. set cssGroup(font) {font-style font-variant font-weight font-size line-height font-family}
  54. set cssGroup(background) {background-color background-image background-repeat
  55. background-attachment background-position}
  56. set cssGroup(text) {word-spacing letter-spacing text-decoration vertical-align
  57. text-transform text-align text-indent}
  58. set cssGroup(margin) {margin-top margin-right margin-bottom margin-left}
  59. set cssGroup(padding) {padding-top padding-right padding-bottom padding-left}
  60. set cssGroup(border) {border-width border-style border-color}
  61. set cssGroup(border-width) {border-top-width border-right-width border-bottom-width
  62. border-left-width}
  63. set cssGroup(size) {width height}
  64. set cssGroup(Display) {display white-space}
  65. set cssGroup(list-style) {list-style-type list-style-image list-style-position}
  66.  
  67. # These of the above groups are shorthands.
  68. set cssShorthands {font background margin padding border border-width list-style}
  69.  
  70. # Possible values of the css properties.
  71. set cssProperty(font-family) {serif sans-serif cursive fantasy monospace}
  72. set cssProperty(font-style) {italic oblique normal}
  73. set cssProperty(font-variant) {small-caps normal}
  74. set cssProperty(font-weight) {bold bolder lighter 100 200 300 400 500 600 700 800 900 normal}
  75. set cssProperty(font-size) {larger smaller xx-small x-small small medium large x-large xx-large}
  76. set cssProperty(line-height) {normal}
  77. set cssProperty(background-color) {transparent}
  78. set cssProperty(background-image) {none}
  79. set cssProperty(background-repeat) {repeat-x repeat-y no-repeat repeat}
  80. set cssProperty(background-attachment) {fixed scroll}
  81. set cssProperty(background-position) {{top center bottom} {left center right}}
  82. set cssProperty(word-spacing) {normal}
  83. set cssProperty(letter-spacing) {normal}
  84. set cssProperty(text-decoration) {none {underline overline line-through blink}}
  85. set cssProperty(vertical-align) {sub super top text-top middle bottom text-bottom baseline}
  86. set cssProperty(text-transform) {capitalize uppercase lowercase none}
  87. set cssProperty(text-align) {left right center justify}
  88. set cssProperty(margin-top) {auto}
  89. set cssProperty(margin-right) {auto}
  90. set cssProperty(margin-bottom) {auto}
  91. set cssProperty(margin-left) {auto}
  92. set cssProperty(border-width) {thin medium thick}
  93. set cssProperty(border-top-width) {thin medium thick}
  94. set cssProperty(border-right-width) {thin medium thick}
  95. set cssProperty(border-bottom-width) {thin medium thick}
  96. set cssProperty(border-left-width) {thin medium thick}
  97. set cssProperty(border-style) {dotted dashed solid double groove ridge inset outset none}
  98. set cssProperty(width) {auto}
  99. set cssProperty(height) {auto}
  100. set cssProperty(float) {left right none}
  101. set cssProperty(clear) {left right both none}
  102. set cssProperty(display) {block inline list-item none}
  103. set cssProperty(white-space) {pre nowrap normal}
  104. set cssProperty(list-style-type) {disc circle square decimal lower-roman upper-roman lower-alpha
  105. upper-alpha none}
  106. set cssProperty(list-style-image) {none}
  107. set cssProperty(list-style-position) {inside outside}
  108.  
  109.  
  110. proc cssGetHtmlWords {} {
  111.     global cssHtmlWords htmlElemAttrOptional1 htmlModeIsLoaded
  112.     if {![info exists htmlModeIsLoaded]} {
  113.         return $cssHtmlWords
  114.     } else {
  115.         catch {unset cssHtmlWords}
  116.         return [array names htmlElemAttrOptional1]
  117.     }    
  118. }
  119.  
  120. proc cssFindWhereToInsert {group pos} {
  121.     if {$pos > 0} {incr pos -1}
  122.     if {[catch {search -s -f 0 -m 0 -r 1 "\{" $pos} lbrace]} {set lbrace 0; set noleft 1}
  123.     set lbrace [expr [lindex $lbrace 0] + 1]
  124.     if {[catch {search -s -f 0 -m 0 -r 1 "\}" $pos} rbrace]} {set rbrace 0}
  125.     set rbrace [expr [lindex $rbrace 0] + 1]
  126.     if {([info exists noleft] || $rbrace > $lbrace) && $group != "@import"} {alertnote "Incorrect position to insert properties."; error "Incorrect position"}
  127.     if {[catch {search -s -f 0 -m 0 -r 1 "\;" $pos} semi] || [lindex $semi 0] < $lbrace} {set semi 0}
  128.     set semi [expr [lindex $semi 0] + 1]
  129.     set go [getPos]
  130.     if {$group != "@import" && ($lbrace > 1 || $semi > 1)} {set go [expr $lbrace > $semi ? $lbrace : $semi]}
  131.     if {[cssIsInComment $go]} {
  132.         set go [lindex [search -s -f 0 -m 0 -r 0 "/*" $go] 0]
  133.         cssFindWhereToInsert $group $go
  134.     } else {
  135.         goto $go
  136.     }
  137. }
  138.  
  139. # CSS properties dialog.
  140. proc cssDialog {group} {
  141.     global cssGroup cssProperty cssAny cssURLs cssLengths cssPercentage cssColors cssUnits
  142.     global htmluserColors htmlColorName basicColors HTMLmodeVars cssShorthands mode cssNumbers
  143.     
  144.     if {$mode == "HTML" && ![htmlIsInContainer STYLE]} {
  145.         beep
  146.         message "Current position is not inside STYLE tags."
  147.         return
  148.     }
  149.     # Find where to insert text.
  150.     cssFindWhereToInsert $group [getPos]
  151.  
  152.     # define colors
  153.     set htmlColors [lsort [array names htmluserColors]]
  154.      append htmlColors " - " $basicColors
  155.     
  156.     # urls
  157.     set URLs $HTMLmodeVars(URLs)
  158.  
  159.     # these fit in half the size of the dialog window
  160.     set halfIsEnough {font-style font-variant font-weight text-transform text-align white-space}
  161.     
  162.     # These needs more space
  163.     set dw 0
  164.     if {$group == "background" || $group == "border-width" || $group == "list-style"} {set dw 40}
  165.     # obtain all props for this group
  166.     if {[info exists cssGroup($group)]} {
  167.         set props $cssGroup($group)
  168.     } else {
  169.         set props $group
  170.     }
  171.     
  172.     # build the dialog
  173.     set invalidInput 1
  174.     set short 1
  175.     set allvalues 0
  176.     set val [cssGetProperties $group]
  177.     if {[info exists errorText] && ![htmlErrorWindow "$group not well-defined" $errorText 1]} {return}
  178.     while {$invalidInput} {
  179.         while {1} {
  180.             if {$group == "@import"} {
  181.                 set htxt "Import Style Sheet"
  182.             } else {
  183.                 set htxt "[string toupper [string index $group 0]][string range $group 1 end] properties"
  184.             }
  185.             set box "-t [list $htxt] 120 10 450 25"
  186.             set fileIndex ""
  187.             set colorIndex ""
  188.             set proptypes ""
  189.             set hpos 35
  190.             set ind 2
  191.             set wpos 10
  192.             foreach p $props {
  193.                 if {[lsearch -exact $halfIsEnough $p] < 0 || $wpos > 235} {
  194.                     if {$wpos > 10} {set wpos 10; incr hpos 30}
  195.                 }
  196.                 if {$p != "@import"} {lappend box -t ${p}: $wpos $hpos [expr $wpos + 110 + $dw] [expr $hpos + 15]}
  197.                 incr wpos 120
  198.                 incr wpos $dw
  199.                 if {[info exists cssProperty($p)]} {
  200.                     # A list of choices
  201.                     set pr $cssProperty($p)
  202.                     # special case with background-position and text-decoration
  203.                     if {$p == "background-position" || $p == "text-decoration"} {
  204.                         set pr1 [lindex $pr 0]
  205.                         if {[llength $pr1] > 1} {
  206.                             lappend box -m [concat [list [lindex $val $ind] "No value"] $pr1] \
  207.                             $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  208.                         } else {
  209.                             lappend box -c $pr1 [lindex $val $ind] $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  210.                         }
  211.                         incr wpos 105
  212.                         incr ind
  213.                         set pr [lindex $pr 1]
  214.                         lappend proptypes $p choices
  215.                     }
  216.                     set n 1
  217.                     # four times for text-decoration and border-style
  218.                     if {$p == "text-decoration" || $group == "border-style"} {set n 4}
  219.                     for {set i 0} {$i < $n} {incr i} {
  220.                         if {$wpos > 355 + $dw} {
  221.                             set wpos [expr 130 + $dw]
  222.                             incr hpos 30
  223.                         }
  224.                         if {[llength $pr] > 1} {
  225.                             lappend box -m [concat [list [lindex $val $ind] "No value"] $pr] \
  226.                             $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  227.                         } else {
  228.                             lappend box -c $pr [lindex $val $ind] $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  229.                         }
  230.                         incr wpos 105
  231.                         incr ind
  232.                         lappend proptypes $p choices
  233.                     }
  234.                 }
  235.                 set l [lsearch -exact $cssLengths $p]
  236.                 set pr [lsearch -exact $cssPercentage $p]
  237.                 if { $l >= 0 || $pr  >= 0 } {
  238.                     # Length or percentage
  239.                     set n 1
  240.                     # twice for background-position
  241.                     if {$p == "background-position"} {set n 2}
  242.                     for {set i 0} {$i < $n} {incr i} {
  243.                         if {$wpos > 335 + $dw} {
  244.                             set wpos [expr 130 + $dw]
  245.                             incr hpos 30
  246.                         }
  247.                         set units ""
  248.                         if {$l >= 0} {set units $cssUnits}
  249.                         if {$pr >= 0} {lappend units %}
  250.                         set uw 110
  251.                         if {[lsearch -exact $cssNumbers $p] >= 0} {set units "{No unit} $units"; set uw 160}
  252.                         lappend box -e [lindex $val $ind] $wpos $hpos [expr $wpos + 50] [expr $hpos + 15]
  253.                         lappend box -m [concat [list [lindex $val [expr $ind + 1]]] $units] \
  254.                         [expr $wpos + 60] $hpos [expr $wpos + $uw] [expr $hpos + 15]
  255.                         incr wpos 120
  256.                         incr ind 2
  257.                         lappend proptypes $p number
  258.                     }
  259.                     set wpos 10
  260.                     incr hpos 30
  261.                 }
  262.                 if {[lsearch -exact $cssAny $p] >= 0} {
  263.                     # Any value
  264.                     if {$wpos > 10} {set wpos 10; incr hpos 30}
  265.                     lappend box -e [lindex $val $ind] 10 $hpos 450 [expr $hpos + 15]
  266.                     incr ind
  267.                     set wpos 10
  268.                     incr hpos 30
  269.                     lappend proptypes $p any
  270.                 }
  271.                 if {[lsearch -exact $cssColors $p] >=0 } {
  272.                     # color
  273.                     set n 1
  274.                     # four times for border-color
  275.                     if {$group == "border-color"} {set n 4}
  276.                     for {set i 0} {$i < $n} {incr i} {
  277.                         if {$wpos > 130} {set wpos 10; incr hpos 30}
  278.                         lappend box -e [lindex $val $ind] 130 $hpos 200 [expr $hpos + 15] \
  279.                         -m [concat [list [lindex $val [expr $ind + 1]] {No value}] $htmlColors] \
  280.                         210 $hpos 340 [expr $hpos + 15] \
  281.                         -b "New Color…" 350 $hpos 450 [expr $hpos + 20]
  282.                         incr ind 3
  283.                         lappend colorIndex [expr $ind - 1]
  284.                         set wpos 10
  285.                         incr hpos 40
  286.                         lappend proptypes $p color
  287.                     }
  288.                 }
  289.                 if {[lsearch -exact $cssURLs $p] >= 0} {
  290.                     # URL
  291.                     if {$wpos > 130} {set wpos 10; incr hpos 30}
  292.                     lappend box -e [lindex $val $ind] 120 $hpos 450 [expr $hpos + 15] \
  293.                     -m [concat [list [lindex $val [expr $ind + 1]] {No value}] $URLs] \
  294.                     120 [expr $hpos + 25] 450 [expr $hpos + 35] \
  295.                     -b "File…" 10 [expr $hpos + 20] 70 [expr $hpos + 40]
  296.                     incr ind 3
  297.                     lappend fileIndex [expr $ind - 1]
  298.                     set wpos 10
  299.                     incr hpos 50
  300.                     lappend proptypes $p url
  301.                 }
  302.                 if {[string match "*left*" $p]} {
  303.                     if {$wpos > 130} {set wpos 10; incr hpos 30}
  304.                     lappend box -r "Set all values individually" $allvalues 10 $hpos 300 [expr $hpos + 15]
  305.                     lappend box -r "Add missing values automatically if possible" [expr !$allvalues] 10 [expr $hpos + 20] 350 [expr $hpos + 35]
  306.                     set allValIndex $ind
  307.                     incr ind 2
  308.                     set wpos 10
  309.                     incr hpos 40
  310.                     lappend proptypes $p allval
  311.                 }
  312.             }
  313.             if {$wpos > 10} {incr hpos 20}
  314.             if {[lsearch -exact $cssShorthands $group] >= 0} {
  315.                 lappend box -c "Use shorthand form if possible" $short 10 $hpos 250 [expr $hpos + 15]
  316.                 incr hpos 20
  317.                 set shortIndex $ind
  318.             }
  319.             set val [eval [concat dialog -w [expr 460 + $dw] -h [expr $hpos + 50] \
  320.             -b OK 20 [expr $hpos + 20]  85 [expr $hpos + 40] \
  321.             -b Cancel 110 [expr $hpos + 20] 175 [expr $hpos + 40] $box]]
  322.             if {[info exists shortIndex]} {set short [lindex $val $shortIndex]}
  323.             if {[info exists allValIndex]} {set allvalues [lindex $val $allValIndex]}
  324.             # OK clicked?
  325.             if {[lindex $val 0]} {break}
  326.             # Cancel clicked?
  327.             if {[lindex $val 1]} {return}
  328.             # File button clicked?
  329.             foreach fl $fileIndex {
  330.                 if {[lindex $val $fl] && [set newFile [htmlGetFile]] != ""} {
  331.                     set URLs $HTMLmodeVars(URLs)
  332.                     set val [lreplace $val [expr $fl - 1] [expr $fl - 1] [lindex $newFile 0]]
  333.                 }
  334.             }
  335.             # Color button clicked?
  336.             foreach cl $colorIndex {
  337.                 if {[lindex $val $cl] && [set newColor [htmlAddNewColor]] != ""} {
  338.                     set htmlColors [concat [list $newColor] $htmlColors]
  339.                     set val [lreplace $val [expr $cl -1] [expr $cl - 1] "$newColor"]
  340.                 }
  341.             }
  342.         }
  343.         
  344.         # Find indentation.
  345.         set indent ""
  346.         if {![catch {matchIt "\}" [getPos]} pos]} {
  347.             regexp {^[ \t]*} [getText [lineStart $pos] $pos] indent
  348.         }
  349.         # Put it all together.
  350.         set j 2
  351.         set prevprop ""
  352.         set proptext ""
  353.         set errtext ""
  354.         set tmptext ""
  355.         for {set i 0} {$i < [llength $proptypes]} {incr i 2} {
  356.             set prop [lindex $proptypes [expr $i + 1]]
  357.             if {$prevprop != [set pr [lindex $proptypes $i]]} {
  358.                 if {$tmptext != ""} {
  359.                     if {$prevprop == "text-decoration"} {
  360.                         if {[lindex $tmptext 0] == "1"} {
  361.                             set tmptext " none"
  362.                         } elseif {$tmptext != " 0"} {
  363.                             set tmptext " [lunique [lrange $tmptext 1 end]]"
  364.                         }
  365.                     } else {
  366.                         set tmptext " [lindex $tmptext 0]"
  367.                     }
  368.                     if {$tmptext != " 0"} {
  369.                         if {[info exists important($prevprop)] || [info exists important($group)]} {append tmptext " ! important"}
  370.                         append proptext "\;\r$indent\t$prevprop:$tmptext"
  371.                     }
  372.                 }
  373.                 set prevprop $pr
  374.                 set tmptext ""
  375.             }
  376.             switch $prop {
  377.                 choices {
  378.                     if {[llength $cssProperty($pr)] == 1} {
  379.                         if {[lindex $val $j]} {
  380.                             append tmptext " $cssProperty($pr)"
  381.                         }
  382.                     } elseif {[set c [lindex $val $j]] != "No value"} {
  383.                         append tmptext " $c"
  384.                     }
  385.                     incr j
  386.                 }
  387.                 number {
  388.                     if {[set c [string trim [lindex $val $j]]] != ""} {
  389.                         if {![catch {cssCheckNumber $pr $c [lindex $val [expr $j + 1]]} c]} {
  390.                             append tmptext " $c"
  391.                         } else {
  392.                             lappend errtext "$pr: $c"
  393.                         }
  394.                     }
  395.                     incr j 2
  396.                 }
  397.                 any {
  398.                     if {[set c [string trim [lindex $val $j]]] != ""} {
  399.                         append tmptext ", $c"
  400.                     }
  401.                     incr j
  402.                 }
  403.                 color {
  404.                     if {[set ctxt [string trim [lindex $val $j]]] != ""} {
  405.                         if {[set col [cssCheckColorNumber $ctxt]] == 0} {
  406.                             lappend errtext "$pr: $ctxt is not a valid color number."
  407.                         } else {
  408.                             append tmptext " $col"
  409.                         }
  410.                     } elseif {[set cval [lindex $val [expr $j + 1]]] != "No value"} {
  411.                         if {[info exists htmluserColors($cval)]} {
  412.                             append tmptext " $htmluserColors($cval)"
  413.                         }
  414.                         if {[info exists htmlColorName($cval)]} {
  415.                             append tmptext " $htmlColorName($cval)"
  416.                         }
  417.                     }
  418.                     incr j 3
  419.                 }
  420.                 url {
  421.                     if {[set turl [string trim [lindex $val $j]]] != ""} {
  422.                         append tmptext " url(\"[htmlURLescape2 $turl]\")"
  423.                         htmlAddToCache URLs $turl
  424.                     } elseif {[set murl [lindex $val [expr $j + 1]]] != "No value"} {
  425.                         append tmptext " url(\"[htmlURLescape2 $murl]\")"
  426.                     }
  427.                     incr j 3
  428.                 }
  429.                 allval {
  430.                     incr j 2
  431.                 }
  432.             }
  433.         }
  434.         if {$tmptext != ""} {
  435.             if {$prevprop == "background-position"} {
  436.                 if {[regexp {^[a-z]+$} [lindex $tmptext 0]]} {
  437.                     set tp ""
  438.                     foreach tm $tmptext {
  439.                         if {[regexp {^[a-z]+$} $tm]} {
  440.                             lappend tp $tm
  441.                         }
  442.                     }
  443.                     set tmptext " $tp"
  444.                 }
  445.             } elseif {$prevprop == "font-family"} {
  446.                 set tmptext [string trim $tmptext ,]
  447.                 if {[lsearch -exact $cssProperty(font-family) [set first [string trim [lindex $tmptext 0] ,]]] >= 0
  448.                 && [llength $tmptext] > 1} {
  449.                     set tmptext " [lrange $tmptext 1 end], $first"
  450.                 }
  451.             } elseif {$prevprop != "border-style" && $prevprop != "border-color"} {
  452.                 set tmptext " [lindex $tmptext 0]"
  453.             }
  454.             if {[info exists important($prevprop)] || [info exists important($group)]} {append tmptext " ! important"}
  455.             append proptext "\;\r$indent\t$pr:$tmptext"
  456.         }
  457.         set proptext [string trimleft $proptext "\;"]
  458.         if {![llength $errtext]} {
  459.             set invalidInput 0
  460.             if {[info exists allValIndex] && !$allvalues} {set proptext [cssAddMissingValues $group $proptext $indent]}
  461.             if {[info exists shortIndex] && $short} {set proptext [cssMakeShort $group $proptext $indent]}
  462.         } else {
  463.             htmlErrorWindow "Invalid input" $errtext
  464.         }
  465.         
  466.     }
  467.     # Special fixes for @import
  468.     if {$group == "@import"} {
  469.         regexp {^[ \t]*} [getText [lineStart [getPos]] [getPos]] indent
  470.         set proptext [string trimleft $proptext ";"]
  471.         regsub "\t+" $proptext "$indent" proptext
  472.         regsub "@import:" $proptext "@import" proptext
  473.     }
  474.     set len 0
  475.     set ps [getPos]
  476.     if {$proptext != ""} {
  477.         insertText "$proptext\;"
  478.         set len [expr [getPos] - $ps]
  479.     }
  480.     set removePos0 [lsort -integer -decreasing $removePos0]
  481.     set removePos1 [lsort -integer -decreasing $removePos1]
  482.     # Check for overlapping positions.
  483.     set r0 [maxPos]
  484.     for {set i 0} {$i < [llength $removePos1]} {incr i} {
  485.         set r00 [lindex $removePos0 $i]
  486.         set r11 [lindex $removePos1 $i]
  487.         if {$r11 > $r0} {set r11 $r0}
  488.         if {$r11 > $r00} {lappend rem [list $r00 $r11]}
  489.         set r0 $r00
  490.     }
  491.     foreach r $rem {
  492.         set xpos 0
  493.         if {[set pos1 [lindex $r 0]] >= $ps} {set xpos $len}
  494.         deleteText [expr $pos1 + $xpos] [expr [lindex $r 1] + $xpos]
  495.     }
  496. }
  497.  
  498. # Add missing values to top, right, bottom, left properties.
  499. proc cssAddMissingValues {group text indent} {
  500.     global cssGroup
  501.     set tmp [split $text "\r"]
  502.     set sideList {top right bottom left}
  503.     # Find those values which have been set
  504.     foreach side $sideList {
  505.         set $side 0
  506.         foreach l $tmp {
  507.             if {[string match *${side}* [lindex $l 0]]} {
  508.                 set $side 1
  509.                 set ${side}val [string trimright [lindex $l 1] "\;"]
  510.             }
  511.         }
  512.     }
  513.     # Add missing values.
  514.     foreach side $sideList {
  515.         if {![set $side]} {
  516.             switch $side {
  517.                 top {set opside bottom}
  518.                 right {set opside left}
  519.                 bottom {set opside top}
  520.                 left {set opside right}
  521.             }
  522.             if {[set $opside]} {
  523.                 set use $opside
  524.             } elseif {$top} {
  525.                 set use top
  526.             } else {
  527.                 # Can't add missing value.
  528.                 return $text
  529.             }    
  530.             append text "\;\r$indent\t[lindex $cssGroup($group) [lsearch $sideList $side]]: [set ${use}val]"
  531.         }
  532.     }
  533.     
  534.     return $text
  535. }
  536.  
  537. # Makes a short form of a group of properties.
  538. proc cssMakeShort {group text indent} {
  539.     global cssGroup
  540.     set lines [split $text \r]
  541.     set count 0
  542.     set important 0
  543.     foreach pr $cssGroup($group) {
  544.         foreach l $lines {
  545.             if {[lindex $l 0] == "$pr:"} {
  546.                 incr important [regsub { ! important} $l {} l]
  547.                 incr count
  548.                 if {$pr == "font-size"} {set fontSize 1}
  549.                 if {$pr == "font-family"} {set fontFamily 1}
  550.                 # Line-height is a special case.
  551.                 if {$pr == "line-height" && [info exists fontSize]} {
  552.                     append values /[string trimright [lrange $l 1 end] "\;"]
  553.                 } else {
  554.                     append values " " [string trimright [lrange $l 1 end] "\;"]
  555.                 }
  556.             }
  557.         }
  558.     }
  559.     if {$important > 0 && $important != $count} {return $text}
  560.     # font-size and font-family must be used for font.
  561.     if {$group == "font" && (![info exists fontSize] || ![info exists fontFamily])} {return $text}
  562.     # Remove unnecessary stuff for margin and padding and border-width.
  563.     if {$group == "margin" || $group == "padding" || $group == "border-width"} {
  564.         # If count ≠ 4, then there is no short form
  565.         if {$count != 4} {return $text}
  566.         if {[llength [lunique $values]] == 1} {
  567.             set values " [lindex $values 0]"
  568.         } elseif {[lindex $values 0] == [lindex $values 2] && [lindex $values 1] == [lindex $values 3]} {
  569.             set values [lrange $values 0 1]
  570.         } elseif {[lindex $values 1] == [lindex $values 3]} {
  571.             set values [lrange $values 0 2]
  572.         }
  573.     }
  574.     
  575.     set text ""
  576.     if {[lindex $lines 0] == "\;"} {set text "\;"}
  577.     if {[info exists values]} {
  578.         if {$group == "font"} {set values " [lunique $values]"}
  579.         append text "\r$indent\t$group:$values"
  580.         if {$important} {append text " ! important"}
  581.     }
  582.     return $text
  583. }
  584.  
  585. # Check if a CSS number is ok.
  586. proc cssCheckNumber {prop num unit} {
  587.     global cssPercentage cssLengths cssUnits
  588.     if {![regexp {^(-?[0-9]+\.?[0-9]*)([%a-z]*)$} $num d n u]} {
  589.         error "Invalid number."
  590.     }
  591.     if {$u != ""} {
  592.         if {[lsearch -exact [concat $cssUnits %] $u] < 0 ||
  593.         $u != "%" && [lsearch -exact $cssLengths $prop] < 0} {
  594.             error "Invalid unit."
  595.         } else {
  596.             set unit $u
  597.         }
  598.     } elseif {$unit == "No unit"} {
  599.         set unit ""
  600.     }
  601.     if {$unit == "%" && [lsearch -exact $cssPercentage $prop] < 0} {
  602.         error "Percentage not allowed."
  603.     }
  604.     return "$n$unit"
  605. }
  606.  
  607. # Check if a color number is a valid number, or one of the predefined names.
  608. # Returns 0 if not and the color number if it is.
  609. proc cssCheckColorNumber {color} {
  610.     global htmlColorName
  611.     set color [string tolower $color]
  612.     if {[info exists htmlColorName($color)]} {return $htmlColorName($color)}
  613.     # rgb(1,2,3)
  614.     if {[regexp {^rgb\(([0-9]+),([0-9]+),([0-9]+)\)$} $color dum c1 c2 c3]} {
  615.         if {$c1 > -1 && $c1 < 256 && $c2 > -1 && $c2 < 256 && $c3 > -1 && $c3 < 256} {
  616.             return $color
  617.         } else {
  618.             return 0
  619.         }
  620.     }
  621.     # rgb(1.0%,2.0%,3.0%)
  622.     if {[regexp {^rgb\(([0-9]+\.?[0-9]*)%,([0-9]+\.?[0-9]*)%,([0-9]+\.?[0-9]*)%\)$} $color dum c1 c2 c3]} {
  623.         if {$c1 >= 0.0 && $c1 <= 100.0 && $c2 >= 0.0 && $c2 <= 100.0 && $c3 >= 0.0 && $c3 <= 100.0} {
  624.             return $color
  625.         } else {
  626.             return 0
  627.         }
  628.     }
  629.         
  630.     # #123456 or #123
  631.     if {[string index $color 0] != "#"} {
  632.         set color "#${color}"
  633.     }
  634.     set color [string toupper $color]
  635.     if {([string length $color] != 7 && [string length $color] != 4) || ![regexp {^#[0-9A-F]+$} $color]} {
  636.         return 0
  637.     } else {
  638.         return $color
  639.     }    
  640. }
  641.  
  642. # Extracts the current values for the property to add.
  643. proc cssGetProperties {group} {
  644.     global cssGroup cssProperty cssAny cssURLs cssLengths cssPercentage cssColors
  645.     global htmluserColorname htmlColorNumber HTMLmodeVars cssShorthands
  646.     
  647.     upvar removePos0 remove0 removePos1 remove1 important important
  648.     upvar short short errorText errorText
  649.     
  650.     if {$group == "@import"} {return}
  651.     
  652.     # obtain all props for this group
  653.     if {[info exists cssGroup($group)]} {
  654.         set props $cssGroup($group)
  655.     } else {
  656.         set props $group
  657.     }
  658.     # Find interval to search in.
  659.     if {[catch {matchIt "\}" [getPos]} start]} {
  660.         if {![catch {search -s -f 0 -m 0 -r 0 "\}" [getPos]} r0] ||
  661.         ![catch {search -s -f 1 -i 1 -m 0 -r 0 "<STYLE([ \t\r]+[^<>]*>|>)" [getPos]} r0]} {
  662.             set start [lindex $r0 1]
  663.         } else {
  664.             set start 0
  665.         }
  666.     }
  667.     if {[catch {matchIt "\{" [getPos]} end]} {
  668.         set rbrace [maxPos]
  669.         set style [maxPos]
  670.         if {![catch {search -s -f 1 -m 0 -r 0 "\{" [getPos]} r0]} {
  671.             set rbrace [lineStart [lindex $r0 0]]
  672.         }
  673.         if {![catch {search -s -f 1 -i 1 -m 0 -r 0 "</STYLE>" [getPos]} r0]} {
  674.             set style [lindex $r0 0]
  675.         }
  676.         set end [expr $rbrace < $style ? $rbrace : $style]
  677.     }
  678.     # build a list with property values
  679.     set val {0 0}
  680.     set remove ""
  681.     # Find shorthand property
  682.     if {[lsearch -exact $cssShorthands $group] >= 0} {
  683.         set groupValue ""
  684.         set st0 $start
  685.         while {1} {
  686.             if {[catch {search -s -f 1 -i 1 -m 0 -r 1 -l $end "(\[ \t\r\]+|;|\{)$group\[ \t\r\]*:" $st0} res]} {
  687.                 break
  688.             } elseif {![catch {search -s -f 1 -i 1 -m 0 -r 0 -l $end "\;" [lindex $res 1]} res1]} {
  689.                 if {![cssIsInComment [lindex $res 0]]} {
  690.                     set groupValue [string trim [getText [lindex $res 1] [expr [lindex $res1 1] - 1]]]
  691.                     set r00 [lindex $res 0]
  692.                     if {[lookAt $r00] == ";" || [lookAt $r00] == "\{"} {incr r00}
  693.                     lappend remove0 $r00 
  694.                     lappend remove1 [lindex $res1 1]
  695.                     break
  696.                 } else {
  697.                     set st0 [lindex $res1 1]
  698.                 }
  699.             } else {
  700.                 if {![cssIsInComment [lindex $res 0]]} {
  701.                     set groupValue [string trim [getText [lindex $res 1] $end]]
  702.                     set r00 [lindex $res 0]
  703.                     if {[lookAt $r00] == ";" || [lookAt $r00] == "\{"} {incr r00}
  704.                     lappend remove0 $r00 
  705.                     lappend remove1 $end
  706.                     break
  707.                 } else {
  708.                     set st0 [lindex $res1 1]
  709.                 }
  710.             }
  711.         }
  712.         regsub -all {/\*[^\*]*\*/} $groupValue "" groupValue
  713.         if {[regsub -nocase {![ \t\r]*important} $groupValue {} groupValue]} {set important($group) 1}
  714.         if {$groupValue != ""} {
  715.             cssExpandProps $group $groupValue
  716.         }
  717.     }
  718.     
  719.     foreach p $props {
  720.         # Find the property
  721.         if {![info exists propValue($p)]} {set propValue($p) ""}
  722.         set st0 $start
  723.         while {1} {
  724.             if {[catch {search -s -f 1 -i 1 -m 0 -r 1 -l $end "(\[ \t\r\]+|;|\{)$p\[ \t\r\]*:" $st0} res]} {
  725.                 break
  726.             } elseif {![catch {search -s -f 1 -i 1 -m 0 -r 0 -l $end "\;" [lindex $res 1]} res1]} {
  727.                 if {![cssIsInComment [lindex $res 0]]} {
  728.                     set propValue($p) [string trim [getText [lindex $res 1] [expr [lindex $res1 1] - 1]]]
  729.                     set r00 [lindex $res 0]
  730.                     if {[lookAt $r00] == ";" || [lookAt $r00] == "\{"} {incr r00}
  731.                     lappend remove0 $r00 
  732.                     lappend remove1 [lindex $res1 1]
  733.                     set short 0
  734.                     break
  735.                 } else {
  736.                     set st0 [lindex $res1 1]
  737.                 }
  738.             } else {
  739.                 if {![cssIsInComment [lindex $res 0]]} {
  740.                     set propValue($p) [string trim [getText [lindex $res 1] $end]]
  741.                     set r00 [lindex $res 0]
  742.                     if {[lookAt $r00] == ";" || [lookAt $r00] == "\{"} {incr r00}
  743.                     lappend remove0 $r00 
  744.                     lappend remove1 $end
  745.                     set short 0
  746.                     break
  747.                 } else {
  748.                     set st0 [lindex $res1 1]
  749.                 }
  750.             }
  751.         }
  752.         regsub -all {/\*[^\*]*\*/} $propValue($p) "" propValue($p)
  753.     }
  754.     foreach p $props {
  755.         set thisValue [string tolower $propValue($p)]
  756.         if {[regsub {![ \t\r]*important} $thisValue {} thisValue]} {set important($p) 1}
  757.         if {[info exists cssProperty($p)]} {
  758.             # A list of choices
  759.             set pr $cssProperty($p)
  760.             # special case with background-position and text-decoration
  761.             if {$p == "background-position" || $p == "text-decoration"} {
  762.                 set pr1 [lindex $pr 0]
  763.                 if {[llength $pr1] > 1} {
  764.                     set found 0
  765.                     for {set i 0} {$i < [llength $thisValue]} {incr i} {
  766.                         set tv [lindex $thisValue $i]
  767.                         if {[lsearch -exact $pr1 $tv] >= 0} {
  768.                             lappend val [lindex $thisValue $i]
  769.                             set thisValue [lreplace $thisValue $i $i]
  770.                             set found 1
  771.                             break
  772.                         }
  773.                     }
  774.                     if {!$found} {lappend val "No value"}
  775.                 } elseif {[set ww [lsearch -exact $thisValue $pr1]] >= 0} {
  776.                     set thisValue [lreplace $thisValue $ww $ww]
  777.                     lappend val 1
  778.                 } else {
  779.                     lappend val 0
  780.                 }
  781.                 set pr [lindex $pr 1]
  782.             }
  783.             set n 1
  784.             # four times for text-decoration and border-style
  785.             if {$p == "text-decoration" || $group == "border-style"} {set n 4}
  786.             for {set i 0} {$i < $n} {incr i} {
  787.                 if {[llength $pr] > 1} {
  788.                     if {[llength $thisValue] && [lsearch -exact $pr [lindex $thisValue 0]] >= 0} {
  789.                         lappend val [lindex $thisValue 0]
  790.                         set thisValue [lrange $thisValue 1 end]
  791.                     } else {
  792.                         lappend val "No value"
  793.                     }
  794.                 } elseif {$thisValue == $pr} {
  795.                     lappend val 1
  796.                     set thisValue ""
  797.                 } else {
  798.                     lappend val 0
  799.                 }
  800.             }
  801.         }
  802.         set l [lsearch -exact $cssLengths $p]
  803.         set pr [lsearch -exact $cssPercentage $p]
  804.         if { $l >= 0 || $pr  >= 0 } {
  805.             # Length or percentage
  806.             set n 1
  807.             # twice for background-position
  808.             if {$p == "background-position"} {set n 2}
  809.             for {set i 0} {$i < $n} {incr i} {
  810.                 if {$i < [llength $thisValue] && ![catch {cssCheckNumber $p [lindex $thisValue 0] ""} num]} {
  811.                     regexp {[0-9]+(.*)} $num dum unit
  812.                     lappend val $num $unit
  813.                     set thisValue [lrange $thisValue 1 end]
  814.                 } else {
  815.                     lappend val "" ""
  816.                 }
  817.             }
  818.         }
  819.         if {[lsearch -exact $cssAny $p] >= 0} {
  820.             # Any value
  821.             lappend val $thisValue
  822.             set thisValue ""
  823.         }
  824.         if {[lsearch -exact $cssColors $p] >=0 } {
  825.             # color
  826.             set n 1
  827.             # four times for border-color
  828.             if {$group == "border-color"} {set n 4}
  829.             for {set i 0} {$i < $n} {incr i} {
  830.                 set tv [cssCheckColorNumber [lindex $thisValue 0]]
  831.                 if {$tv == "0"} {
  832.                     lappend val "" "No value" 0
  833.                 } elseif {[info exists htmluserColorname($tv)]} {
  834.                     lappend val "" $htmluserColorname($tv) 0
  835.                 } elseif {[info exists htmlColorNumber($tv)]} {
  836.                     lappend val "" $htmlColorNumber($tv) 0
  837.                 } else {
  838.                     lappend val $tv "No value" 0
  839.                 }
  840.                 if {$tv != "0"} {set thisValue [lrange $thisValue 1 end]}
  841.             }
  842.         }
  843.         if {[lsearch -exact $cssURLs $p] >= 0} {
  844.             # URL
  845.             if {[regexp {url\(\"?([^\"\)]+)\"?\)} $propValue($p) dum thisValue]} {
  846.                 set thisValue [htmlURLunEscape $thisValue]
  847.                 htmlAddToCache URLs $thisValue
  848.                 lappend val "" $thisValue 0
  849.                 set thisValue ""
  850.             } else {
  851.                 lappend val "" "No value" 0
  852.             }
  853.         }
  854.         if {[llength $thisValue]} {lappend errorText "$p: $thisValue"}
  855.     }
  856.     return $val
  857. }
  858.  
  859. proc cssExpandProps {group value} {
  860.     global cssGroup cssProperty cssAny cssURLs cssLengths cssPercentage cssColors cssUnits
  861.     upvar propValue prop errorText errorText
  862.     set valueUP $value
  863.     set value [string tolower $value]
  864.     # Special case with font
  865.     if {$group == "font"} {
  866.         regexp {[^ \t]+(,[ \t]+[^ \t]+)*[ \t]*$} $value family
  867.         set prop(font-family) [string trim $family]
  868.         set value [string range $value 0 [expr [string length $value] - [string length $family] - 1]]
  869.         set fontsize [lindex $value [expr [llength $value] - 1]]
  870.         set lineheight ""
  871.         regexp {^([^/]+)/?(.*)$} $fontsize dum fontsize lineheight
  872.         if {[lsearch -exact $cssProperty(font-size) $fontsize] >= 0 || ![catch {cssCheckNumber font-size $fontsize ""} fontsize]} {
  873.             set prop(font-size) $fontsize
  874.         }
  875.         if {[lsearch -exact $cssProperty(line-height) $lineheight] >= 0 || ![catch {cssCheckNumber line-height $lineheight ""} lineheight]} {
  876.             set prop(line-height) $lineheight
  877.         }
  878.         set value [lrange $value 0 [expr [llength $value] - 2]]
  879.         set normal [lsearch -exact $value normal]
  880.         regsub -all "normal" $value "" value
  881.     }
  882.  
  883.     # Special case with background-position
  884.     if {$group == "background"} {
  885.         foreach bp $cssProperty(background-position) {
  886.             set nv ""
  887.             foreach v $value {
  888.                 if {[lsearch -exact $bp $v] >= 0} {
  889.                     lappend prop(background-position) $v
  890.                 } else {
  891.                     lappend nv $v
  892.                 }
  893.             }
  894.             set value $nv
  895.         }
  896.         set nv ""
  897.         foreach v $value {
  898.             if {![catch {cssCheckNumber background-position $v ""} v1]} {
  899.                 lappend prop(background-position) $v1
  900.             } else {
  901.                 lappend nv $v
  902.             }
  903.         }
  904.         set value $nv
  905.     }
  906.     
  907.     # Handle margin, padding and border-width separately
  908.     if {$group == "margin" || $group == "padding" || $group == "border-width"} {
  909.         foreach trbl {top right bottom left} {
  910.             if {$group == "border-width"} {
  911.                 set pr "border-${trbl}-width"
  912.             } else {
  913.                 set pr ${group}-$trbl
  914.             }
  915.             set v ""
  916.             if {[llength $value]} {
  917.                 set v [lindex $value 0]
  918.                 set value [lrange $value 1 end]
  919.             }
  920.             if {$group != "padding" && [lsearch -exact $cssProperty($pr) $v] >= 0} {
  921.                 set prop($pr) $v
  922.             } elseif {![catch {cssCheckNumber $pr $v ""} v1]} {
  923.                 set prop($pr) $v1
  924.             } elseif {$v != ""} {
  925.                 append err " $v"
  926.             }
  927.         }
  928.         if {[info exists err]} {lappend errorText "$group:$err"}
  929.         return
  930.     }
  931.     
  932.     # All other properties.
  933.     foreach p $cssGroup($group) {
  934.         if {[info exists cssProperty($p)]} {
  935.             set p1 $cssProperty($p)
  936.             if {$group == "font" && [lsearch -exact {font-style font-weight font-variant line-height} $p] >= 0} {
  937.                 set tmp ""
  938.                 for {set i 0} {$i < [llength $value]} {incr i} {
  939.                     set v [lindex $value $i]
  940.                     if {[lsearch -exact $p1 $v] >= 0} {
  941.                         set tmp $v
  942.                         set value [lreplace $value $i $i]
  943.                         break
  944.                     }
  945.                 }
  946.                 if {$tmp != ""} {
  947.                     set prop($p) $tmp
  948.                 } elseif {$normal >= 0} {
  949.                     set prop($p) normal
  950.                 }
  951.             } else {
  952.                 for {set i 0} {$i < [llength $value]} {incr i} {
  953.                     set v [lindex $value $i]
  954.                     if {[lsearch -exact $p1 $v] >= 0} {
  955.                         set prop($p) $v
  956.                         set value [lreplace $value $i $i]
  957.                         break
  958.                     }
  959.                 }
  960.             }
  961.         }
  962.         if {[lsearch -exact $cssURLs $p] >= 0} {
  963.             for {set i 0} {$i < [llength $value]} {incr i} {
  964.                 set v [lindex $value $i]
  965.                 if {[regexp {^url\(\"?[^\"\)]+\"?\)$} $v]} {
  966.                     foreach v1 $valueUP {
  967.                         if {$v == [string tolower $v1]} {
  968.                             set prop($p) $v1
  969.                         }
  970.                     }
  971.                     set value [lreplace $value $i $i]
  972.                     break
  973.                 }
  974.             }
  975.         }
  976.         if {[lsearch -exact $cssColors $p] >= 0} {
  977.             for {set i 0} {$i < [llength $value]} {incr i} {
  978.                 set v [lindex $value $i]
  979.                 if {[set c [cssCheckColorNumber $v]] != "0"} {
  980.                     set prop($p) $c
  981.                     set value [lreplace $value $i $i]
  982.                     break
  983.                 }
  984.             }
  985.         }
  986.         set l [lsearch -exact $cssLengths $p]
  987.         set pr [lsearch -exact $cssPercentage $p]
  988.         if { $l >= 0 || $pr  >= 0 } {
  989.             for {set i 0} {$i < [llength $value]} {incr i} {
  990.                 set v [lindex $value $i]
  991.                 if {![catch {cssCheckNumber $p $v ""} num]} {
  992.                     set prop($p) $num
  993.                     set value [lreplace $value $i $i]
  994.                     break
  995.                 }
  996.             }
  997.         }        
  998.     }
  999.     if {[llength $value]} {lappend errorText "$group: $value"}
  1000. }
  1001.  
  1002. proc cssIsInComment {pos} {
  1003.     set a [maxPos]
  1004.     set b -1
  1005.     if {![catch {search -s -f 0 -m 0 -r 0 "/*" $pos} a1]} {set a [lindex $a1 0]}
  1006.     if {![catch {search -s -f 0 -m 0 -r 0 "*/" $pos} b1]} {set b [lindex $b1 0]}
  1007.     return [expr ($a < $pos && $a > $b)]
  1008. }
  1009.