home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / HTML and CSS Modes / htmlStatusBar.tcl < prev    next >
Encoding:
Text File  |  2001-01-12  |  27.6 KB  |  959 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlStatusBar.tcl"
  6.  #                                    created: 96-06-16 14.24.31 
  7.  #                                last update: 00-12-31 17.27.53 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <alpha_www_tools@go.to>
  10.  #     www: <http://go.to/alpha_www_tools>
  11.  #  
  12.  # Version: 3.0
  13.  # 
  14.  # Copyright 1996-2001 by Johan Linde
  15.  #  
  16.  # This program is free software; you can redistribute it and/or modify
  17.  # it under the terms of the GNU General Public License as published by
  18.  # the Free Software Foundation; either version 2 of the License, or
  19.  # (at your option) any later version.
  20.  # 
  21.  # This program is distributed in the hope that it will be useful,
  22.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24.  # GNU General Public License for more details.
  25.  # 
  26.  # You should have received a copy of the GNU General Public License
  27.  # along with this program; if not, write to the Free Software
  28.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  # 
  30.  # ###################################################################
  31.  ##
  32.  
  33. #===============================================================================
  34. # This file contains procs for giving values to attributes in the status bar.
  35. #===============================================================================
  36.  
  37. # Opening or only tag of an element - include attributes
  38. # Status bar for each attribute.
  39. # Return empty string if user skips an attribute which must be used.
  40. proc html::OpenElemStatusBar {elem used wrPos {values ""} {addNotUsed 0} {addHidden 0} {absPos ""}} {
  41.     global HTMLmodeVars
  42.     global html::WrapPos html::AbsPos
  43.     global html::ActiveWidth html::ActiveHeight html::ActiveElem html::ActiveUsed
  44.     
  45.     if {![string length $used]} {set used $elem}
  46.     set elem [set html::ActiveElem [string toupper $elem]]
  47.     set used [set html::ActiveUsed [string toupper $used]]
  48.     
  49.     # if there are attributes to ask about, do so
  50.     set reqatts [html::GetRequired $used]
  51.     set optatts [html::GetOptional $used]
  52.     set allatts [html::GetUsed $used $reqatts $optatts]
  53.     regsub -all "\[ \n\r\t]+([join $allatts |])" " $optatts" " " notUsedAtts
  54.     if {$addNotUsed} {
  55.         append allatts " " $notUsedAtts
  56.         set notUsedAtts ""
  57.     }
  58.     if {$addHidden} {
  59.         regsub -all "\[ \n\r\t]+([join $optatts |])" " [html::GetOptional $used 1]" " " hiddenAtts
  60.         append allatts " $hiddenAtts"
  61.     }
  62.     
  63.     set text "<"
  64.     append text [html::SetCase $elem]
  65.     # trick for INPUT
  66.     regsub {TYPE=(.*)$} $text "TYPE=\"\\1\"" text
  67.     
  68.     set useatts $allatts
  69.     append allatts " " $notUsedAtts
  70.     set html::ActiveWidth ""
  71.     set html::ActiveHeight ""
  72.     
  73.     # wrapping
  74.     if {$absPos == ""} {
  75.         set html::AbsPos [getPos]
  76.     } else {
  77.         set html::AbsPos $absPos
  78.     }
  79.     set html::WrapPos [expr {$wrPos == -1 ? [posX [getPos]] : $wrPos}]
  80.     incr html::WrapPos [expr {[string length $text] + 1}]
  81.     for {set i 0} {$i < [llength $allatts] && [llength $useatts]} {incr i} {
  82.         set attr [lindex $allatts $i]
  83.         if {[lcontains reqatts $attr]} {
  84.             set required 1
  85.         } else {
  86.             set required 0
  87.         }
  88.         set attrType [html::GetAttrType $used $attr]
  89.         if {[expr {!$i}] && $HTMLmodeVars(promptNoisily)} {beep}
  90.         set flash ""
  91.         if {[expr {!$i}] && $HTMLmodeVars(flashStatusBar)} {set flash -f}
  92.         if {[catch {html::StatusBar$attrType $elem $used $attr $required $flash [lindex $values $i]} res]} {
  93.             if {$res == "Cancel"} {return}
  94.             if {$res == "Skip rest!"} {
  95.                 if {!$required} {
  96.                     set i [llength $allatts]
  97.                 } else {
  98.                     alertnote "You must give $attr a value."
  99.                     incr i -1
  100.                 }
  101.             }
  102.         } elseif {$res == "" && $required} {
  103.             alertnote "You must give $attr a value."
  104.             incr i -1
  105.         } else {
  106.             append text $res
  107.         }
  108.     }
  109.  
  110.     message ""
  111.     # Some tests that input is ok.
  112.     if {([info commands html::${elem}test] != "" || [info commands ::html::${elem}test] != "") && [eval html::${elem}test $elem [list "$text"] message]} { 
  113.         beep
  114.         set text ""
  115.     }
  116.     if {[string length $text]} {append text ">"}
  117.     catch {unset html::ActiveWidth}
  118.     catch {unset html::ActiveHeight}
  119.     return ${text}
  120. }
  121.  
  122. proc html::StatusElemPrompt {elem attr req def} {
  123.     global html::Plugins html::ActiveUsed
  124.     if {!$req} { set pr "(optional) "}
  125.     if {[lcontains html::Plugins ${html::ActiveUsed}] && ${html::ActiveUsed} != "EMBED"} {
  126.         append pr "$elem, ${html::ActiveUsed}:$attr"
  127.     } else {
  128.         append pr ${elem}:${attr}
  129.     }
  130.     if {$def != ""} {append pr " \[$def\] "}
  131.     return $pr
  132. }
  133.  
  134.  
  135. #===============================================================================
  136. # ◊◊◊◊ Flag ◊◊◊◊ #
  137. #===============================================================================
  138.  
  139. # flag
  140. proc html::StatusBarflag {elem used attr required flash def} {
  141.     set v ""
  142.     set text ""
  143.     set yn no
  144.     if {$def == "1"} {set yn yes}
  145.     while {[catch {html::statusPrompt $flash "${elem}:$attr \[$yn\] " html::StatusAskYesOrNo} v]} {
  146.         if {[html::statusError v no]} {break}
  147.     }
  148.     if {$v == ""} {set v $yn}
  149.     if {$v == "yes"} {append text [html::WrapTag [html::SetCase $attr]]}
  150.     return $text
  151. }
  152.  
  153. # Force yes or no in the status window
  154. proc html::StatusAskYesOrNo {args} {
  155.     eval html::statusArgs curr c $args
  156.     set c [string tolower $c]
  157.     if {[string match "$curr$c*" "no"]} {return [html::statusReturn [string trim "no" $curr]]}
  158.     if {[string match "$curr$c*" "yes"]} {return [html::statusReturn [string trim "yes" $curr]]}
  159.     beep
  160.     return [html::statusReturn ""]
  161. }
  162.  
  163. #===============================================================================
  164. # ◊◊◊◊ URL / Frame target / Contenttype ◊◊◊◊ #
  165. #===============================================================================
  166.  
  167. # url
  168. proc html::StatusBarurl {elem used attr required flash def} {
  169.     global html::ActiveCache
  170.     set html::ActiveCache URLs
  171.     set text ""
  172.     if {[catch {html::AskURL $elem $attr $required $flash $def} v]} {
  173.         html::statusError v ""
  174.     } elseif {[string length $v]} {
  175.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes [html::URLescape2 $v]]"]
  176.     }
  177.     return $text
  178. }
  179.  
  180. # frametarget
  181. proc html::StatusBarframetarget {elem used attr required flash def} {
  182.     global html::ActiveCache
  183.     set html::ActiveCache windows
  184.     set text ""
  185.     if {[catch {html::AskURL $elem $attr $required $flash $def} v]} {
  186.         html::statusError v ""
  187.     } elseif {[string length $v]} {
  188.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  189.     }
  190.     return $text
  191. }
  192.  
  193. # contenttype
  194. proc html::StatusBarcontenttype {elem used attr required flash def} {
  195.     global html::ActiveCache HTMLmodeVars
  196.     set html::ActiveCache contenttypes
  197.     set text ""
  198.     if {[catch {html::AskURL $elem $attr $required $flash $def} v]} {
  199.         html::statusError v ""
  200.     } elseif {[string length $v]} {
  201.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  202.         if {![lcontains HTMLmodeVars(contenttypes) [string tolower $v]]} {
  203.             lappend HTMLmodeVars(contenttypes) [string tolower $v]
  204.             prefs::modifiedModeVar contenttypes HTML
  205.         }
  206.     }
  207.     return $text
  208. }
  209.  
  210. # contenttypes
  211. proc html::StatusBarcontenttypes {elem used attr required flash def {types contenttypes} {comma 1}} {
  212.     global html::ActiveCache HTMLmodeVars
  213.     set html::ActiveCache $types
  214.     set text ""
  215.     set sep " "
  216.     if {$comma} {set sep ","}
  217.     if {[catch {html::AskURL $elem $attr $required $flash $def $sep} v]} {
  218.         html::statusError v ""
  219.     } elseif {[string length $v]} {
  220.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  221.         if {$comma} {
  222.             set tlist [split $v ,]
  223.         } else {
  224.             set tlist $v
  225.         }
  226.         foreach t $tlist {
  227.             set t [string tolower [string trim $t]]
  228.             if {![lcontains HTMLmodeVars($types) $t]} {
  229.                 lappend HTMLmodeVars($types) $t
  230.                 prefs::modifiedModeVar $types HTML
  231.             }
  232.         }
  233.     }
  234.     return $text
  235. }
  236.  
  237. # linktypes 
  238. proc html::StatusBarlinktypes {elem used attr required flash def} {
  239.     return [html::StatusBarcontenttypes $elem $used $attr $required $flash $def linktypes 0]
  240. }
  241.  
  242. # mediadesc 
  243. proc html::StatusBarmediadesc {elem used attr required flash def} {
  244.     return [html::StatusBarcontenttypes $elem $used $attr $required $flash $def mediatypes]
  245. }
  246.  
  247. # HREF attributes are handled as a listpick from a cached list
  248. proc html::AskURL {elem attr required flash def {sep ""}} {
  249.     global html::URLTabSeen html::ActiveAttr html::StatusSepString
  250.     global HTMLmodeVars html::ActiveCache html::ActiveURL
  251.     
  252.     set html::StatusSepString $sep
  253.     set html::ActiveAttr $attr
  254.     set html::URLTabSeen 0
  255.     set pr [html::StatusElemPrompt $elem $attr $required $def]
  256.     while {[catch {html::statusPrompt $flash $pr html::URLStatusFunc} r]} {
  257.         if {$r == "Cancel all!"} {
  258.             error "Cancel all!"
  259.         }
  260.         if {$r == "Continue!"} {
  261.             set r ${html::ActiveURL}
  262.             unset html::ActiveURL
  263.             break
  264.         }
  265.         if {$r == "Skip rest!"} {error "Skip rest!"}
  266.         if {$r == "No value"} {return}
  267.     }
  268.     set r [string trim $r]
  269.     if {${html::ActiveCache} == "URLs" || ${html::ActiveCache} == "windows"} {html::AddToCache ${html::ActiveCache} $r}
  270.     if {$r == ""} {return $def}
  271.     return $r
  272. }
  273.  
  274.  
  275. proc html::URLStatusFunc {args} {
  276.     global HTMLmodeVars html::ActiveAttr html::URLTabSeen html::ActiveCache html::ActiveURL
  277.     global html::ActiveElem html::ActiveWidth html::ActiveHeight html::StatusSepString
  278.     
  279.     eval html::statusArgs curr c $args
  280.     if {${html::ActiveCache} == "windows"} {set URLs {_self _top _parent _blank}}
  281.     append URLs " " $HTMLmodeVars(${html::ActiveCache})
  282.     
  283.     # ctrl-f for file dialog.
  284.     if {$c == "\006"} {
  285.         if {${html::ActiveCache} != "URLs"} {
  286.             beep
  287.             return [html::statusReturn ""]
  288.         }
  289.         set newURL [html::GetFile]
  290.         if {[string length $newURL]} {
  291.             set html::ActiveURL [lindex $newURL 0]
  292.             if {[llength [set nnn [lindex $newURL 1]]] && ${html::ActiveAttr} == "SRC="} {
  293.                 set html::ActiveWidth [lindex $nnn 0]
  294.                 set html::ActiveHeight [lindex $nnn 1]
  295.             }
  296.             error "Continue!"
  297.         } else {
  298.             return [html::statusReturn ""]
  299.         }
  300.     }
  301.  
  302.     if {$c != "\t"} {
  303.         set html::URLTabSeen 0
  304.         return [html::statusReturn $c]
  305.     }
  306.  
  307.     set matches {}
  308.     set matchcurr $curr
  309.     if {${html::StatusSepString} != ""} {
  310.         set matchcurr [string trimleft [string range $matchcurr [expr {[string last ${html::StatusSepString} $matchcurr] + 1}] end]]
  311.     }
  312.     
  313.     foreach w $URLs {
  314.         if {[string match "$matchcurr*" $w]} {
  315.             lappend matches $w
  316.         }
  317.     }
  318.     if {![llength $matches]} {
  319.         beep
  320.     } else {
  321.         if {${html::URLTabSeen}} {
  322.             if {[catch {listpick -p ${html::ActiveElem}:${html::ActiveAttr} $matches} ret]} {
  323.                 set ret ""
  324.             }
  325.             if {[string length $ret]} {
  326.                 set html::ActiveURL $ret
  327.                 if {${html::StatusSepString} == ""} {
  328.                     error "Continue!"
  329.                 } else {
  330.                     set ret [string range $ret [string length $matchcurr] end]
  331.                 }
  332.             }
  333.             set html::URLTabSeen 0
  334.         } else {
  335.             set html::URLTabSeen 1
  336.             set ret [string range [largestPrefix $matches] [string length $matchcurr] end]
  337.         }
  338.         return [html::statusReturn $ret]
  339.     }
  340.     return [html::statusReturn ""]
  341. }
  342.  
  343. #===============================================================================
  344. # ◊◊◊◊ Color ◊◊◊◊ #
  345. #===============================================================================
  346.  
  347. # color
  348. proc html::StatusBarcolor {elem used attr required flash def} {
  349.     set text ""
  350.     if {[catch {html::AskColor $elem $attr $required $flash $def} v]} {
  351.         html::statusError v ""
  352.     } elseif {[string length $v]} {
  353.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  354.     }
  355.     return $text    
  356. }
  357. # Choose a color name or add a color number
  358.  
  359. proc html::AskColor {elem attr required flash def} {
  360.     global HTMLmodeVars html::ColorTabSeen html::ColorName html::ActiveAttr
  361.     global html::basicColors html::userColors htmlColors html::ActiveColor
  362.     
  363.     set htmlColors [lsort [array names html::userColors]]
  364.     append htmlColors " " ${html::basicColors}
  365.     set html::ActiveAttr $attr
  366.      
  367.      while {1} {
  368.          # Loop until input is valid or everything is cancelled, then something is returned
  369.          set html::ColorTabSeen 0
  370.          set pr [html::StatusElemPrompt $elem $attr $required $def]
  371.          while {[catch {html::statusPrompt $flash $pr html::ColorStatusFunc} r]} {
  372.              if {$r == "Cancel all!"} {
  373.                   error "Cancel all!"
  374.              }
  375.              if {$r == "Continue!"} {
  376.                  set r ${html::ActiveColor}
  377.                  unset html::ActiveColor
  378.                  break
  379.              }
  380.              if {$r == "Skip rest!"} {error "Skip rest!"}
  381.              if {$r == "No value"} {return}
  382.          }
  383.          set r [string trim $r]
  384.          if {$r == ""} {return $def}
  385.          # Users own color?
  386.          if {[info exists html::userColors($r)]} {return [set html::userColors($r)]}
  387.          # Predefined color?
  388.          if {[info exists html::ColorName($r)]} {
  389.              return [set html::ColorName($r)]
  390.          } else {
  391.              set col [html::CheckColorNumber $r]
  392.              if {$col != 0} {
  393.                  return $col
  394.              } else {
  395.                  alertnote "$r is not a valid color number. It should be of the form #RRGGBB."
  396.              }
  397.          }
  398.      }
  399. }
  400.  
  401. proc html::ColorStatusFunc {args} {
  402.     global html::ActiveAttr html::ColorTabSeen html::ColorName
  403.     global htmlColors html::ActiveColor html::ActiveElem
  404.     
  405.     eval html::statusArgs curr c $args
  406.     # ctrl-f is new color.
  407.     if {$c == "\006"} {
  408.         set newcolor [html::AddANewColor]
  409.         if {[string length $newcolor]} {
  410.             set html::ActiveColor $newcolor
  411.             error "Continue!"
  412.         } else {
  413.             return [html::statusReturn ""]
  414.         }
  415.     }
  416.     
  417.     if {$c != "\t"} {
  418.         set html::ColorTabSeen 0
  419.         return [html::statusReturn $c]
  420.     }
  421.  
  422.     set matches {}
  423.     set attr ${html::ActiveAttr}
  424.     foreach w $htmlColors {
  425.         if {[string match "$curr*" $w]} {
  426.             lappend matches $w
  427.         }
  428.     }
  429.     if {![llength $matches]} {
  430.         beep
  431.     } else {
  432.         if {${html::ColorTabSeen}} {
  433.             if {[catch {listpick -p ${html::ActiveElem}:${html::ActiveAttr} $matches} ret]} {
  434.                 set ret ""
  435.             }
  436.             if {[string length $ret]} {
  437.                 set html::ActiveColor $ret
  438.                 error "Continue!"
  439.             }
  440.             set html::ColorTabSeen 0
  441.         } else {
  442.             set html::ColorTabSeen 1
  443.             set ret [string range [largestPrefix $matches] [string length $curr] end]
  444.         }
  445.         return [html::statusReturn $ret]
  446.     }
  447.     return [html::statusReturn ""]
  448. }
  449.  
  450.  
  451. #===============================================================================
  452. # ◊◊◊◊ Choices / Oltype / Other etc. ◊◊◊◊ #
  453. #===============================================================================
  454.  
  455. # choices
  456. proc html::StatusBarchoices {elem used attr required flash def {casesensitive 0}} {
  457.     set text ""
  458.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 $casesensitive [html::GetAttrChoices $used $attr]} v]} {
  459.         html::statusError v ""
  460.     } elseif {[string length $v]} {
  461.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  462.     }
  463.     return $text
  464. }
  465.  
  466. # oltype
  467. proc html::StatusBaroltype {elem used attr required flash def} {
  468.     html::StatusBarchoices $elem $used $attr $required $flash $def 1
  469. }
  470.  
  471. # other
  472. proc html::StatusBarother {elem used attr required flash def} {
  473.     set text ""
  474.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 ""} v]} {
  475.         html::statusError v ""
  476.     } elseif {[string length $v]} {
  477.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  478.     }
  479.     return $text
  480. }
  481.  
  482. # othernotrim
  483. proc html::StatusBarothernotrim {elem used attr required flash def} {
  484.     set text ""
  485.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 0 0 ""} v]} {
  486.         html::statusError v ""
  487.     } elseif {[string length $v]} {
  488.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  489.     }
  490.     return $text
  491. }
  492.  
  493. # anchor
  494. proc html::StatusBaranchor {elem used attr required flash def} {
  495.     set text ""
  496.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 ""} v]} {
  497.         html::statusError v ""
  498.     } elseif {[string length $v]} {
  499.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  500.         html::AddToCache URLs "#$v"
  501.     }
  502.     return $text
  503. }
  504.  
  505. # targetname
  506. proc html::StatusBartargetname {elem used attr required flash def} {
  507.     set text ""
  508.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 ""} v]} {
  509.         html::statusError v ""
  510.     } elseif {[string length $v]} {
  511.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  512.         html::AddToCache windows $v
  513.     }
  514.     return $text
  515. }
  516.  
  517. # eventhandler
  518. proc html::StatusBareventhandler {elem used attr required flash def} {
  519.     set text ""
  520.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 ""} v]} {
  521.         html::statusError v ""
  522.     } elseif {[string length $v]} {
  523.         append text [html::WrapTag "$attr[html::AddQuotes $v]"]
  524.     }
  525.     return $text
  526. }
  527.  
  528. # id
  529. proc html::StatusBarid {elem used attr required flash def} {
  530.     set text ""
  531.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 "" html::CheckId "Must be first a letter and then letters, digits, and '_' '-' ':' '.'"} v]} {
  532.         html::statusError v ""
  533.     } elseif {[string length $v]} {
  534.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  535.     }
  536.     return $text
  537. }
  538.  
  539. # ids
  540. proc html::StatusBarids {elem used attr required flash def} {
  541.     set text ""
  542.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 "" html::CheckIds "Must be first a letter and then letters, digits, and '_' '-' ':' '.'"} v]} {
  543.         html::statusError v ""
  544.     } elseif {[string length $v]} {
  545.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  546.     }
  547.     return $text
  548. }
  549.  
  550. # languagecode 
  551. proc html::StatusBarlanguagecode {elem used attr required flash def} {
  552.     html::StatusBarother $elem $used $attr $required $flash $def
  553.     # to be modified
  554. }
  555.  
  556. # charset 
  557. proc html::StatusBarcharset {elem used attr required flash def} {
  558.     html::StatusBarother $elem $used $attr $required $flash $def
  559.     # to be modified
  560. }
  561.  
  562. # charsets 
  563. proc html::StatusBarcharsets {elem used attr required flash def} {
  564.     html::StatusBarother $elem $used $attr $required $flash $def
  565.     # to be modified
  566. }
  567.  
  568. # coords 
  569. proc html::StatusBarcoords {elem used attr required flash def {multilength 0}} {
  570.     global html::ActiveAttr
  571.     set html::ActiveAttr $attr
  572.     set func html::CheckStatusCoords
  573.     if {$multilength} {set func html::CheckStatusMultiLengths}
  574.     set text ""
  575.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 "" $func "Incorrect number."} v]} {
  576.         html::statusError v ""
  577.     } elseif {[string length $v]} {
  578.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  579.     }
  580.     return $text
  581. }
  582.  
  583. # multilengths 
  584. proc html::StatusBarmultilengths {elem used attr required flash def} {
  585.     html::StatusBarcoords $elem $used $attr $required $flash $def 1
  586. }
  587.  
  588. # datetime 
  589. proc html::StatusBardatetime {elem used attr required flash def} {
  590.     set text ""
  591.     if {[catch {html::StatusAskAttr $elem $used $attr $required $flash $def 1 0 "" html::CheckStatusDateTime "Incorrect date and time."} v]} {
  592.         html::statusError v ""
  593.     } elseif {[string length $v]} {
  594.         if {[string tolower $v] == "now"} {set v [html::ISOtime]}
  595.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  596.     }
  597.     return $text
  598. }
  599.  
  600. proc html::StatusAskAttr {elem used attr required flash def trim casesensitive {choices ""} {checkFunc ""} {errMsg ""}} {
  601.     global htmlAttrTabSeen htmlActiveInput HTMLmodeVars htmlActiveChoices html::ActiveUsed html::ActiveAttr htmlCaseSensitive alpha::platform
  602.  
  603.     set html::ActiveAttr $attr
  604.     set html::ActiveUsed $used
  605.     set htmlActiveChoices $choices
  606.     set htmlAttrTabSeen 0
  607.     set htmlCaseSensitive $casesensitive
  608.     set pr [html::StatusElemPrompt $elem $attr $required $def]
  609.     while {1} {
  610.         set v ""
  611.         while {[catch {html::statusPrompt $flash $pr html::AttrStatusFunc} v]} {
  612.             if {$v == "Cancel all!"} {
  613.                 error "Cancel all!"
  614.             }
  615.             if {$v == "Continue!"} {
  616.                 set v $htmlActiveInput
  617.                 unset htmlActiveInput
  618.                 break
  619.             }
  620.             if {$v == "Skip rest!"} {error "Skip rest!"}
  621.             if {$v == "No value"} {return}
  622.         }
  623.         
  624.         if {$trim} {set v [string trim $v]}
  625.         if {$v == ""} {return $def}
  626.         # Check value
  627.         if {$checkFunc != ""} {
  628.             if {![$checkFunc $v]} {
  629.                 alertnote $errMsg
  630.             } else {
  631.                 break
  632.             }
  633.         } else {
  634.             break
  635.         }
  636.     }
  637.     
  638.      # if there are choices, check if the user has typed one.
  639.     if {![llength $choices]} {
  640.         return $v
  641.     } else {
  642.         set matches ""
  643.         foreach w $choices {
  644.             if {$casesensitive} {
  645.                 set c $v
  646.             } else {
  647.                 set c [string toupper $v]    
  648.             }
  649.             if {[string match "${c}*" $w]} {
  650.                 lappend matches $w 
  651.             }
  652.         } 
  653.         # if unique extension, add what's needed, otherwise return nothing.
  654.         if {[llength $matches] == 1 && [string length $v]} {
  655.             set ret $matches
  656.             if {!$casesensitive} {
  657.                 set ret [html::SetCase $ret] 
  658.             }
  659.             return $ret
  660.         } else {
  661.             return
  662.         }
  663.     }
  664. }
  665.  
  666. # CDATA element attribute, status window match completion
  667. proc html::AttrStatusFunc {args} {
  668.     global html::ActiveUsed htmlActiveChoices html::ActiveAttr htmlAttrTabSeen htmlActiveInput htmlCaseSensitive alpha::platform
  669.  
  670.     eval html::statusArgs curr c $args
  671.     # should we set the case or not (are there predefined choices)?
  672.     set matches {}
  673.     set attr ${html::ActiveAttr}
  674.     foreach w $htmlActiveChoices {
  675.         if {$htmlCaseSensitive} {
  676.             if {[string match "${curr}*" $w]} {
  677.                 lappend matches $w
  678.             }
  679.         } elseif {[string match [string toupper "${curr}*"] $w]} {
  680.             lappend matches $w
  681.         }
  682.     }
  683.     
  684.     if {$c != "\t" } {
  685.         set htmlAttrTabSeen 0
  686.         if {[llength $htmlActiveChoices]} {
  687.         # check if the last character matches
  688.             set matches {}
  689.             foreach w $htmlActiveChoices {
  690.                 if {[string match [string toupper "${curr}${c}*"] $w]} {
  691.                     lappend matches $w
  692.                 }
  693.             }
  694.             if {[llength $matches]} { 
  695.                 if {!$htmlCaseSensitive} {
  696.                     set c [html::SetCase $c] 
  697.                 }
  698.                 return [html::statusReturn $c]
  699.             } else {
  700.                 beep
  701.                 return [html::statusReturn ""]
  702.             } 
  703.         } else {
  704.             return [html::statusReturn $c]
  705.         }
  706.     }
  707.     
  708.     # it's a tab
  709.     if {![llength $matches]} {
  710.         beep
  711.     } else {
  712.         if {$htmlAttrTabSeen} {
  713.             if {[catch {listpick -p ${html::ActiveUsed}:${html::ActiveAttr} $matches} ret]} {
  714.                 set ret ""
  715.             }
  716.             if {[string length $ret]} {
  717.                 set htmlActiveInput $ret
  718.                 error "Continue!"
  719.             }
  720.             set htmlAttrTabSeen 0
  721.         } else {
  722.             set htmlAttrTabSeen 1
  723.             set ret [string range [largestPrefix $matches] [string length $curr] end]
  724.         }
  725.         if {!$htmlCaseSensitive} { 
  726.             # special case 
  727.             set ret [html::SetCase $ret] 
  728.         }
  729.         return [html::statusReturn $ret]
  730.     }
  731.     return [html::statusReturn ""]
  732. }
  733.  
  734. #===============================================================================
  735. # ◊◊◊◊ Character ◊◊◊◊ #
  736. #===============================================================================
  737.  
  738. # character
  739. proc html::StatusBarcharacter {elem used attr required flash def} {
  740.     set text ""
  741.     set pr [html::StatusElemPrompt $elem $attr $required $def]
  742.     while {[catch {html::statusPrompt $flash $pr html::AskCharacter} v]} {
  743.         if {$v == "No value"} {return}
  744.         html::statusError v ""
  745.     }
  746.     if {$v == ""} {set v $def}
  747.     if {$v != ""} {append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]}
  748.     return $text
  749. }
  750.  
  751. # Force yes or no in the status window
  752. proc html::AskCharacter {args} {
  753.     eval html::statusArgs curr c $args
  754.     if {$curr == "" && $c != " "} {return [html::statusReturn $c]}
  755.     beep
  756.     return [html::statusReturn ""]
  757. }
  758.  
  759. #===============================================================================
  760. # ◊◊◊◊ Length / Integer ◊◊◊◊ #
  761. #===============================================================================
  762.  
  763. # length
  764. proc html::StatusBarlength {elem used attr required flash def} {
  765.     global html::StatusNumRegexp
  766.     set html::StatusNumRegexp {^(\+|-)?([0-9]*|[0-9]+%?)$}
  767.     html::_AskNumber $elem $used $attr $required $flash $def 1 0
  768. }
  769.  
  770. # integer
  771. proc html::StatusBarinteger {elem used attr required flash def} {
  772.     global html::StatusNumRegexp
  773.     set html::StatusNumRegexp {^(\+|-)?[0-9]*$}
  774.     html::_AskNumber $elem $used $attr $required $flash $def 0 0
  775. }
  776.  
  777. # multilength 
  778. proc html::StatusBarmultilength {elem used attr required flash def} {
  779.     global html::StatusNumRegexp
  780.     set html::StatusNumRegexp {^(\*|(\+|-)?([0-9]*|[0-9]+(\*|%)?))$}
  781.     html::_AskNumber $elem $used $attr $required $flash $def 1 1
  782. }
  783.  
  784. proc html::_AskNumber {elem used attr required flash def procent multilength} {
  785.     set text ""
  786.     if {[catch {html::AskNumber $elem $used $attr $required $flash $def $procent $multilength} v]} {
  787.         html::statusError v ""
  788.     } elseif {[string length $v]} {
  789.         append text [html::WrapTag "[html::SetCase $attr][html::AddQuotes $v]"]
  790.     }
  791.     return $text    
  792. }
  793.  
  794. # ask for an attribute which is a number. Returns "" if input is not valid.
  795. proc html::AskNumber {elem used attr required flash default procent multilength} {
  796.     global HTMLmodeVars html::ActiveWidth html::ActiveHeight alpha::platform
  797.     
  798.     
  799.     # loop until input is valid, then something is returned
  800.     while {1} { 
  801.         set pr [html::StatusElemPrompt $elem $attr $required ""]
  802.         
  803.         if {$elem == "IMG" && $attr == "WIDTH=" && ${html::ActiveWidth} != ""} {
  804.             append pr " \[${html::ActiveWidth}\] "
  805.         } elseif {$elem == "IMG" && $attr == "HEIGHT=" && ${html::ActiveHeight} != ""} {
  806.             append pr " \[${html::ActiveHeight}\] "
  807.         } elseif {$default != ""} {
  808.             append pr " \[$default\] "
  809.         }
  810.         while {[catch {html::statusPrompt $flash $pr html::NumberStatusFunc} r]} { 
  811.             if {$r == "Cancel all!"} {error "Cancel all!"}
  812.             if {$r == "Skip rest!"} {error "Skip rest!"}
  813.             if {$r == "No value"} {return}
  814.         }
  815.         set r [string trim $r]
  816.         # if no input, return default
  817.         if {$r == ""} {
  818.             if {$elem == "IMG" && $attr == "WIDTH=" && ${html::ActiveWidth} != ""} {
  819.                 return ${html::ActiveWidth}
  820.             } elseif {$elem == "IMG" && $attr == "HEIGHT=" && ${html::ActiveHeight} != ""} {
  821.                 return ${html::ActiveHeight}
  822.             } else {
  823.                 return $default
  824.             }
  825.         }
  826.         # check that input is valid.
  827.         set numcheck [html::CheckAttrNumber $used $attr $r $procent $multilength]
  828.         if {$numcheck == 1} {
  829.             return $r 
  830.         } else {
  831.             alertnote "Invalid input. $numcheck"
  832.         }
  833.     }
  834. }
  835.  
  836. proc html::NumberStatusFunc {args} {
  837.     global html::StatusNumRegexp
  838.     eval html::statusArgs curr c $args
  839.     if {![regexp ${html::StatusNumRegexp} $curr$c]} {
  840.         beep
  841.         set c ""
  842.     }
  843.     return [html::statusReturn $c]
  844. }
  845.     
  846.  
  847. #===============================================================================
  848. # ◊◊◊◊ Help procs ◊◊◊◊ #
  849. #===============================================================================
  850.  
  851. proc html::statusPrompt {flash prompt func} {
  852.     global alpha::platform
  853.     
  854.     if {${alpha::platform} == "alpha"} {
  855.         if {[catch {eval [concat statusPrompt $flash [list $prompt] $func]} r]} {
  856.             error $r
  857.         } else {
  858.             return $r
  859.         }
  860.     }
  861.     if {${alpha::platform} == "tk"} {
  862.         set patt ""
  863.         if {[catch {eval [concat status::prompt $flash -add anything -command $func [list $prompt]]} r]} {
  864.             if {$r == "return"} {return $patt}
  865.             error $r
  866.         } else {
  867.             return $patt
  868.         }
  869.     }
  870. }
  871.  
  872. proc html::statusArgs {current char args} {
  873.     upvar $current curr $char c
  874.     global alpha::platform
  875.     if {${alpha::platform} == "alpha"} {
  876.         set curr [lindex $args 0]
  877.         set c [lindex $args 1]
  878.     } else {
  879.         upvar 2 patt patt
  880.         set c [lindex $args 0]
  881.         if {$c == "\b"} {
  882.             set c ""
  883.             set patt [string range $patt 0 [expr {[string length $patt] - 2}]]
  884.         }
  885.         if {$c == "\033"} {error "escape"}
  886.         set curr $patt
  887.         if {[lindex $args 1] == ""} {error "return"}
  888.         if {[expr {[lindex $args 1] & 144}]} {
  889.             if {$c == "q"} {set c "\021"}
  890.             if {$c == "d"} {set c "\004"}
  891.             if {$c == "z"} {set c "\032"}
  892.             if {$c == "f"} {set c "\006"}
  893.         }
  894.         if {[expr {[lindex $args 1] & 1}]} {
  895.             if {$c == "v"} {set c [getScrap]}
  896.         }
  897.     }
  898.     if {$c == "\032"} {error "Cancel all!"}
  899.     if {$c == "\021"} {error "Skip rest!"}
  900.     if {$c == "\004"} {error "No value"}
  901.     
  902. }
  903.  
  904. proc html::statusReturn {c} {
  905.     global alpha::platform
  906.     if {${alpha::platform} == "alpha"} {return $c}
  907.     upvar 2 patt patt
  908.     append patt $c
  909.     upvar 2 prompt pr
  910.     message "$pr$patt "
  911.     return ""
  912. }
  913.  
  914. proc html::statusError {val def} {
  915.     upvar $val var
  916.     if {$var == "Cancel all!"} {
  917.         message "Cancel"
  918.         error "Cancel"
  919.     }
  920.     if {$var == "Skip rest!"} {
  921.         error "Skip rest!"
  922.     }
  923.     if {$var == "No value"} {
  924.         set var $def
  925.         return 1
  926.     }
  927.     return 0
  928. }
  929.  
  930. proc html::CheckStatusDateTime {val} {
  931.     if {[string tolower $val] == "now"} {return 1}
  932.     if {[regexp {^([0-9]+)-([0-9]+)-([0-9]+)T([0-9]+):([0-9]+):([0-9]+)(Z|[-+][0-9]+:[0-9]+)$} $val "" Y M D h m s tzd]} {
  933.         return [expr ![catch {html::CheckDateTime [list $Y $M $D $h $m $s $tzd]}]]
  934.     }
  935.     return 0
  936. }
  937.  
  938. proc html::_CheckStatusCoords {val multilength} {
  939.     global html::ActiveUsed html::ActiveAttr
  940.     if {$val != ""} {
  941.         foreach l [split $val ,] {
  942.             set l [string trim $l]
  943.             set numcheck [html::CheckAttrNumber ${html::ActiveUsed} ${html::ActiveAttr} $l 1 $multilength]
  944.             if {$numcheck != 1} {
  945.                 return 0
  946.             }
  947.         }
  948.     }
  949.     return 1
  950. }
  951.  
  952. proc html::CheckStatusCoords {val} {
  953.     html::_CheckStatusCoords $val 0
  954. }
  955.  
  956. proc html::CheckStatusMultiLengths {val} {
  957.     html::_CheckStatusCoords $val 1
  958. }
  959.