home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / HTML and CSS Modes / htmlEngine.tcl < prev    next >
Encoding:
Text File  |  1997-12-06  |  56.6 KB  |  1,800 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlEngine.tcl"
  6.  #                                    created: 96-04-29 21.31.28 
  7.  #                                last update: 6/12/97 {1:49:56 pm} 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0.3
  13.  # 
  14.  # Copyright 1996, 1997 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 htmlEngine.tcl {} {}
  25.  
  26. proc htmlIsUnsignedInteger {str1} {
  27.     return [regexp {^[0-9]+$} [string trim $str1]]
  28. }
  29.  
  30. proc htmlIsPositiveInteger {str1} {
  31.     return [expr ([htmlIsUnsignedInteger $str1] && ![regexp {^0+$} [string trim $str1]])]
  32. }
  33.  
  34. proc htmlIsInteger {str} {
  35.     return [regexp {^-?[0-9]+$} [string trim $str]]
  36. }
  37.  
  38. # Checks to see if the current window is empty, except for whitespace.
  39. proc htmlIsEmptyFile {} {
  40.     return [htmlIsWhite [getText 0 [maxPos]]]
  41. }
  42.  
  43. # Removes all tags from a string.
  44. proc htmlTagStrip {str} {
  45.     regsub -all {<[^<>]*>} $str "" str
  46.     return $str
  47. }
  48.  
  49. # Quoting of strings for meta tags.
  50. proc htmlQuote {str} {
  51.     regsub -all "#" $str {#;} str
  52.     regsub -all "\"" $str {#qt;} str
  53.     regsub -all "<" $str {#lt;} str
  54.     regsub -all ">" $str {#gt;} str
  55.     return $str
  56. }
  57.  
  58. proc htmlUnQuote {str} {
  59.     regsub -all {#qt;} $str "\"" str
  60.     regsub -all {#lt;} $str "<" str
  61.     regsub -all {#gt;} $str ">" str
  62.     regsub -all {#;} $str "#" str
  63.     return $str
  64. }
  65.  
  66.  
  67. # Find the version number of a program.
  68. # Returns 0 if any problem.
  69. proc htmlGetVersion {sig} {
  70.     if {![htmlCheckRunning $sig] && [catch {app::launchBack $sig}]} {
  71.         return 0
  72.     }
  73.     set vers [AEBuild -r '$sig' core getd ---- "obj{want:type('prop'),from:null(),form:'prop',seld:type('vers')}"]
  74. #     set vers [objectProperty 'MACS' vers "obj {want:type(file), seld:$sig, form:fcrt, from:'null'()}"]
  75.     if {[regexp {vers\(«([0-9]+)} $vers dum vers]} {
  76.         return [string trimleft [string range $vers 0 1].[string range $vers 2 3] 0]
  77.     }
  78.     return 0
  79. }
  80.  
  81. # Checks if an element is an INPUT elements.
  82. proc htmlIsInputElement {elem} {
  83.     global htmlElemProc
  84.     if {[lsearch -exact {TEXT PASSWORD CHECKBOX BUTTON RADIO IMAGE HIDDEN FILE SUBMIT RESET} $elem] >= 0 ||
  85.     [info exists htmlElemProc($elem)] && [lindex $htmlElemProc($elem) 0] == "htmlBuildInputElem"} {
  86.         return 1
  87.     }
  88.     return 0
  89. }
  90.  
  91. proc htmlCommentStrings {} {
  92.     if {[htmlIsInContainer SCRIPT] || [htmlIsInContainer STYLE]} {
  93.         return [list "/* " " */"]
  94.     } else {
  95.         return [list "<!-- " " -->"]
  96.     }
  97. }
  98.  
  99. # Create a string for URL mapping in Big Brother.
  100. proc htmlURLmap {} {
  101.     global HTMLmodeVars
  102.     set urlmap {}
  103.     foreach hp $HTMLmodeVars(homePages) {
  104.         set fld "[htmlURLescape [lindex $hp 0] 1]/"
  105.         regsub -all ":" $fld "/" fld
  106.         set url [htmlURLescape "[lindex $hp 1][lindex $hp 2]"]
  107.         lappend urlmap "Msta:“$url”, Mend:“file:///$fld”"
  108.         append urlmap ","
  109.     }
  110.     set urlmap [string trimright $urlmap ","]
  111.     return $urlmap
  112. }
  113.  
  114. # Checks if an app is running.
  115. proc htmlCheckRunning {sig} {
  116.     foreach    p [processes] {
  117.         if {[lindex $p 1] == $sig } {
  118.             return 1
  119.         }
  120.     }
  121.     return 0
  122. }
  123.  
  124. # Makes a line for browser error window.
  125. proc htmlBrwsErr {fil l lnum ln text path} {
  126.     return "$fil[format "%$l\s" ""]; Line $lnum:[format "%$ln\s" ""]$text\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$path\r"
  127. }
  128.  
  129. proc htmlSetWin {} {
  130.     insertColorEscape 0 1
  131.     insertColorEscape [nextLineStart [nextLineStart 0]] 0
  132.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  133.     setWinInfo dirty 0
  134.     setWinInfo read-only 1
  135.     scrollUpLine; scrollUpLine
  136.     refresh
  137. }
  138.     
  139. proc htmlIsTextFile {fil cmd} {
  140.     if {[getFileType $fil] != "TEXT"} {
  141.         $cmd "[file tail $fil] is not a text file."
  142.         return 0
  143.     }
  144.     return 1
  145. }
  146.  
  147. proc htmlAllSaved {msg} {
  148.     set dirty 0
  149.     foreach w [winNames] {
  150.         getWinInfo -w $w arr
  151.         if {$arr(dirty)} {set dirty 1; break}
  152.     }
  153.     if {$dirty} {
  154.         set yn [eval [concat askyesno $msg]]
  155.         if {$yn == "yes"} {saveAll}
  156.         return $yn
  157.     }
  158.     return yes
  159. }
  160.  
  161. proc htmlIsThereAHomePage {} {
  162.     global HTMLmodeVars    
  163.     if {![llength $HTMLmodeVars(homePages)]} {
  164.         alertnote "You must set a home page folder."
  165.         htmlHomePages
  166.     }
  167.     return [llength $HTMLmodeVars(homePages)]
  168. }
  169.  
  170. proc htmlWhichHomePage {msg} {
  171.     global HTMLmodeVars
  172.     foreach hp $HTMLmodeVars(homePages) {
  173.         lappend hplist "[lindex $hp 1][lindex $hp 2]"
  174.     }
  175.     if {[catch {listpick -p "Select home page to $msg." $hplist} hp] || ![string length $hp]} {error ""}
  176.     set home [lindex $HTMLmodeVars(homePages) [lsearch -exact $hplist $hp]]
  177.     if {![file exists [lindex $home 0]] || ![file isdirectory [lindex $home 0]]} {
  178.         alertnote "Can't find the folder for [lindex $home 1][lindex $home 2]"
  179.         error ""
  180.     }
  181.     return $home
  182. }
  183.  
  184. # Determines in which home page folder a URL points to.
  185. # If none, return empty string.
  186. proc htmlInWhichHomePage {url} {
  187.     global HTMLmodeVars
  188.     foreach p $HTMLmodeVars(homePages) {
  189.         if {[string match "[lindex $p 1][lindex $p 2]*" $url]} {return [lindex $p 0]}
  190.     }
  191.     return ""
  192. }
  193.  
  194. # Checks if a folder contains a home page folder or an include folder as a subfolder.
  195. proc htmlContainHpFolder {folder} {
  196.     global HTMLmodeVars
  197.     foreach p $HTMLmodeVars(homePages) {
  198.         foreach i {0 4} {
  199.             if {[llength $p] == $i} {continue}
  200.             if {[string match "$folder:*" "[lindex $p $i]:"] && "[lindex $p $i]:" != "$folder:"} {
  201.                 return 1
  202.             }
  203.         }
  204.     }
  205.     return 0
  206. }
  207.  
  208. # Asks for a folder and checks that it is not an alias.
  209. proc htmlGetDir {prompt} {
  210.     while {1} {
  211.         if {[file isdirectory [set folder [get_directory -p $prompt]]]} {
  212.             break
  213.         } else {
  214.             alertnote "Sorry! Cannot resolve aliases."
  215.         }
  216.     }
  217.     return [string trimright $folder :]
  218. }
  219.  
  220. proc htmlNotYet {} {
  221.     alertnote "Not yet, but coming soon."
  222. }
  223.  
  224. proc htmlDisabled {} {
  225.     alertnote "Disabled function!"
  226.     error "Disabled function!"
  227. }
  228.  
  229. proc htmlSetCase {elem} {
  230.     global HTMLmodeVars 
  231.     if {$HTMLmodeVars(useLowerCase)} { 
  232.         return [string tolower $elem] 
  233.     } else {
  234.         return [string toupper $elem] 
  235.     }
  236. }
  237.  
  238.  
  239. # Returns a list of all attributes used in any HTML element.
  240. proc htmlGetAllAttrs {} {
  241.     global htmlElemAttrOptional1 htmlElemAttrRequired1 htmlElemEventHandler1
  242.     
  243.     foreach elem [array names htmlElemAttrOptional1] {
  244.         if {[info exists htmlElemAttrRequired1($elem)]} {
  245.             append allHTMLattrs " " $htmlElemAttrRequired1($elem)
  246.         }
  247.         append allHTMLattrs " " $htmlElemAttrOptional1($elem)
  248.         if {[info exists htmlElemEventHandler1($elem)]} {
  249.             append allHTMLattrs " " [string toupper $htmlElemEventHandler1($elem)]
  250.         }
  251.     }
  252.     return $allHTMLattrs
  253. }
  254.  
  255.  
  256. # Snatch the current selection into htmlCurSel, set flag whether there is one
  257. proc htmlGetSel {} {
  258.     global htmlCurSel htmlIsSel
  259.     set htmlCurSel [string trim [getSelect]]
  260.     set htmlIsSel [string length $htmlCurSel]
  261. }
  262.  
  263.  
  264. # Insert one or two carriage returns at the insertion point if any
  265. # character preceding the insertion point (on the same line)
  266. # is a non-whitespace character.
  267. proc htmlOpenCR {indent {extrablankline 0}} {
  268.     set end [getPos]
  269.     set start [lineStart $end]
  270.     set text [getText $start $end]
  271.     if {![htmlIsWhite $text]} {
  272.         set r "\r$indent"
  273.         if {$extrablankline} {append r "\r$indent"}
  274.         return $r
  275.     } elseif {$start > 0 } { 
  276.         set prevstart [lineStart [expr $start - 1 ]]
  277.         set text [getText $prevstart [expr $start - 1]]
  278.         if {![htmlIsWhite $text] && $extrablankline} {
  279.             return "\r$indent"
  280.         } else { 
  281.             return [htmlFirstLineIndent $indent]
  282.         }
  283.     } else {
  284.         return [htmlFirstLineIndent $indent]
  285.     }
  286. }
  287.  
  288. # Insert a carriage return at the insertion point if any
  289. # character following the insertion point (on the same line)
  290. # is a non-whitespace character.
  291. proc htmlCloseCR {indent {start ""}} {
  292.     if {$start == ""} {set start [selEnd]}
  293.     if {![htmlIsWhite [getText $start [nextLineStart $start]]]} {
  294.         return "\r$indent"
  295.     }
  296. }
  297.  
  298. # Insert up to two carriage return at the insertion point depending
  299. # on how many blank lines there are after the insertion point.
  300. proc htmlCloseCR2 {indent pos} {
  301.     set blank1 [htmlIsWhite [getText $pos [nextLineStart $pos]]]
  302.     set blank2 [htmlIsWhite [getText $pos [nextLineStart [nextLineStart $pos]]]]
  303.     if {!$blank1} {
  304.         return "\r$indent\r$indent"
  305.     } elseif {!$blank2} {
  306.         return "\r$indent"
  307.     }    
  308. }
  309.  
  310. proc HTML::electricSemi {} {
  311.     global HTMLmodeVars
  312.     if [isSelection] { deleteSelection }
  313.     if {!$HTMLmodeVars(electricSemi) || (![htmlIsInContainer SCRIPT] && ![htmlIsInContainer STYLE])} {
  314.         insertText ";"
  315.         return
  316.     }
  317.     set pos [getPos]
  318.     set start [lineStart $pos]
  319.     set text [getText $start $pos]
  320.     
  321.     if {[string first "for" $text] != "-1"} {
  322.         set lefts 0
  323.         set rights 0
  324.         set len [string length $text]
  325.         for {set i 0} {$i < $len} {incr i} {
  326.             case [string index $text $i] in {
  327.                 "("    { incr lefts }
  328.                 ")"    { incr rights }
  329.             }
  330.         }
  331.         if {$lefts != $rights} {
  332.             insertText ";"
  333.             return
  334.         }
  335.     }
  336.     
  337.     insertText ";\r" [htmlGetIndent $pos]
  338. }
  339.  
  340. #===============================================================================
  341. # Tab key
  342. #===============================================================================
  343.  
  344. # Set up tab mark mechanism.
  345. proc htmlTabGoto {directionIndicator} {
  346.     set searchResult [search -s -n -f $directionIndicator -m 0 -i 1 -r 0 {•} [getPos]]
  347.     if {![llength $searchResult] || [lindex $searchResult 0] >= [maxPos]} {
  348.         beep
  349.         message "Tab mark not found."
  350.         return 0
  351.     } else {
  352.         goto [lindex $searchResult 0]
  353.         return 1
  354.     }
  355. }
  356.  
  357. proc htmlNextTabMark {} {
  358.     if {[htmlTabGoto 1]} {deleteChar}
  359. }
  360.  
  361. proc htmlPreviousTabMark {} {
  362.     if {[htmlTabGoto 0]} {deleteChar}
  363. }
  364.  
  365.  
  366. proc htmlWordComplete {} {
  367.     bind::Completion
  368. }
  369. namespace eval HTML::Completion {}
  370. # If current position is inside a tag, complete the tag or attributes
  371. # being written.
  372. proc HTML::Completion::word {dummy} {
  373.     global htmlPackageToUse htmlElemAttrOptional1 htmlElemAttrOptional3 HTMLmodeVars htmlColorAttr
  374.     global basicColors htmluserColors htmlSpecColor htmlURLAttr htmlSpecURL HTMLmodeVars
  375.     global htmlSpecWindow htmlWindowAttr
  376.     
  377.     if {[htmlIsInContainer SCRIPT]} {return 0}
  378.     if {[htmlIsInContainer STYLE]} {return [CSS::Completion::word dummy]}
  379.     
  380.     set pos [getPos]
  381.     set allTags [array names htmlElemAttrOptional${htmlPackageToUse}]
  382.  
  383.     # Find the tag.
  384.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^ \t\r<>]+} [expr $pos - 1]} left]} {return 0}
  385.     if {![catch {search -s -f 0 -r 0 -m 0 {>} [expr $pos - 1]} right]
  386.     && [lindex $right 1] > [lindex $left 1] && [lindex $right 0] < $pos} {return 0}
  387.     set tag [string toupper [string range [eval getText $left] 1 end]]
  388.     if {$tag == "LI"} {
  389.         set ltype [htmlFindList]
  390.         if {$ltype == "UL"} {
  391.             set tag "LI IN UL"
  392.         } elseif {$ltype == "OL"} {
  393.             set tag "LI IN OL"
  394.         }            
  395.     }
  396.     set tagBegin [expr [lindex $left 0] + 1]
  397.     set tagEnd [lindex $left 1]
  398.     # opening or closing tag
  399.     set opening 1
  400.     if {[string index $tag 0] == "/"} {
  401.         set tag    [string range $tag 1 end]
  402.         incr tagBegin 1
  403.         set opening 0
  404.     }
  405.     # inside < and > or just right of < ?
  406.     if {![catch {search -s -f 1 -r 0 -m 0 {>} $pos} r1] && 
  407.     ![catch {search -s -f 1 -r 0 -m 0 {<} $pos} l1] &&
  408.     [lindex $r1 0] < [lindex $l1 0]} {
  409.         set inside 1
  410.     } else {
  411.         set inside 0
  412.     }
  413.     
  414.     # Are we typing the tag or an attribute?
  415.     if {$tagEnd == $pos} {
  416.         # tag
  417.         set matches ""
  418.         foreach t $allTags {
  419.             if {[string match "$tag*" $t]} {lappend matches $t}
  420.         }
  421.         if {![llength $matches]} {
  422.             select $tagBegin $tagEnd
  423.         } else {
  424.             set newTag [largestPrefix $matches]
  425.             if {!$inside} {
  426.                 append newTag >
  427.                 if {$HTMLmodeVars(useTabMarks) && ($opening || [llength $matches] > 1)} {append newTag •}
  428.             }
  429.             replaceText $tagBegin $tagEnd [htmlSetCase $newTag]
  430.             if {!$inside && ($opening || [llength $matches] > 1)} {goto [expr [getPos] - 1 - $HTMLmodeVars(useTabMarks)]}
  431.         }
  432.     } else {
  433.         # Attribute
  434.         if {!$opening} {return 1}
  435.         # are we between quotes to type the attribute value?
  436.         if {![catch {search -s -f 0 -r 1 -m 0 {=\"[^\"]*\"} [expr $pos - 1]} pos5] &&  [lindex $pos5 0] > $tagBegin &&
  437.         [lindex $pos5 1] > $pos} {
  438.             if {![catch {search -s -f 0 -r 1 -m 0 {[ \t\r\"][^ \t\r\"=]+=\"[^\"]*\"} [expr $pos - 1]} attPos] && [lindex $attPos 0] > $tagBegin && 
  439.             [lindex $attPos 1] > $pos} {
  440.                 set txt [getText [expr [lindex $attPos 0] + 1] [lindex $attPos 1]]
  441.                 regexp {([^=]+=)\"([^\"]*)\"} $txt dum attr val
  442.                 set attr [string toupper $attr]
  443.                 set begin [expr [lindex $attPos 0] + 2 + [string length $attr]]
  444.                 set end [expr [lindex $attPos 1] - 1]
  445.                 set choices [htmlGetChoices $tag]
  446.                 if {[lsearch $choices "$attr*"] < 0} {
  447.                     if {[lsearch -exact [concat [htmlGetRequired $tag] [htmlGetOptional $tag 1]] $attr] < 0} {return 0}
  448.                     set isChoice 0
  449.                     if {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${tag}!=[string trimright $attr =]"] < 0) || \
  450.                     [lsearch -exact $htmlSpecColor "${tag}=[string trimright $attr =]"] >= 0} {
  451.                         set choices [concat $basicColors [array names htmluserColors]]
  452.                     } elseif {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${tag}!=[string trimright $attr =]"] < 0) || \
  453.                     [lsearch -exact $htmlSpecURL "${tag}=[string trimright $attr =]"] >= 0} {
  454.                         set choices $HTMLmodeVars(URLs)
  455.                     } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${tag}!=[string trimright $attr =]"] < 0) || \
  456.                     [lsearch -exact $htmlSpecWindow "${tag}=[string trimright $attr =]"] >= 0} {
  457.                         set choices [concat _self _blank _top _parent $HTMLmodeVars(windows)]
  458.                     } else {
  459.                         return 0
  460.                     }
  461.                 } else {
  462.                     set val [string toupper $val]
  463.                     set isChoice 1
  464.                 }
  465.                 
  466.                 set matches ""
  467.                 foreach c $choices {
  468.                     if {$isChoice && [string match "${attr}$val*" $c]} {
  469.                         lappend matches [string range $c [string length $attr] end]
  470.                     } elseif {!$isChoice && [string match "$val*" $c]} {
  471.                         lappend matches $c
  472.                     }
  473.                 }
  474.                 if {![llength $matches]} {
  475.                     select $begin $end
  476.                 } else {
  477.                     set newval [largestPrefix $matches]
  478.                     if {$isChoice} {set newval [htmlSetCase $newval]}
  479.                     replaceText $begin $end $newval
  480.                 }
  481.                 return 1
  482.             }
  483.         }
  484.  
  485.         # we are typing the attribute itself.
  486.         set addSpace 0
  487.         if {[set c [lookAt [getPos]]] != " " && $c != ">"} {set addSpace 1} 
  488.         backwardWord
  489.         set attrBegin [getPos]
  490.         set attrEnd $pos
  491.         set attr [string toupper [getText $attrBegin $attrEnd]]
  492.         set eventAtts [htmlGetEvent $tag]
  493.         set allAttrs [concat [htmlGetRequired $tag] [htmlGetOptional $tag 1] [string toupper $eventAtts]]
  494.         set matches ""
  495.         foreach t $allAttrs {
  496.             if {[string match "$attr*" $t]} {lappend matches $t}
  497.         }
  498.         if {![llength $matches]} {
  499.             select $attrBegin $attrEnd
  500.         } else {
  501.             if {[lookAt [expr $attrBegin - 1]] == "\""} {set newAttr " "}
  502.             append newAttr [largestPrefix $matches]
  503.             if {[set i [lsearch [string toupper $eventAtts] "$newAttr*"]] >= 0} {
  504.                 set newAttr [string range [lindex $eventAtts $i] 0 [expr [string length $newAttr] - 1]]
  505.             } else {
  506.                 set newAttr [htmlSetCase $newAttr]
  507.             }
  508.             set backup 1
  509.             if {[llength $matches] == 1} {
  510.                 if {[regexp {=} $newAttr]} {
  511.                     append newAttr "\"\""
  512.                     if {$HTMLmodeVars(useTabMarks)} {append newAttr •}
  513.                 }
  514.                 if {$addSpace} {append newAttr " "; set backup 2} 
  515.             }
  516.             replaceText $attrBegin $attrEnd $newAttr
  517.             if {[llength $matches] == 1 && [regexp {=} $newAttr]} {goto [expr [getPos] - $backup - $HTMLmodeVars(useTabMarks)]}
  518.         }
  519.     }
  520.     return 1
  521. }
  522.  
  523.  
  524. #===============================================================================
  525. # Building tags, including element attributes
  526. #===============================================================================
  527.  
  528. # A couple of functions to get element variables from the right package.
  529. proc htmlGetSomeAttrs {item type num1 pkg} {
  530.     global htmlElem${type}$num1  htmlElem${type}3
  531.     if {[catch {set atts [set htmlElem${type}${pkg}($item)]}]} { 
  532.         if {$type == "AttrMore"} {
  533.             set atts 0
  534.         } else {
  535.             set atts {} 
  536.         }
  537.     }
  538.     return $atts
  539. }    
  540.  
  541. proc htmlGetRequired {item} {
  542.     global htmlPackageToUse
  543.     return [htmlGetSomeAttrs $item AttrRequired 1 $htmlPackageToUse]
  544. }
  545.  
  546. proc htmlGetOptional {item {all 0}} {
  547.     global htmlPackageToUse HTMLmodeVars htmlElemHideNetscape htmlElemHideIE
  548.     set attrs [htmlGetSomeAttrs $item AttrOptional 1 $htmlPackageToUse]
  549.     if {$all} {return $attrs}
  550.     if {$HTMLmodeVars(hideStyleAttrs)} {
  551.         foreach a {CLASS= ID= STYLE=} {
  552.             if {[set w [lsearch -exact $attrs $a]] >= 0} {
  553.                 set attrs [lreplace $attrs $w $w]
  554.             }
  555.         }
  556.     }
  557.     if {$htmlPackageToUse == 3} {return $attrs}
  558.     foreach b {Netscape IE} {
  559.         if {[set HTMLmodeVars(hide${b})] && [info exists htmlElemHide${b}($item)]} {
  560.             foreach a [set htmlElemHide${b}($item)] {
  561.                 set attrs [lreplace $attrs [set i [lsearch -exact $attrs $a]] $i]
  562.             }
  563.         }
  564.     }
  565.     return $attrs
  566. }
  567.  
  568. proc htmlGetNumber {item} {
  569.     global htmlPackageToUse
  570.     return [htmlGetSomeAttrs $item AttrNumber 1 $htmlPackageToUse]
  571. }
  572.  
  573.  
  574. proc htmlGetChoices {item} {
  575.     global htmlPackageToUse
  576.     return [htmlGetSomeAttrs $item AttrChoices 1 $htmlPackageToUse]
  577. }
  578.  
  579. proc htmlGetEvent {item} {
  580.     global htmlPackageToUse
  581.     return [htmlGetSomeAttrs $item EventHandler 1 $htmlPackageToUse]
  582. }
  583.  
  584. proc htmlGetUsed {item {reqatts ""} {optatts ""}} {
  585.     global htmlPackageToUse
  586.     if {$htmlPackageToUse == 1} {
  587.         set num ""
  588.     } else {
  589.         set num 3
  590.     }
  591.     set useatts [htmlGetSomeAttrs $item AttrUsed "" $num]
  592.     if {$reqatts == ""} {set reqatts [htmlGetRequired $item]}
  593.     if {$optatts == ""} {set optatts [htmlGetOptional $item]}
  594.     # Add missing required attributes.
  595.     foreach a $reqatts {
  596.         if {[lsearch -exact $useatts $a] < 0} {
  597.             set useatts "$a $useatts"
  598.         }
  599.     }
  600.     # Remove extra attributes
  601.     foreach a $useatts {
  602.         if {[lsearch -exact $reqatts $a] < 0 && [lsearch -exact $optatts $a] < 0} {
  603.             set where [lsearch -exact $useatts $a]
  604.             set useatts [lreplace $useatts $where $where]
  605.         }
  606.     }
  607.     return $useatts
  608. }
  609.  
  610. proc htmlGetAttrMore {item} {
  611.     global htmlPackageToUse
  612.     if {$htmlPackageToUse == 1} {
  613.         set num ""
  614.     } else {
  615.         set num 3
  616.     }
  617.     return [htmlGetSomeAttrs $item AttrMore "" $num]
  618. }
  619.  
  620. proc htmlOpenElem {elem {used ""} {pos -1}} {
  621.     global HTMLmodeVars 
  622.     if {$HTMLmodeVars(useBigWindows)} {
  623.         return [htmlOpenElemWindow $elem $used $pos]
  624.     } else {
  625.         return [htmlOpenElemStatusBar $elem $used $pos]
  626.     }
  627. }
  628.  
  629. # Opening or only tag of an element - include attributes
  630. # Big window with all attributes.
  631. # Return empty string if user clicks "Cancel".
  632.  
  633. proc htmlOpenElemWindow {elem used wrPos {values ""} {addNotUsed 0} {addHidden 0} {absPos ""}} {
  634.     global HTMLmodeVars  htmlColorName htmlElemEventHandler1
  635.     global  htmluserColors basicColors htmlPackageToUse
  636.     global htmlURLAttr htmlColorAttr  htmlWindowAttr
  637.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  638.     
  639.     set URLs $HTMLmodeVars(URLs)
  640.     set Windows {_self _top _parent _blank}
  641.     if {[llength $HTMLmodeVars(windows)]} {append Windows " - " $HTMLmodeVars(windows)}
  642.     
  643. # put users colours first
  644.     set htmlColors [lsort [array names htmluserColors]]
  645.      append htmlColors " - " $basicColors
  646.  
  647.     if {![string length $used]} {set used $elem}
  648.     set elem [string toupper $elem]
  649.     set used [string toupper $used]
  650.     
  651.     # get variables for the element
  652.     set reqatts [htmlGetRequired $used]
  653.     set numatts [htmlGetNumber $used]
  654.     set optatts [htmlGetOptional $used]
  655.     set alloptatts [htmlGetOptional $used 1]
  656.     set choiceatts [htmlGetChoices $used]
  657.     set notUsedAtts ""
  658.     if {$HTMLmodeVars(useAttsApplyToDialogs)} {
  659.         set allatts [htmlGetUsed $used $reqatts $optatts]
  660.         foreach a $optatts {
  661.             if {[lsearch -exact $allatts $a] < 0} {
  662.                 lappend notUsedAtts $a
  663.             }
  664.         }
  665.     } else {
  666.         set allatts [concat $reqatts $optatts]
  667.     }
  668.     set reallyAllAtts [concat $reqatts $alloptatts]
  669.     foreach a $alloptatts {
  670.         if {[lsearch -exact $optatts $a] < 0} {
  671.             lappend hiddenAtts $a
  672.         }
  673.     }
  674.     if {$addNotUsed} {
  675.         append allatts " $notUsedAtts"
  676.         set notUsedAtts ""
  677.     }
  678.     if {$addHidden} {append allatts " $hiddenAtts"}
  679.     # optionally include event handlers
  680.     if {$HTMLmodeVars(inclEventHandler)} {
  681.         set eventatts [htmlGetEvent $used]
  682.         append allatts " " $eventatts
  683.     } else {
  684.         set eventatts ""
  685.     }
  686.  
  687.     # if there are attributes to ask about, do so
  688.  
  689.     set text "<"
  690.     append text  [htmlSetCase $elem]
  691.     if {![llength $allatts]} {return "$text>"}
  692.  
  693.     set maxHeight [expr [lindex [getMainDevice] 3] - 115]
  694.     set thisPage "Page 1"
  695.  
  696.     set widthIndex -1
  697.     set heightIndex -1
  698.     if {$absPos == ""} {set absPos [getPos]}
  699.     # build window with attributes 
  700.     set invalidInput 1
  701.     while {$invalidInput} {
  702.         # wrapping
  703.         set htmlWrapPos [expr $wrPos == -1 ? [lindex [posToRowCol [getPos]] 1] : $wrPos]
  704.         incr htmlWrapPos [expr [string length $text] + 1]
  705.         while {1} {
  706.             if {$used == "LI IN UL" || $used == "LI IN OL"} {
  707.                 set pr LI
  708.             } else {
  709.                 set pr $used
  710.             }
  711.             set box1 "-t {Attributes for $pr} 120 10 450 25"
  712.             set box2 "-t {Attributes for $pr} 120 10 450 25"
  713.             set box3 "-t {Attributes for $pr} 120 10 450 25"
  714.             set page 1
  715.             set attrtypes {}
  716.             set fileIndex ""
  717.             set colorIndex ""
  718.             set wpos 10
  719.             if {[string length $reqatts]} {
  720.                 lappend box$page -p 120 30 270 31 -t {Required attributes} 10 35 200 50
  721.                 set hpos 60
  722.             } else {
  723.                 set hpos 30
  724.             }
  725.             set attrIndex 2
  726.             for {set i 0} {$i < [llength $allatts]} {incr i} {
  727.                 set attr [lindex $allatts $i]
  728.                 if {$i == [llength $reqatts]} {
  729.                     if {$wpos > 20} { incr hpos 20 }
  730.                     lappend box$page -p 120 $hpos 270 [expr $hpos + 1] \
  731.                     -t {Optional attributes} 10 [expr $hpos + 5] 200 [expr $hpos + 20]
  732.                     set wpos 10
  733.                     incr hpos 30
  734.                 }
  735.                 set a2 [string trimright $attr =]
  736.                 if {[string index $attr [expr [string length $attr] - 1]] != "="}  { 
  737.                     # Flag
  738.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  739.                         incr page
  740.                         set hpos 40
  741.                     }
  742.                     lappend box$page -c $attr [lindex $values $attrIndex] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]
  743.                     incr attrIndex 
  744.                     if {$wpos > 20} { 
  745.                         incr hpos 25
  746.                         set wpos 10
  747.                     } else {
  748.                         set wpos 230
  749.                     }
  750.                     lappend attrtypes flag
  751.                 } elseif {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${used}!=$a2"] < 0) || \
  752.                 [lsearch -exact $htmlSpecURL "${used}=$a2"] >= 0} { 
  753.                     # URL
  754.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}
  755.                     if {[expr $hpos + 45] > $maxHeight && $page < 3} {
  756.                         incr page
  757.                         set hpos 40
  758.                     }
  759.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  760.                     -e [lindex $values $attrIndex] 120 $hpos 450 [expr $hpos + 15] \
  761.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] $URLs] \
  762.                     120 [expr $hpos + 25] 450 [expr $hpos + 35] \
  763.                     -b "File…" 10 [expr $hpos + 20] 70 [expr $hpos + 40]
  764.                     incr attrIndex 3
  765.                     incr hpos 50
  766.                     lappend attrtypes url
  767.                     lappend fileIndex [expr $attrIndex - 1]
  768.                 } elseif {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${used}!=$a2"] < 0) || \
  769.                 [lsearch -exact $htmlSpecColor "${used}=$a2"] >= 0} { 
  770.                     # Color attribute
  771.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  772.                     if {[expr $hpos + 25] > $maxHeight && $page < 3} {
  773.                         incr page
  774.                         set hpos 40
  775.                     }
  776.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  777.                     -e [lindex $values $attrIndex] 120 $hpos 190 [expr $hpos + 15] \
  778.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] $htmlColors] \
  779.                     200 $hpos 340 [expr $hpos + 15] \
  780.                     -b "New Color…" 350 $hpos 450 [expr $hpos + 20]
  781.                     incr attrIndex 3
  782.                     incr hpos 30
  783.                     lappend attrtypes color
  784.                     lappend colorIndex [expr $attrIndex - 1]
  785.                 } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${used}!=$a2"] < 0) || \
  786.                 [lsearch -exact $htmlSpecWindow "${used}=$a2"] >= 0} { 
  787.                     # Window attribute
  788.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  789.                     if {[expr $hpos + 25] > $maxHeight && $page < 3} {
  790.                         incr page
  791.                         set hpos 40
  792.                     }
  793.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  794.                     -e [lindex $values $attrIndex] 120 $hpos 240 [expr $hpos + 15] \
  795.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] \
  796.                     $Windows] \
  797.                     250 $hpos 440 [expr $hpos + 15]
  798.                     incr attrIndex 2
  799.                     incr hpos 30
  800.                     lappend attrtypes window
  801.                 } elseif {[lsearch $numatts "${attr}*"] >= 0} { 
  802.                     # Number
  803.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  804.                         incr page
  805.                         set hpos 40
  806.                     }
  807.                     if {$attr == "WIDTH="} {set widthIndex $attrIndex}
  808.                     if {$attr == "HEIGHT="} {set heightIndex $attrIndex}
  809.                     lappend box$page -t $attr $wpos $hpos [expr $wpos + 100] [expr $hpos + 15] \
  810.                     -e [lindex $values $attrIndex] [expr $wpos + 110] $hpos [expr $wpos + 150] [expr $hpos + 15]
  811.                     incr attrIndex 
  812.                     if {$wpos > 20} { 
  813.                         incr hpos 25
  814.                         set wpos 10
  815.                     } else {
  816.                         set wpos 230
  817.                     }
  818.                     lappend attrtypes number
  819.                 } elseif {[lsearch $choiceatts "${attr}*"] >= 0} { 
  820.                     # Choices
  821.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  822.                         incr page
  823.                         set hpos 40
  824.                     }
  825.                     set matches {}
  826.                     foreach w $choiceatts {
  827.                         if {[string match "${attr}*" $w]} {
  828.                             lappend matches  [string range $w [string length $attr] end]
  829.                         }    
  830.                     }
  831.                     lappend box$page -t $attr $wpos $hpos [expr $wpos + 100] [expr $hpos + 15] \
  832.                     -m [concat [list [lindex $values $attrIndex] {No value}] $matches] \
  833.                     [expr $wpos + 110] $hpos [expr $wpos + 205] [expr $hpos + 15]
  834.                     incr attrIndex 
  835.                     if {$wpos > 20} { 
  836.                         incr hpos 25 
  837.                         set wpos 10
  838.                     } else {
  839.                         set wpos 230
  840.                     }    
  841.                     lappend attrtypes choices
  842.                 } else {
  843.                     # Any other
  844.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  845.                     if {[expr $hpos + 20] > $maxHeight && $page < 3} {
  846.                         incr page
  847.                         set hpos 40
  848.                     }
  849.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  850.                     -e [lindex $values $attrIndex] 120 $hpos 450 [expr $hpos + 15] 
  851.                     incr attrIndex
  852.                     incr hpos 25
  853.                     lappend attrtypes any
  854.                 }
  855.             }
  856.             if {$wpos > 20} { incr hpos 25 }
  857.             
  858.             if {$page == 1} {
  859.                 set box $box1
  860.             } elseif {$page == 2} {
  861.                 set hpos $maxHeight
  862.                 set box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2"
  863.             } elseif {$page == 3} {
  864.                 set hpos $maxHeight
  865.                 set box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\} \{Page 3\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2 -n \{Page 3\} $box3"
  866.             }
  867.             # Add More button if hidden attrs
  868.             set moreButton 0
  869.             if {[llength $reallyAllAtts] > [llength $allatts]} {
  870.                 set box " -b More… 200 [expr $hpos + 20] 265 [expr $hpos + 40] $box"
  871.                 set moreButton 1
  872.             }
  873.             set values [eval [concat dialog -w 460 -h [expr $hpos + 50] \
  874.             -b OK 20 [expr $hpos + 20]  85 [expr $hpos + 40] \
  875.             -b Cancel 110 [expr $hpos + 20] 175 [expr $hpos + 40] $box]]
  876.             
  877.             # More button clicked?
  878.             if {[llength $reallyAllAtts] > [llength $allatts] && [lindex $values 2]} {
  879.                 if {[llength $notUsedAtts]} {
  880.                     append allatts " $notUsedAtts"
  881.                     set notUsedAtts ""
  882.                 } else {
  883.                     append allatts " $hiddenAtts"
  884.                 }
  885.             }
  886.             # If more button...
  887.             if {$moreButton} {
  888.                 set values [lreplace $values 2 2]
  889.             }
  890.             # If two pages...
  891.             if {$page > 1} {
  892.                 set thisPage [lindex $values 2]
  893.                 set values [lreplace $values 2 2]
  894.             }
  895.             # OK button clicked?
  896.             if {[lindex $values 0] } { break }
  897.             # Cancel button clicked?
  898.             if {[lindex $values 1] } { return}
  899.             # File button clicked?
  900.             foreach fl $fileIndex {
  901.                 if {[lindex $values $fl] && [string length [set newFile [htmlGetFile]]]} {
  902.                     set URLs $HTMLmodeVars(URLs)
  903.                     set values [lreplace $values [expr $fl - 1] [expr $fl - 1] [lindex $newFile 0]]
  904.                     if {$used == "IMG" && $fl == 4 && [llength [set widhei [lindex $newFile 1]]]} {
  905.                         if {$widthIndex >= 0} {set values [lreplace $values $widthIndex $widthIndex [lindex $widhei 0]]}
  906.                         if {$heightIndex >= 0} {set values [lreplace $values $heightIndex $heightIndex [lindex $widhei 1]]}
  907.                     }
  908.                 }
  909.             }
  910.             # Color button clicked?
  911.             foreach cl $colorIndex {
  912.                 if {[lindex $values $cl] && [string length [set newcolor [htmlAddNewColor]]]} {
  913.                     set htmlColors [concat [list $newcolor] $htmlColors]
  914.                     set values [lreplace $values [expr $cl - 1] [expr $cl - 1] "$newcolor"]
  915.                 }
  916.             }
  917.         }
  918.         
  919.  
  920.         # put everything together
  921.         set attrtext ""
  922.         set errtext ""
  923.  
  924.         set j 2
  925.         for {set i 0} {$i < [llength $attrtypes]} {incr i} {
  926.             set attr [lindex $allatts $i]                
  927.             switch [lindex $attrtypes $i] {
  928.                 url {
  929.                     set texturl [string trim [lindex $values $j]]
  930.                     set menuurl [lindex $values [expr $j + 1]]
  931.                     if {[string length $texturl]} {        
  932.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $texturl]]"]
  933.                         htmlAddToCache URLs $texturl
  934.                     } elseif {$menuurl != "No value"} {
  935.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $menuurl]]"] 
  936.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  937.                         lappend errtext "$attr required."
  938.                     }
  939.                     incr j 3
  940.                 }
  941.                 color {
  942.                     set colortxt [lindex $values $j]
  943.                     set colorval [lindex $values [expr $j + 1]]
  944.                     if {[string length $colortxt]} {
  945.                         set col [htmlCheckColorNumber $colortxt]
  946.                                  if {$col == 0} {
  947.                                      lappend errtext "$attr: $colortxt is not a valid color number."
  948.                         } else {    
  949.                             append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $col]"]
  950.                         }
  951.                     } elseif {$colorval != "No value"} {
  952.                         # Users own color?
  953.                         if {[info exists htmluserColors($colorval)]} {
  954.                             set colornum $htmluserColors($colorval)
  955.                         }
  956.                         # Predefined color?
  957.                         if {[info exists htmlColorName($colorval)]} {
  958.                             set colornum $htmlColorName($colorval)
  959.                         }
  960.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $colornum]"]
  961.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  962.                         lappend errtext "$attr required."
  963.                     }
  964.                     incr j 3
  965.                 }
  966.                 window {
  967.                     set textwin [string trim [lindex $values $j]]
  968.                     set menuwin [lindex $values [expr $j + 1]]
  969.                     if {[string length $textwin]} {        
  970.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $textwin]"]
  971.                         htmlAddToCache windows $textwin
  972.                     } elseif {$menuwin != "No value"} {
  973.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $menuwin]"]
  974.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  975.                         lappend errtext "$attr required."
  976.                     }
  977.                     incr j 2
  978.                 }
  979.                 number {
  980.                     set numval [string trim [lindex $values $j]]
  981.                     if {[string length $numval]} {
  982.                         if {[htmlCheckAttrNumber $used $attr $numval] == 1} {        
  983.                             append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $numval]"]
  984.                         } else {
  985.                             lappend errtext "$attr: [htmlCheckAttrNumber $used $attr $numval]"
  986.                         }
  987.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  988.                         lappend errtext "$attr required."
  989.                     }
  990.                     incr j
  991.                 }
  992.                 choices {
  993.                     set choiceval [lindex $values $j]
  994.                     if {$choiceval != "No value"} {        
  995.                         set qchoice [htmlAddQuotes $choiceval]
  996.                         if {($used != "LI IN OL" && $used != "OL") || $attr != "TYPE="} {
  997.                             set qchoice [htmlSetCase $qchoice]
  998.                         }
  999.                         append attrtext [htmlWrapTag "[htmlSetCase $attr]$qchoice"]
  1000.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  1001.                         lappend errtext "$attr required."
  1002.                     }
  1003.                     incr j
  1004.                 }
  1005.                 any {
  1006.                     set anyval [lindex $values $j]
  1007.                     # Trim only if it's only spaces.
  1008.                     if {[string trim $anyval] == ""} {set anyval ""}
  1009.                     if {[string length $anyval]} {
  1010.                         htmlOpenExtraThings $used $attr $anyval
  1011.                         if {[lsearch -exact $eventatts $attr] < 0} {
  1012.                             set attr [htmlSetCase $attr]
  1013.                         }
  1014.                         append attrtext [htmlWrapTag "$attr[htmlAddQuotes $anyval]"]
  1015.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  1016.                         lappend errtext "$attr required."
  1017.                     }
  1018.                     incr j
  1019.                 }
  1020.                 flag {
  1021.                     set flagval [lindex $values $j]
  1022.                     if {$flagval} {        
  1023.                         append attrtext [htmlWrapTag [htmlSetCase $attr]]
  1024.                     }
  1025.                     incr j
  1026.                 }
  1027.             }
  1028.         }    
  1029.         # If everything is OK, add the attribute text to text.
  1030.         if {![llength $errtext]} {
  1031.             append text $attrtext
  1032.             set invalidInput 0
  1033.         } else {
  1034.             # Put up alert with the error text.
  1035.             htmlErrorWindow "Invalid input for $used" $errtext
  1036.         }
  1037.         # Some tests that input is ok.
  1038.         if {!$invalidInput} {set invalidInput [htmlFontBaseTest $text alertnote]}
  1039.         if {!$invalidInput && $elem == "A" && [set invalidInput [htmlATest $text alertnote]]} {
  1040.             set text "<[htmlSetCase A]"
  1041.         }
  1042.         if {!$invalidInput && $elem == "FRAMESET" && [set invalidInput [htmlFramesetTest $text alertnote]]} {
  1043.             set text "<[htmlSetCase FRAMESET]"
  1044.         }
  1045.         if {!$invalidInput && $elem == "SPACER" && [set invalidInput [htmlSpacerTest $text alertnote]]} {
  1046.             set text "<[htmlSetCase SPACER]"
  1047.         }
  1048.         if {!$invalidInput && $elem == "AREA" && [set invalidInput [htmlAreaTest $text alertnote]]} {
  1049.             set text "<[htmlSetCase AREA]"
  1050.         }
  1051.     }
  1052.     
  1053.     if {[string length $text] } {append text ">"}
  1054.     
  1055.     return ${text}
  1056. }
  1057.  
  1058. proc htmlWrapTag {toadd} {
  1059.     global fillColumn HTMLmodeVars
  1060.     upvar htmlWrapPos wrpos absPos ap
  1061.     if {!$HTMLmodeVars(wordWrap)} {return " $toadd"}
  1062.     incr wrpos [string length $toadd]
  1063.     if {$wrpos > $fillColumn} {
  1064.         set ind [htmlGetIndent $ap]
  1065.         set wrpos [string length "$ind$toadd"]
  1066.         return "\r$ind$toadd"
  1067.     } else {
  1068.         return " $toadd"
  1069.     }
  1070. }
  1071.  
  1072. # these two require at least one of several optional attributes
  1073. proc htmlFontBaseTest {text cmd} {
  1074.     if {[string toupper $text] == "<FONT" || [string toupper $text] == "<BASEFONT" ||
  1075.     [string toupper $text] == "<BASE" || [string toupper $text] == "<SPAN"} {  
  1076.         eval {$cmd "At least one of the attributes is required."}
  1077.         return 1
  1078.     }
  1079.     return 0
  1080. }
  1081.  
  1082. # HREF or NAME must be used for A.
  1083. proc htmlATest {text cmd} {
  1084.     if {![regexp -nocase {href=} $text] && ![regexp -nocase {name=} $text]} {
  1085.         eval {$cmd "At least one of the attributes HREF and NAME must be used."}
  1086.         return 1
  1087.     }
  1088.     return 0
  1089. }
  1090.  
  1091. # ROWS or COLS must be used for FRAMESET
  1092. proc htmlFramesetTest {text cmd} {
  1093.     if {![regexp -nocase {rows=} $text] && ![regexp -nocase {cols=} $text]} {
  1094.         eval {$cmd "At least one of the attributes ROWS and COLS must be used."}
  1095.         return 1
  1096.     }
  1097.     return 0
  1098. }
  1099.  
  1100. # Some checks for SPACER.
  1101. proc htmlSpacerTest {text cmd} {
  1102.         set horver [regexp -nocase {type=\"(horizontal|vertical)\"} $text]
  1103.         set wh [regexp -nocase {width=|height=} $text]
  1104.         set sz [regexp -nocase {size=} $text]
  1105.         set al [regexp -nocase {align=} $text]
  1106.         set invalidInput 1
  1107.         if {$horver && ($wh || $al)} {
  1108.             eval {$cmd "WIDTH, HEIGHT and ALIGN should only be used when TYPE=BLOCK."}
  1109.         } elseif {!$horver && $sz} {
  1110.             eval {$cmd "SIZE should only be used when TYPE=HORIZONTAL or VERTICAL."}
  1111.         } elseif {$horver && !$sz} {
  1112.             eval {$cmd "SIZE is required when TYPE=HORIZONTAL or VERTICAL."}
  1113.         } elseif {!$horver && !$wh} {
  1114.             eval {$cmd "WIDTH or HEIGHT is required when TYPE=BLOCK."}
  1115.         } else {
  1116.             set invalidInput 0
  1117.         }
  1118.         return $invalidInput
  1119. }
  1120.  
  1121. # For AREA, either HREF or NOHREF must be used, but not both.
  1122. proc htmlAreaTest {text cmd} {
  1123.     set hasHref [regexp -nocase {href=} $text]
  1124.     set hasNohref [regexp -nocase {nohref} $text]
  1125.     set hasCoords [regexp -nocase {coords=} $text]
  1126.     set shapeDefault [regexp -nocase {shape=\"default\"} $text]
  1127.     set invalidInput 0
  1128.     if {($hasHref && $hasNohref) || (!$hasHref && !$hasNohref)} {
  1129.         eval {$cmd "One of the attributes HREF and NOHREF must be used, but not both."}
  1130.         set invalidInput 1
  1131.     } elseif {!$hasCoords && !$shapeDefault} {
  1132.         eval {$cmd "COORDS= is required if SHAPE≠DEFAULT"}
  1133.         set invalidInput 1
  1134.     }
  1135.     return $invalidInput
  1136. }
  1137.  
  1138. # Adds a NAME= value to cache.
  1139. proc htmlOpenExtraThings {elem attr val} {
  1140.     if {[lsearch -exact {A MAP} $elem] >= 0 && $attr == "NAME="} {
  1141.         htmlAddToCache URLs "#$val"
  1142.     }
  1143.     if {$elem == "FRAME" && $attr == "NAME="} {
  1144.         htmlAddToCache windows $val
  1145.     }
  1146. }
  1147.  
  1148.  
  1149. # Check if a input is a valid number for the element attribute.
  1150. # Returns 1 if it is, otherwise returns an error message.
  1151. proc htmlCheckAttrNumber {item attr number} {
  1152.     
  1153.     set attrNumbers [htmlGetNumber $item]
  1154.     set numind [lsearch $attrNumbers "${attr}*"]
  1155.     set numstr [string range [lindex $attrNumbers $numind] [string length $attr] end]
  1156.     regexp {^[-i0-9]+} $numstr minvalue
  1157.     set numstr [string range $numstr [expr [string length $minvalue] + 1] end]
  1158.     regexp {^[-i0-9]+} $numstr maxvalue
  1159.     set procent [string range $numstr [expr [string length $numstr] - 1] end]
  1160.     if {$procent == "%"} {
  1161.         set procerr " or percentage"
  1162.     } else {
  1163.         set procerr ""
  1164.     }
  1165.     if {$minvalue == "-i"} {
  1166.         set errtext "An integer"
  1167.     } elseif {$maxvalue == "i"} {
  1168.         set errtext "A number $minvalue or greater"
  1169.     } else {
  1170.         set errtext "A number in the range $minvalue to $maxvalue"
  1171.     }
  1172.     if {$item == "FONT"} { append errtext " or -6 to +6"}
  1173.     append errtext  "$procerr expected." 
  1174.     # Is percent allowed?
  1175.     if {[string index $number [expr [string length $number] - 1]] == "%" } {
  1176.         set number [string range $number 0 [expr [string length $number] - 2]]
  1177.         if {$procent != "%"} {return $errtext}
  1178.     }
  1179.     # FONT can take values -6 - +6. Special case.
  1180.     if {$item == "FONT" && [regexp {^(\+|-)[1-6]$} $number]} { return 1}
  1181.     # Is input a number?
  1182.     if {![regexp {^-?[0-9]+$} $number]} {return $errtext}
  1183.     # Is input in the valid range?
  1184.     if {( $maxvalue != "i" && $number > $maxvalue ) || ( $minvalue != "-i" && $number < $minvalue ) } {
  1185.         return $errtext
  1186.     }    
  1187.     return 1 
  1188. }
  1189.  
  1190.  
  1191. # Add quotes to attribute
  1192. proc htmlAddQuotes {v} {
  1193.  
  1194.     if {[string range $v 0 0] != "\""} {set v  "\"$v"}
  1195.      set vlen [expr [string length $v] - 1]
  1196.     if {[string range $v $vlen $vlen] !="\""} {append v "\""}
  1197.     return $v
  1198. }
  1199.  
  1200.  
  1201. # Splits an attribute into its name and value and remove quotes.
  1202. proc htmlRemoveQuotes {attrStr} {
  1203.     # Is it a flag?
  1204.     if {![string match "*=*" $attrStr]} {return [string toupper $attrStr]}
  1205.     
  1206.     set attr [string range $attrStr 0 [string first "=" $attrStr]]
  1207.     # Get the attribute value.
  1208.     set attrVal [string range $attrStr [expr [string first "=" $attrStr] + 1] end]
  1209.     
  1210.     return [list $attr [string trim $attrVal \"]]
  1211. }
  1212.  
  1213. # Returns a list of the attributes not used for the tag at the current position.
  1214. proc htmlGetAttributes {} {
  1215.     set pos [getPos]
  1216.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^<>]+>} $pos} res] || [lindex $res 1] < $pos} {
  1217.         message "Current position is not at a tag."
  1218.         return
  1219.     }
  1220.     set tag [string trim [lindex [set all [string toupper [eval getText $res]]] 0] "<>"]
  1221.     if {$tag == "LI"} {
  1222.         set ltype [htmlFindList]
  1223.         if {$ltype == "UL"} {
  1224.             set tag "LI IN UL"
  1225.         } elseif {$ltype == "OL"} {
  1226.             set tag "LI IN OL"
  1227.         }            
  1228.     }
  1229.     # All INPUT elements are defined differently. Must extract TYPE.
  1230.     if {$tag == "INPUT"} {
  1231.         if {![regexp { TYPE=\"?([^ \t\r\"]+)\"?} $all dum tag]} {
  1232.             message "INPUT element without a TYPE attribute."
  1233.             return
  1234.         } 
  1235.     }
  1236.     set ret ""
  1237.     foreach a [concat [htmlGetRequired $tag] [htmlGetOptional $tag 1] [htmlGetEvent $tag]] {
  1238.         set exp "\[ \t\r\n\]+${a}"
  1239.         if {![regexp -nocase $exp $all]} {
  1240.             lappend ret $a
  1241.         }
  1242.     }
  1243.     if {$ret == ""} {message "No attributes."}
  1244.     return $ret
  1245. }
  1246.  
  1247. # Inserts an attribute in a tag at the current position.
  1248. proc htmlInsertAttributes {{attrList ""}} {
  1249.     global HTMLmodeVars fillColumn
  1250.     set useMarks $HTMLmodeVars(useTabMarks)
  1251.     if {$attrList == "" && ([set l [htmlGetAttributes]] == "" ||
  1252.     [catch {listpick -p "Select attributes" -l $l} attrList] || $attrList == "") } {return}
  1253.     foreach attr $attrList {
  1254.         set epos [expr [lindex [search -s -f 0 -r 1 -m 0 {<[^<>]+>} [getPos]] 1] - 1]
  1255.         if {[expr [lindex [posToRowCol $epos] 1] + [string length $attr]] > $fillColumn && $HTMLmodeVars(wordWrap)} {
  1256.             set text "\r[htmlGetIndent $epos]"
  1257.         } else {
  1258.             set text " "
  1259.         }
  1260.         append text $attr
  1261.         if {[string match "*=" $attr]} {
  1262.             append text "\"\""
  1263.             if {$useMarks} {append text •}        
  1264.         }
  1265.         set x [expr $epos - 3]
  1266.         if {[string match "*•" [set etxt [getText $x $epos]]]} {
  1267.             set p [expr $x + 1]
  1268.             if {$useMarks} {
  1269.                 if {[string match "*=" $attr]} {
  1270.                     set text [string range $text 0 [expr [string length $text] - 3]]•\"•
  1271.                 } else {
  1272.                     append text •
  1273.                 }
  1274.             }
  1275.             replaceText [expr $p + 1] $epos $text
  1276.         } else {
  1277.             goto $epos
  1278.             insertText $text
  1279.             if {[regexp {=} $text]} {goto [expr + [getPos] - 1 - $useMarks]}
  1280.         }
  1281.     }
  1282. }
  1283.  
  1284. #===============================================================================
  1285. # Element build routines
  1286. #===============================================================================
  1287.  
  1288. # Closing tag of an element
  1289. proc htmlCloseElem {theElem} {
  1290.     return "</[htmlSetCase $theElem]>"
  1291. }
  1292.  
  1293.  
  1294. proc htmlTag {str} {
  1295.     global htmlElemProc
  1296.     set elem [lindex $str 1]
  1297.     if {[htmlIsInContainer STYLE]} {
  1298.         if {[htmlIsInputElement $elem]} {set elem INPUT}
  1299.         replaceText [getPos] [selEnd] $elem
  1300.     } elseif {[info exists htmlElemProc($elem)]} {
  1301.         eval $htmlElemProc($elem)
  1302.     } else {
  1303.         eval $str
  1304.     }
  1305. }
  1306.  
  1307. # Build elements with only a opening tag.
  1308. proc htmlBuildOpening {ftype {begCR 0} {endCR 0} {attr ""}} {
  1309.     set text1 ""
  1310.     set indent [htmlGetIndent [getPos]]
  1311.     if {$begCR} { 
  1312.         set text1 [htmlOpenCR $indent]
  1313.     }
  1314.     set text [htmlOpenElem $ftype $attr]
  1315.     if {![string length $text]} {return}
  1316.     if {$endCR} {
  1317.         append text [htmlCloseCR $indent]
  1318.     }
  1319.     insertText $text1 $text
  1320. }
  1321.  
  1322.     
  1323. # This is used for almost all containers
  1324. proc htmlBuildElem {ftype {attr ""}} {
  1325.     global HTMLmodeVars htmlCurSel htmlIsSel
  1326.  
  1327.     if {![string length [set text [htmlOpenElem $ftype $attr]]]} {return}
  1328.     htmlGetSel
  1329.     append text $htmlCurSel
  1330.     set currpos [expr [getPos] + [string length $text]]
  1331.     append text [htmlCloseElem $ftype]
  1332.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1333.     if {$htmlIsSel} {
  1334.         replaceText [getPos] [selEnd] $text
  1335.     } else {
  1336.         insertText $text
  1337.         goto $currpos
  1338.     }
  1339. }
  1340.  
  1341. # This is used for elements that should be surrounded by newlines
  1342. proc htmlBuildCRElem {ftype {extrablankline 0} {attr ""}} {
  1343.     global htmlCurSel htmlIsSel HTMLmodeVars
  1344.  
  1345.     if {![string length [set text2 [htmlOpenElem $ftype $attr 0]]]} {return}
  1346.     set indent [htmlFindNextIndent]
  1347.     set text [htmlOpenCR $indent $extrablankline]
  1348.     append text $text2
  1349.     htmlGetSel
  1350.     append text $htmlCurSel
  1351.     set currpos [expr [getPos] + [string length $text]]
  1352.     append text [htmlCloseElem $ftype]
  1353.     if {$extrablankline} {
  1354.         set cr2 [htmlCloseCR2 $indent [selEnd]]
  1355.     } else {
  1356.         set cr2 [htmlCloseCR $indent]
  1357.     }
  1358.     append text $cr2
  1359.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1360.     if {$htmlIsSel} { deleteSelection }
  1361.     insertText $text
  1362.     if {!$htmlIsSel} {
  1363.         goto $currpos
  1364.     }
  1365. }
  1366.  
  1367. # This is used for elements that should be surrounded by empty lines
  1368. proc htmlBuildCR2Elem {ftype {attr ""}} {
  1369.     global HTMLmodeVars htmlCurSel htmlIsSel
  1370.     
  1371.     htmlGetSel
  1372. # Check if user has skipped an attribute which can't be skipped.
  1373.     if {![string length [set text2 [htmlOpenElem $ftype $attr 0]]]} {return}
  1374.     set indent [htmlFindNextIndent]
  1375.     set text [htmlOpenCR $indent 1]
  1376.     append text $text2
  1377.     if {[info exists HTMLmodeVars(indent${ftype})] && $HTMLmodeVars(indent${ftype})} {
  1378.         regsub -all "\r" $htmlCurSel "\r\t" htmlCurSel
  1379.         set exindent "\t"
  1380.     } else {
  1381.         set exindent ""
  1382.     }
  1383.     if {$htmlIsSel || ($ftype != "SCRIPT" && $ftype != "STYLE")} {
  1384.         append text "\r${indent}${exindent}$htmlCurSel"
  1385.     } else {
  1386.         append text "\r${indent}<!-- /* Hide content from old browsers */\r${indent}"
  1387.     }
  1388.     set currpos [expr [getPos] + [string length $text]]
  1389.     append text \r$indent
  1390.     set pre(SCRIPT) "//"; set pre(STYLE) "/*"; set post(SCRIPT) ""; set post(STYLE) "*/"
  1391.     if {!$htmlIsSel && ($ftype == "SCRIPT" || $ftype == "STYLE")} {append text "$pre($ftype) end hiding content from old browsers $post($ftype) -->\r$indent"}
  1392.     append text [htmlCloseElem $ftype]
  1393.     append text [htmlCloseCR2 $indent [selEnd]]
  1394.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1395.     if {$htmlIsSel} { deleteSelection }
  1396.     insertText $text
  1397.     if {!$htmlIsSel}    {
  1398.         goto $currpos
  1399.     }
  1400. }
  1401.  
  1402. # Determines which list the current position is inside.
  1403. proc htmlFindList {} {    
  1404.     set listType ""
  1405.     foreach l [list UL OL DIR MENU] {
  1406.         set ex "<${l}(\[ \\t\\r\]+\[^>\]*>|>)"
  1407.         set listOpening [search -s -f 0 -i 1 -r 1 -m 0 -n $ex [getPos]]
  1408.         set ex2 </$l>
  1409.         set listClosing [search -s -f 0 -i 1 -r 1 -m 0 -n $ex2 [getPos]]
  1410.         # Search until a single list opening is found.
  1411.         while {[string length $listOpening] && [string length $listClosing] &&
  1412.         [lindex $listClosing 0] > [lindex $listOpening 0]} {
  1413.             set listOpening [search -s -f 0 -i 1 -r 1 -m 0 -n $ex [expr [lindex $listOpening 0] - 1]]
  1414.             set listClosing [search -s -f 0 -i 1 -r 1 -m 0 -n $ex2 [expr [lindex $listClosing 0] - 1]]
  1415.         }
  1416.         if {[string length $listOpening]} {
  1417.             lappend listType "$listOpening $l"
  1418.         }
  1419.     }
  1420.     set ltype [lindex [lindex $listType 0] 2]
  1421.     set lnum [lindex [lindex $listType 0] 0]
  1422.     for {set i 1} {$i < [llength $listType]} {incr i} {
  1423.         if {[lindex [lindex $listType $i] 0] > $lnum} {
  1424.             set ltype [lindex [lindex $listType $i] 2]
  1425.             set lnum [lindex [lindex $listType $i] 0]
  1426.         }
  1427.     }
  1428.     return $ltype
  1429. }
  1430.  
  1431.  
  1432. # Choose an item from Use Attributes menu.
  1433. proc htmlChooseUseAttr {} {
  1434.     global htmlPackageToUse htmlElemAttrOptional1 htmlElemAttrOptional3
  1435.     foreach a [array names htmlElemAttrOptional$htmlPackageToUse] {
  1436.         if {[llength [set htmlElemAttrOptional${htmlPackageToUse}($a)]]} {lappend htmlPossibleToUse $a}
  1437.     }
  1438.     if {![catch {listpick -p "Choose HTML element" [lsort $htmlPossibleToUse]} elem] &&
  1439.     $elem != ""} {htmlUseAttributes $elem}
  1440. }
  1441.  
  1442. # Customize list of attributes which get asked about
  1443. proc htmlUseAttributes {item} {
  1444.     global HTMLmodeVars htmlPackageToUse modifiedVars
  1445.     global htmlElemAttrUsed htmlElemAttrUsed3
  1446.     global htmlElemAttrMore htmlElemAttrMore3
  1447.     
  1448.     set reqattrs [htmlGetRequired $item]
  1449.     set askformore [htmlGetAttrMore $item]
  1450.     set optatts [htmlGetOptional $item 1]
  1451.     set used [htmlGetUsed $item $reqattrs $optatts]
  1452.     set attrnumber [llength $optatts]
  1453.     
  1454.     set height [expr 95 + (( $attrnumber - 1) / 3 + 1) * 20]
  1455.     set box "-w 400 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1456.         -b Cancel 110 [expr $height - 30] 175 [expr $height - 10] \
  1457.         -t {Select the optional attributes you want for $item} 10 10 450 30 "
  1458.  
  1459.     lappend box -t {Ask for more?} 10 [expr $height - 55] 110 [expr $height - 40] \
  1460.         -r Yes $askformore 120 [expr $height - 55] 160 [expr $height - 40] \
  1461.         -r No [expr !$askformore] 180 [expr $height - 55] 220 [expr $height - 40]
  1462.     # see which attributes were used previously
  1463.     set wpos 10 
  1464.     set hpos 35
  1465.     foreach attr $optatts {
  1466.         lappend box -c [string trimright $attr =] [expr ([lsearch -exact $used $attr] >= 0)] $wpos $hpos [expr $wpos + 120] [expr $hpos + 15]
  1467.         set wpos [expr $wpos + 130]
  1468.         if {$wpos > 310} {
  1469.             set wpos 10
  1470.             set hpos [expr $hpos + 20]
  1471.         }
  1472.     }
  1473.     # get the new ones wanted
  1474.     set newatts [eval [concat dialog $box]]
  1475.     set newuse {}
  1476.     if {[lindex $newatts 0]} {
  1477.         for {set i 0} {$i < $attrnumber} {incr i} {
  1478.         if {[lindex $newatts [expr $i + 4]]} {
  1479.                 lappend newuse [lindex $optatts $i]
  1480.             }
  1481.         }
  1482.         set newuse [concat $reqattrs $newuse]
  1483.         if {$htmlPackageToUse == 1} {
  1484.             set num ""
  1485.         } else {
  1486.             set num 3
  1487.         }
  1488.         set htmlElemAttrUsed${num}($item) $newuse
  1489.         addArrDef htmlElemAttrUsed$num $item $newuse
  1490.         set htmlElemAttrMore${num}($item) [lindex $newatts 2]
  1491.         addArrDef htmlElemAttrMore$num $item [lindex $newatts 2]
  1492.     }
  1493. }
  1494.  
  1495. #===============================================================================
  1496. # Indentation
  1497. #===============================================================================
  1498.  
  1499. proc HTML::indentLine {} {
  1500.     if {[htmlIsInContainer STYLE] || [htmlIsInContainer SCRIPT]} {text::genericIndent; return}
  1501.     if {[htmlIsInContainer PRE]} {return}
  1502.     
  1503.     set previndent [htmlFindIndent]
  1504.     set lend [expr [nextLineStart [getPos]] - 1]
  1505.     if {$lend < [getPos]} {set lend [maxPos]}
  1506.     set thisLine [string trimleft [getText [set lstart [lineStart [getPos]]] $lend ]]
  1507.     set thisIndent [htmlGetIndent [getPos]]
  1508.     if {$thisIndent != $previndent} {replaceText $lstart $lend "$previndent$thisLine"}
  1509.  
  1510. }
  1511.  
  1512. # Find the indentation the current line should have.
  1513. proc htmlFindIndent {{pos0 ""}} {
  1514.     global htmlIndentElements HTMLmodeVars
  1515.     set indent ""
  1516.     foreach i $htmlIndentElements {
  1517.         if {$HTMLmodeVars(indent$i)} {lappend indent $i}
  1518.     }
  1519.     # Find previous non-blank line.
  1520.     if {$pos0 == ""} {set pos0 [getPos]}
  1521.     set pos [expr [lineStart $pos0] - 1]
  1522.     while {$pos >= 0 && [regexp {^[ \t]*$} [getText [lineStart $pos] $pos]]} {
  1523.         set pos [expr [lineStart $pos] - 1]
  1524.     }
  1525.     set pos [expr $pos >= 0 ? $pos : 0]
  1526.     # Get indentation on that line.
  1527.     set previndent [htmlGetIndent $pos]
  1528.     # Find last tag on or before that line.
  1529.     if {[catch {search -s -f 0 -m 0 -r 1 {<([^<>]+)>} $pos} tag] || [lindex $tag 1] < [lineStart $pos] ||
  1530.     ( [lindex $tag 0] < [lineStart $pos0] && [lindex $tag 1] > [lineStart $pos0])} {
  1531.         set tag ""
  1532.     } else {
  1533.         set tag [string trim [eval getText $tag] "<>"]
  1534.     }
  1535.     set tag [string toupper [lindex $tag 0]]
  1536.     # Add a tab to indentation?
  1537.     if {[lsearch -exact $indent $tag] >= 0} {
  1538.         append previndent "\t"
  1539.     }
  1540.     # Find last tag on current line.
  1541.     set tag ""
  1542.     set lstart [lineStart $pos0]
  1543.     set lend [expr ([set npos [nextLineStart $pos0]] <= $lstart) ? $lstart : $npos - 1]
  1544.     regexp {<([^<>]+)>} [getText $lstart $lend] dum tag
  1545.     set tag [string toupper [lindex $tag 0]]
  1546.     
  1547.     # Remove a tab from indentation?
  1548.     if {[string index $tag 0] == "/" && [lsearch -exact $indent [string range $tag 1 end]] >= 0} {
  1549.         set previndent [htmlReduceIndent $previndent]
  1550.     }
  1551.     return $previndent 
  1552. }
  1553.  
  1554. # Find the indentation the next line should have.
  1555. proc htmlFindNextIndent {{pos0 ""}} {
  1556.     global HTMLmodeVars htmlIndentElements
  1557.     set indent ""
  1558.     foreach i $htmlIndentElements {
  1559.         if {$HTMLmodeVars(indent$i)} {lappend indent $i}
  1560.     }
  1561.     if {$pos0 == ""} {set pos0 [getPos]}
  1562.     set ind [htmlFindIndent $pos0]
  1563.     # Find last tag before pos0 on current line.
  1564.     set tag ""
  1565.     set lstart [lineStart $pos0]
  1566. #     set lend [expr ([set npos [nextLineStart $pos0]] <= $lstart) ? $lstart : $npos - 1]
  1567.     regexp {<([^<>]+)>} [getText $lstart $pos0] dum tag
  1568.     set tag [string toupper [lindex $tag 0]]
  1569.     # Remove a tab from indentation?
  1570.     if {[lsearch -exact $indent $tag] >= 0} {append ind "\t"}
  1571.     return $ind
  1572. }
  1573.  
  1574. # get the leading whitespace of the current line
  1575. proc htmlGetIndent { pos } {
  1576.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  1577.     return [htmlIndentConvert [eval getText $res]]
  1578. }
  1579.  
  1580. # convert it to minimal form: tabs then spaces.
  1581. proc htmlIndentConvert {indent} {
  1582.     getWinInfo a
  1583.     set sp [string range "              " 1 $a(tabsize) ]
  1584.     regsub -all $sp $indent "\t" indent
  1585.     regsub -all "\[ \]+\t" $indent "\t" indent
  1586.     return $indent
  1587. }
  1588.  
  1589. # Removes tabsize whitespace.
  1590. proc htmlReduceIndent {indent} {
  1591.     getWinInfo a
  1592.     set sp [string range "              " 1 $a(tabsize) ]
  1593.     regsub -all "\t" $indent $sp indent
  1594.     set indent [string range $indent $a(tabsize) end]
  1595.     regsub -all $sp $indent "\t" indent
  1596.     regsub -all "\[ \]+\t" $indent "\t" indent
  1597.     return $indent
  1598. }
  1599.  
  1600. proc htmlFirstLineIndent {indent} {
  1601.     if {![htmlIsWhite [set text [getText [lineStart [getPos]] [getPos]]]]} {return $indent}
  1602.     set text [htmlIndentConvert $text]
  1603.     return [string range $indent [string length $text] end]
  1604. }
  1605.  
  1606. #===============================================================================
  1607. # Tidy up source
  1608. #===============================================================================
  1609. proc htmlReformatParagraph {} {htmlTidyUp paragraph}
  1610. proc htmlReformatDocument {} {htmlTidyUp document}
  1611.  
  1612. proc htmlTidyUp {where} {
  1613.     global HTMLmodeVars fillColumn htmlElemProc htmlIndentElements
  1614.     message "Reformatting…"
  1615.     set oldfillColumn $fillColumn
  1616.     getWinInfo a
  1617.     set tab $a(tabsize)
  1618.     if {$where == "paragraph"} {
  1619.         if {[isSelection]} {
  1620.             set startPos [getPos]
  1621.             set endPos [selEnd]
  1622.         } else {
  1623.             if {[catch {search -s -f 0 -m 0 -r 1 {^[ \t]*$} [getPos]} sp]} {set sp 0}
  1624.             set startPos [nextLineStart [lindex $sp 1]]
  1625.             if {[catch {search -s -f 1 -m 0 -r 1 {^[ \t]*$} [getPos]} sp]} {set sp "0 [maxPos]"}
  1626.             set endPos [expr [lindex $sp 1] < [maxPos] ? [lindex $sp 1] + 1 : [maxPos]]
  1627.         }
  1628.         set ind [htmlFindIndent $startPos]
  1629.         set fillColumn [expr $oldfillColumn - $tab * [string length $ind]]
  1630.         set cr 2
  1631.     } else {
  1632.         set startPos 0
  1633.         set endPos [maxPos]
  1634.         set ind ""
  1635.         set cr 0
  1636.     }
  1637.     # Remember position
  1638.     set srem [expr [set pos [getPos]] - 20 < $startPos ? $startPos : $pos - 20]
  1639.     set remember_str [quote::Regfind [getText $srem $pos ]]
  1640.     regsub -all {\?} $remember_str {\\?} remember_str
  1641.     regsub -all "\[ \t\r\]+" $remember_str {[ \t\r]+} remember_str
  1642.     # To handle indentation
  1643.     set indList ""
  1644.     foreach i $htmlIndentElements {
  1645.         if {$HTMLmodeVars(indent$i)} {lappend indList $i}
  1646.     }
  1647.     
  1648.     # These tags should have a blank line before
  1649.     set blBef {TITLE HEAD BODY STYLE H1 H2 H3 H4 H5 H6 P BLOCKQUOTE DIV CENTER PRE MULTICOL OBJECT
  1650.     NOEMBED UL OL DIR MENU DL FORM SELECT TABLE TR FRAMESET NOFRAMES MAP APPLET SCRIPT NOSCRIPT LAYER NOLAYER}
  1651.     # These tags should have a cr before
  1652.     set crBef {/HTML /HEAD /BODY /STYLE /P /BLOCKQUOTE /DIV ADDRESS /CENTER /PRE /MULTICOL HR BASEFONT
  1653.     MARQUEE /OBJECT BGSOUND /NOEMBED /UL /OL /DIR /MENU LI /DL DT /FORM /SELECT OPTION TEXTAREA
  1654.     KEYGEN /TABLE /TR CAPTION COL COLGROUP THEAD TBODY TFOOT /FRAMESET FRAME /NOFRAMES /MAP AREA
  1655.     /APPLET PARAM /SCRIPT /NOSCRIPT /LAYER ILAYER /NOLAYER BASE ISINDEX LINK META !--}
  1656.     # These tags should have a blank line after
  1657.     set blAft {/TITLE /HEAD /BODY /STYLE /H1 /H2 /H3 /H4 /H5 /H6 /P /BLOCKQUOTE /DIV /CENTER /PRE /MULTICOL
  1658.     /OBJECT /NOEMBED /UL /OL /DIR /MENU /DL /FORM /SELECT /TABLE /TR /FRAMESET /NOFRAMES /MAP
  1659.     /APPLET /SCRIPT /NOSCRIPT /LAYER /NOLAYER}
  1660.     # These tags should have a cr after
  1661.     set crAft {HTML /HTML HEAD BODY STYLE P BLOCKQUOTE DIV /ADDRESS CENTER PRE MULTICOL BR HR WBR BASEFONT
  1662.     /MARQUEE OBJECT BGSOUND NOEMBED UL OL DIR MENU /LI DL /DD FORM INPUT SELECT OPTION /TEXTAREA KEYGEN
  1663.     TABLE TR /CAPTION COL COLGROUP THEAD TBODY TFOOT FRAMESET FRAME NOFRAMES MAP AREA APPLET PARAM
  1664.     SCRIPT NOSCRIPT LAYER /ILAYER NOLAYER BASE ISINDEX LINK META !--}
  1665.     # Custom elements
  1666.     foreach c [array names htmlElemProc] {
  1667.         switch [lindex $htmlElemProc($c) 0] {
  1668.             htmlBuildCR2Elem {
  1669.                 lappend blBef $c
  1670.                 lappend crBef /$c
  1671.                 lappend blAft /$c
  1672.                 lappend crAft $c
  1673.             }
  1674.             htmlBuildCRElem {
  1675.                 if {[lindex $htmlElemProc($c) 2] == "1"} {
  1676.                     lappend blBef $c
  1677.                     lappend blAft /$c
  1678.                 } else {
  1679.                     lappend crBef $c
  1680.                     lappend crAft /$c
  1681.                 }
  1682.             }
  1683.             htmlBuildOpening {
  1684.                 if {[lindex $htmlElemProc($c) 2] == "1"} {lappend crBef $c}
  1685.                 if {[lindex $htmlElemProc($c) 3] == "1"} {lappend crAft $c}
  1686.             }
  1687.         }
  1688.     }
  1689.     set all [concat $blBef $blAft $crBef $crAft]
  1690.     set bef [concat $blBef $crBef]
  1691.     set aft [concat $blAft $crAft]
  1692.     set pos $startPos
  1693.     set tmp ""
  1694.     set text ""
  1695.     while {![catch {search -s -f 1 -m 0 -r 1 {(<!--|<[^<>]+>)} $pos} pos1] && [lindex $pos1 1] <= $endPos} {
  1696.         set tag [string toupper [lindex [set wholeTag [string trim [eval getText $pos1] "<>"]] 0]]
  1697.         if {$tag != "!--"} {
  1698.             set w ""
  1699.             set i {0 0}
  1700.             # To avoid line breaks inside attributes
  1701.             while {[regexp -indices {=\"[^ \"]* [^\"]*\"} $wholeTag i]} {
  1702.                 append w [string range $wholeTag 0 [expr [lindex $i 0] - 1]]
  1703.                 regsub -all "\[ \t\r\]+" [string range $wholeTag [lindex $i 0] [lindex $i 1]] "" w1
  1704.                 append w $w1
  1705.                 set wholeTag [string range $wholeTag [expr [lindex $i 1] + 1] end]
  1706.             }
  1707.             set wholeTag $w$wholeTag
  1708.         }
  1709.         append tmp [getText $pos [lindex $pos1 0]]
  1710.         set pos [lindex $pos1 1]            
  1711.         if {[lsearch $all $tag] < 0} {
  1712.             append tmp <$wholeTag>
  1713.             continue
  1714.         }
  1715.         # cr or blank line before tag
  1716.         if {[lsearch $bef $tag] >= 0} {
  1717.             regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1718.             set tmp [string trimright [breakIntoLines $tmp]]
  1719.             regsub -all "" $tmp " " tmp
  1720.             regsub -all "\r" $tmp "\r$ind" tmp
  1721.             if {![htmlIsWhite $tmp]} {set cr 0; append text $ind}
  1722.             append text $tmp
  1723.             set ble [lsearch $blBef $tag]
  1724.             if {$cr == 1 && $ble >= 0 && ([string index $tag 0] != "/" || [lsearch $indList [string range $tag 1 end]] < 0)} {
  1725.                 append text $ind
  1726.             }
  1727.             if {$cr == 0} {
  1728.                 append text \r
  1729.                 incr cr
  1730.                 if {$cr == 1 && $ble >= 0} {append text $ind}
  1731.             }
  1732.             if {$ble >= 0 && $cr < 2} {append text \r; incr cr}
  1733.             set tmp <$wholeTag>
  1734.             # Take care of comments separately
  1735.             if {$tag == "!--"} {
  1736.                 set tmp "<!--"
  1737.                 if {[catch {search -s -f 1 -m 0 -r 1 -i 1 -- "-->" $pos} pos2]} {set pos2 "0 $endPos"}
  1738.                 append text $ind$tmp[getText $pos [set pos [lindex $pos2 1]]]
  1739.                 set tmp ""
  1740.                 set cr 0
  1741.             }
  1742.             # The contents of these tags should be left untouched
  1743.             if {[lsearch {SCRIPT STYLE PRE} $tag] >= 0} {
  1744.                 set tag /$tag
  1745.                 regsub -all "" $tmp " " tmp
  1746.                 if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "<$tag>" $pos} pos2]} {set pos2 "0 $endPos"}
  1747.                 append text $ind$tmp[getText $pos [set pos [lindex $pos2 1]]]
  1748.                 set tmp ""
  1749.                 set cr 0
  1750.             }
  1751.         } else {
  1752.             append tmp <$wholeTag>
  1753.         }
  1754.         # cr or blank line after tag
  1755.         if {[lsearch $aft $tag] >= 0} {
  1756.             if {[string index $tag 0] == "/" && [lsearch $indList [string range $tag 1 end]] >= 0} {
  1757.                 set ind [string range $ind 1 end]
  1758.                 set fillColumn [expr $oldfillColumn - $tab * [string length $ind]]
  1759.             }
  1760.             regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1761.             set tmp [string trimright [breakIntoLines $tmp]]
  1762.             regsub -all "" $tmp " " tmp
  1763.             regsub -all "\r" $tmp "\r$ind" tmp
  1764.             if {![htmlIsWhite $tmp]} {set cr 0; append text $ind}
  1765.             append text $tmp
  1766.             set bla [lsearch $blAft $tag]
  1767.             if {[lsearch $indList $tag] >= 0} {
  1768.                 append ind \t
  1769.                 set fillColumn [expr $oldfillColumn - $tab * [string length $ind]]
  1770.             }
  1771.             if {$cr == 0} {
  1772.                 append text \r
  1773.                 incr cr
  1774.                 if {$cr == 1 && $bla >= 0} {append text $ind}
  1775.             }
  1776.             if {$bla >= 0 && $cr < 2} {append text \r; incr cr}
  1777.             set tmp ""
  1778.         }
  1779.     }
  1780.     # Add what's left
  1781.     if {$tmp != "" || $pos < $endPos} {
  1782.         if {$pos < $endPos} {append tmp [getText $pos $endPos]}
  1783.         regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1784.         set tmp [string trimright [breakIntoLines $tmp]]
  1785.         regsub -all "" $tmp " " tmp
  1786.         regsub -all "\r" $tmp "\r$ind" tmp
  1787.         if {![htmlIsWhite $tmp]} {append text $ind}
  1788.         append text $tmp
  1789.         if {![htmlIsWhite $tmp]} {append text \r}
  1790.     }
  1791.     replaceText $startPos $endPos $text
  1792.     set fillColumn $oldfillColumn
  1793.     # Go back to previous position.
  1794.     if { $remember_str != "" } {
  1795.         regexp -indices $remember_str [getText $startPos [set end [getPos]]] wholematch
  1796.         set p [expr [info exists wholematch] ? [expr $startPos + 1 + [lindex $wholematch 1]] : $end]
  1797.         goto [expr $p >= $end ? $end -1 : $p]
  1798.     }
  1799. }
  1800.