home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-07-16 | 55.0 KB | 2,163 lines | [TEXT/ALFA] |
- #================================================================================
- #
- # html.tcl: macros and bindings for editing HTML documents.
- #
- # Copyright 1994,1995 by Scott W. Brim. You may use this software freely, and
- # distribute it freely, as long as the receiver is not obligated in any
- # way by receiving it.
- #
- # See HTML Help in the Help folder.
- # Original ideas taken from Marc Andreesen's html.el and Tom Scavo's latex.tcl.
- # If you make improvements, please share them!
- #
- # Scott Brim <swb1@cornell.edu>
- #
- #================================================================================
- #
- # Change Log:
- #
- # Version 0.24, 04 July 1995
- #
- # Fixed browser launching.
- # Character entities now colored.
- # URL prompt was messed up if user hadn't typed anything before double tab.
- #
- # Version 0.23, 14 June 1995
- #
- # Remove 'processing instructions' - confusing some people.
- # Less whitespace around <p> if text selected.
- # Add optional HEIGHT=, WIDTH=, HSPACE= to IMG
- #
- # Version 0.22, 08 June 1995
- #
- # Keybindings default to ctrl-opt, not cmd-opt. Removed useCtlCmd option.
- # User can now set keybinding prefixes. See help file.
- # Keybinding icons displayed in menus.
- # "launch browser" moved to shift-cmd-S, standard for compilers.
- # cmd-v, not ctrl-y pastes in statusBar.
- # URL prompts done with prompt popup and menu (comments, please).
- # Double tab when prompted for URL in statusBar puts up prompt window.
- # htmlBrowserPath added to Mode:AppPaths menu.
- # Allow custom definition of the htmlMenu icon or string (default Ñ942)
- # Add optional WIDTH= to TH and TD
- # Restore names "less than", etc., to commonly used characters list.
- # Better colorizing.
- # Slight fixes to Select Tag, Untag.
- # Remove Tab Marks now bound to cmd-tab
- #
- # Version 0.21, 31 May 1995
- #
- # IMG is no longer a container.
- # Tuned statusbar handling of attribute choices using uppercase.
- # Add "common characters" to char entity menu, with add and clear commands.
- # Other messing with menus.
- # Took out extra è.
- # Tuned cmd-B and Untag - still not universally satisfying.
- # "Processing Instructions" (PIs, <?>) added to menu.
- # Bind "untag" to shift-cmd-opt-u.
- # Added method alternates for FORM.
- # Avoid adding empty URLs to the list.
- #
- # Version 0.20, 21 May 1995
- #
- # htmlBalance, on cmd-B, selects text between matching tags
- # Added Untag to menu. No keybinding yet. Doesn't work if opening
- # tag has a "/" in one of its attributes, but that should be rare.
- #
- # Version 0.19, 20 May 1995
- #
- # browseInForeground flag: if set, switch to browser, otherwise leave
- # browser in background (good if validating & lots of screen space)
- # CLEAR= attribute for <BR>
- # fixed bindings for &, <, and >
- # ctrl-y pastes clipboard during statusbar prompts
- # Put extra newlines back in
- #
- # Version 0.18, 10 May 1995
- #
- # Tables
- # User-custom menu support (see help file)
- # Netscape attributes available (but not default) on BODY
- # <LI>, <DT>, <DD> optionally closed
- # Add selection/clipboard to URL cache
- # "id" allowed on all elements
- # Fix lower-case behavior for Mosaic
- # Extra checks on tab stops
- # Launch browser, on opt-cmd-right
- # Choice of case for elements again
- # No extra <cr> out after containers on own line
- # Fixed up <P> behavior
- # Add opt-cmd-return binding for <P>
- # A few more element attributes
- # Spaces taken out after <LI>, <DD>, and <DT>
- # Small fixes to NewTemplate
- #
- # Version 0.17, 02 May 1995
- #
- # Renamed all mode-specific variables (redo your customizations)
- # Lots of editorial manicuring (redo your customizations)
- # Big experiment with element attributes in statusBar and popups
- # Thanks to Ian Alderman for several ideas.
- # Completely new menus, some dynamic
- # All HTML 2.0 elements
- # Assume Version 6.0
- #
- # Version 0.16, 30 November 1994
- #
- # Split out htmlMode.tcl for faster startup.
- # Take out single-character bindings <, >, & - collision with isearch.
- # Clean up handling of HTML-specific flags and variables. Fix help
- # accordingly.
- # Support user keywords for coloring through variable HTMLwords (like Cwords).
- # Add htmlDividingLine.
- # Clump some text insertion for easier undo
- #
- # Version 0.15, 17 August 1994
- #
- # HTML mode is now integrated into the main Alpha distribution.
- # Better documentation all around.
- # Use newModeVar and shadowing; remove requirement that certain flags
- # be set before or after html.tcl is loaded.
- #
- #===============================================================================
- #
- # To Do:
- #
- # double tab with choices should put up listpick.
- # Add cmd to turn chars in selection into entities
- # parameterize template -- include HTMLmodeVars(htmlNewTmplHeadElems) {} and
- # HTMLmodeVars(htmlNewTmplBodyElems) {} if they exist, on separate lines.
- # Multiple URL cache sets.
- # URL cache popup: have 'file' option, allow standard file select
- # routine, and format URL right. Need relative vs. absolute paths,
- # and translation of characters. Either that or have URL menu item
- # which does a file dialog (and translates chars etc.).
- # Allow user to set color (via modeVar) - shadow it.
- # Click (or something) on a tag -> jump into HTML spec for help.
- # Lump more text inserts, integral for undo. carriagereturn, openCR, closeCR.
- # after launch browser, see if really launched (check list of processes)
- # Better searching for headers for HTMLMarkFile, e.g. to find headers even
- # when there are IMGs embedded in them.
- # Select Container -- if one of p/li/dt/dd, see if there is another opening
- # tag before the closing tag, in case user mixed uses.
- # Proc to automatically put <P>s at newlines in region.
- # cmd-doubleclick to follow local file URLs. Perhaps notice <BASE>.
- # htmlFillParagraph sensitive to HTML elements.
- # better indentation management
- # Automatically take a plaintext *'d list and turn it into a <ul> list.
- # Customizable automatic insertion or changing of "last modified" line
- # HTML3 mode - cut html.tcl in dependent and independent parts, create html3.tcl
- #================================================================================
-
- #===============================================================================
- # Global variables and their management
- #===============================================================================
-
- if {![info exists htmlMenu]} {set htmlMenu "Ñ135"}
- # if {![info exists htmlMenu]} {set htmlMenu "Ñ942"}
-
- set commentPreString "<!-- "
- set commentSufString " -->"
-
- newModeVar HTML wordWrap 1 1
- newModeVar HTML prefixString $commentPreString 0
- newModeVar HTML suffixString $commentSufString 0
- # how to fill in element attributes
- newModeVar HTML useStatusBar 0 1
- newModeVar HTML promptNoisily 1 1
- # Should elements be lower case?
- newModeVar HTML useLowerCase 0 1
- # Should Ñ's be inserted?
- newModeVar HTML useTabMarks 1 1
- # Use opt-cmd or ctl-cmd? Hack for int'l users.
- # commented out since moved to ctrl-opt
- # newModeVar HTML useCtlCmd 0 1
- # Are <p>, <li>, <dd>, <dl> containers?
- newModeVar HTML allContainers 1 1
- # A list of URLs, cached, to pick from for insertion
- newModeVar HTML URLs {} 0
- # When browser is launched, should it be brought to front?
- newModeVar HTML browseInForeground 1 1
- # Default number of discursive list entries
- newModeVar HTML dlEntries 3 0
- # These element attributes require quotation marks
- newModeVar HTML quotedAttrs {NAME= HREF= URN= TITLE= METHODS= SRC= ALT= ALIGN= \
- ACTION= ENCTYPE= VALUE= CONTENT= ID=} 0
- # These element attributes are URLs (right now, anyway)
- newModeVar HTML URLAttrs {HREF= URI= URN= SRC= ACTION=} 0
- # all elements get these
- newModeVar HTML elemAttrsForAll {ID= } 0
- # list of commonly used character entities
- newModeVar HTML defaultCommonChars {"less than" "greater than" "ampersand"} 0
- newModeVar HTML commonChars $HTMLmodeVars(defaultCommonChars) 0
- # these are the prefixes for keybindings
- newModeVar HTML htmlBindPrefix oz 0
- newModeVar HTML htmlSBindPrefix soz 0
- newModeVar HTML htmlMenuPrefix "<B<I" 0
- newModeVar HTML htmlSMenuPrefix "<U<B<I" 0
-
- #
- # this proc allows HTML mode arrays like newModeVar
- #
- proc htmlNewElemVar {list var val} {
- global $list
- if {![info exists ${list}($var)]} { set ${list}($var) $val }
- }
-
- #
- # the per-element lists of all possible attributes
- #
- htmlNewElemVar htmlElemAttrAll A {HREF= NAME= REL= REV= TITLE= URN= METHODS=}
- htmlNewElemVar htmlElemAttrAll ADDRESS {}
- htmlNewElemVar htmlElemAttrAll B {}
- htmlNewElemVar htmlElemAttrAll BASE {HREF=}
- htmlNewElemVar htmlElemAttrAll BLOCKQUOTE {}
- htmlNewElemVar htmlElemAttrAll BODY {BACKGROUND= TEXT= LINK= VLINK= }
- htmlNewElemVar htmlElemAttrAll BR {CLEAR= }
- htmlNewElemVar htmlElemAttrAll CAPTION {ALIGN=}
- htmlNewElemVar htmlElemAttrAll CENTER {}
- htmlNewElemVar htmlElemAttrAll CITE {}
- htmlNewElemVar htmlElemAttrAll CODE {}
- htmlNewElemVar htmlElemAttrAll DD {}
- htmlNewElemVar htmlElemAttrAll DIR {COMPACT}
- htmlNewElemVar htmlElemAttrAll DL {COMPACT}
- htmlNewElemVar htmlElemAttrAll DT {}
- htmlNewElemVar htmlElemAttrAll EM {}
- htmlNewElemVar htmlElemAttrAll FORM {ACTION= METHOD= ENCTYPE= }
- htmlNewElemVar htmlElemAttrAll H1 { }
- htmlNewElemVar htmlElemAttrAll H2 { }
- htmlNewElemVar htmlElemAttrAll H3 { }
- htmlNewElemVar htmlElemAttrAll H4 { }
- htmlNewElemVar htmlElemAttrAll H5 { }
- htmlNewElemVar htmlElemAttrAll H6 { }
- htmlNewElemVar htmlElemAttrAll HEAD {}
- htmlNewElemVar htmlElemAttrAll HR {ALIGN= SIZE= WIDTH=}
- htmlNewElemVar htmlElemAttrAll HTML { }
- htmlNewElemVar htmlElemAttrAll I {}
- htmlNewElemVar htmlElemAttrAll IMG {SRC= ALT= ALIGN= BORDER= ISMAP HEIGHT= WIDTH= HSPACE=}
- htmlNewElemVar htmlElemAttrAll INPUT {NAME= TYPE= VALUE= CHECKED SIZE= ALIGN= SRC= }
- htmlNewElemVar htmlElemAttrAll ISINDEX {}
- htmlNewElemVar htmlElemAttrAll KBD {}
- htmlNewElemVar htmlElemAttrAll LI {}
- htmlNewElemVar htmlElemAttrAll LINK {HREF= REL= REV= TITLE= URN= METHODS= }
- htmlNewElemVar htmlElemAttrAll MENU {COMPACT }
- htmlNewElemVar htmlElemAttrAll META {CONTENT= HTTP-EQUIV= NAME= }
- htmlNewElemVar htmlElemAttrAll NEXTID {N=}
- htmlNewElemVar htmlElemAttrAll OL {COMPACT }
- htmlNewElemVar htmlElemAttrAll OPTION {SELECTED VALUE=}
- htmlNewElemVar htmlElemAttrAll P {ALIGN= }
- htmlNewElemVar htmlElemAttrAll PRE {WIDTH= }
- htmlNewElemVar htmlElemAttrAll SAMP {}
- htmlNewElemVar htmlElemAttrAll SELECT {MULTIPLE NAME= SIZE= }
- htmlNewElemVar htmlElemAttrAll STRONG {}
- htmlNewElemVar htmlElemAttrAll TABLE {BORDER= BORDER CELLSPACING= CELLPADDING= WIDTH= }
- htmlNewElemVar htmlElemAttrAll TEXTAREA {NAME= ROWS= COLS= }
- htmlNewElemVar htmlElemAttrAll TITLE { }
- htmlNewElemVar htmlElemAttrAll TD {ALIGN= VALIGN= NOWRAP COLSPAN= ROWSPAN= WIDTH=}
- htmlNewElemVar htmlElemAttrAll TH {ALIGN= VALIGN= NOWRAP COLSPAN= ROWSPAN= WIDTH=}
- htmlNewElemVar htmlElemAttrAll TR {ALIGN= VALIGN= }
- htmlNewElemVar htmlElemAttrAll TT {}
- htmlNewElemVar htmlElemAttrAll UL {COMPACT}
- htmlNewElemVar htmlElemAttrAll VAR {}
-
- #
- # element-specific attribute completions
- #
- htmlNewElemVar htmlElemAttrChoices BR {CLEAR=ALL CLEAR=LEFT CLEAR=RIGHT }
- htmlNewElemVar htmlElemAttrChoices CAPTION {ALIGN=BOTTOM ALIGN=TOP }
- htmlNewElemVar htmlElemAttrChoices FORM {METHOD=GET METHOD=POST}
- htmlNewElemVar htmlElemAttrChoices INPUT {TYPE=CHECKBOX TYPE=HIDDEN TYPE=IMAGE
- TYPE=PASSWORD TYPE=RADIO TYPE=RESET TYPE=SUBMIT TYPE=TEXT
- ALIGN=LEFT ALIGN=MIDDLE ALIGN=RIGHT}
- htmlNewElemVar htmlElemAttrChoices IMG {ALIGN=BOTTOM ALIGN=MIDDLE ALIGN=TOP ALIGN=LEFT ALIGN=RIGHT}
- htmlNewElemVar htmlElemAttrChoices P {ALIGN=LEFT ALIGN=MIDDLE ALIGN=RIGHT}
- htmlNewElemVar htmlElemAttrChoices TR {ALIGN=LEFT ALIGN=CENTER ALIGN=RIGHT
- VALIGN=BASELINE VALIGN=BOTTOM VALIGN=MIDDLE VALIGN=TOP }
- htmlNewElemVar htmlElemAttrChoices TD {ALIGN=LEFT ALIGN=CENTER ALIGN=RIGHT
- VALIGN=BASELINE VALIGN=BOTTOM VALIGN=MIDDLE VALIGN=TOP }
- htmlNewElemVar htmlElemAttrChoices TH {ALIGN=LEFT ALIGN=CENTER ALIGN=RIGHT
- VALIGN=BASELINE VALIGN=BOTTOM VALIGN=MIDDLE VALIGN=TOP }
-
- #
- # the per-element list of attributes actually wanted at this time.
- #
- htmlNewElemVar htmlElemAttrUsed A {HREF= NAME=}
- htmlNewElemVar htmlElemAttrUsed BASE {HREF=}
- htmlNewElemVar htmlElemAttrUsed CAPTION {ALIGN=}
- htmlNewElemVar htmlElemAttrUsed DIR {COMPACT}
- htmlNewElemVar htmlElemAttrUsed DL {COMPACT}
- htmlNewElemVar htmlElemAttrUsed FORM {ACTION=}
- htmlNewElemVar htmlElemAttrUsed IMG {SRC= ALT= ALIGN= ISMAP}
- htmlNewElemVar htmlElemAttrUsed INPUT {TYPE= NAME= VALUE= SRC= SIZE= MAXLENGTH= ALIGN=}
- htmlNewElemVar htmlElemAttrUsed LINK {HREF=}
- htmlNewElemVar htmlElemAttrUsed MENU {COMPACT}
- htmlNewElemVar htmlElemAttrUsed META {HTTP-EQUIV= NAME= CONTENT=}
- htmlNewElemVar htmlElemAttrUsed NEXTID {N=}
- htmlNewElemVar htmlElemAttrUsed OPTION {SELECTED VALUE=}
- htmlNewElemVar htmlElemAttrUsed PRE {WIDTH=}
- htmlNewElemVar htmlElemAttrUsed SELECT {NAME= SIZE= MULTIPLE}
- htmlNewElemVar htmlElemAttrUsed TABLE {BORDER}
- htmlNewElemVar htmlElemAttrUsed TD {NOWRAP ALIGN= VALIGN= COLSPAN= ROWSPAN=}
- htmlNewElemVar htmlElemAttrUsed TEXTAREA {NAME= ROWS= COLS=}
- htmlNewElemVar htmlElemAttrUsed TH {NOWRAP ALIGN= VALIGN= COLSPAN= ROWSPAN=}
- htmlNewElemVar htmlElemAttrUsed TR {ALIGN= VALIGN=}
- #
- # these two are special (perhaps there will be more A types in the future)
- #
- htmlNewElemVar htmlElemAttrUsed ANCHOR {NAME=}
- htmlNewElemVar htmlElemAttrUsed HREF {HREF=}
-
-
- #
- # color support
- #
- # foreach t [array names htmlElemAttrAll] {
- # set l [string tolower $t]
- # set u [string toupper $t]
- # lappend HTMLKeyWords <${l}> </${l}> <${u}> </${u}>
- # }
- set HTMLKeyWords {}
- if {[info exists HTMLwords]} {set HTMLKeyWords [concat $HTMLKeyWords $HTMLwords]}
- regModeKeywords -b "<" ">" -c blue -k blue HTML $HTMLKeyWords
- # regModeKeywords -b $commentPreString $commentSufString -m {<} -c red -k blue HTML $HTMLKeyWords
-
-
- #
- # Internal Globals
- #
- set htmlCurSel ""
- set htmlIsSel 0
-
- #===============================================================================
- # General Support Routines
- #===============================================================================
-
- proc htmlNotYet {} {
- alertnote "Not yet, but coming soon."
- }
-
- proc htmlSetCase {elem} {
- global HTMLmodeVars
- set useLowerCase $HTMLmodeVars(useLowerCase)
- if {$useLowerCase} {
- return [string tolower $elem]
- } else {
- return [string toupper $elem]
- }
- }
-
- #
- # Mark file
- #
- # note - for this to work, the <h.. has to be at the left margin. Given
- # that, one way to put anchors on headings is to have empty anchors
- # on the line above the heading, e.g. <a name="frob"></a>, then
- # <h2>Frobs and their Environment</h2>
- #
- proc HTMLMarkFile {} {
- set end [maxPos]
- set pos 0
- set l {}
- set exp {^(<[Aa][^>]*>)?<([Hh][1-6]>.*)</[Hh][1-6]>}
-
- while {![catch {search -f 1 -r 1 -m 0 -i 0 $exp $pos} res]} {
- set start [lindex $res 0]
- set end [lindex $res 1]
- set text [lindex [split [getText $start $end] "<>"] 2]
- set indlevel [getText [expr $start + 2] [expr $start + 3]]
-
- if {$indlevel > 0 && $indlevel < 7} {
- set lab [string range " " 2 $indlevel]
- append lab $lab $indlevel " " $text
- setNamedMark $lab $start $start $end
- }
-
- set pos $end
- }
- }
-
- # Snatch the current selection into htmlCurSel, set flag whether there is one
- proc htmlGetSel {{sel ""}} {
- global htmlCurSel htmlIsSel
- set htmlCurSel [string trim $sel]
- if {![string length $htmlCurSel]} {
- set htmlCurSel [string trim [getSelect]]
- }
- set htmlIsSel [string length $htmlCurSel]
- }
-
- #
- # return positions of tags of including elements, as a list of 4 numbers --
- # openstart openend closestart closeend.
- #
- # args: point to start search backward from; point which must be enclosed
- #
- # if any problem, return just {0}
- #
- proc htmlGetContainer {curPos inclPos} {
- # set startPos [expr $curPos == 0 ? $curPos : [expr $curPos - 1]]
- set startPos $curPos
- # find first tag
- if {[catch {search -f 0 -r 1 -i 0 -m 0 {<[^</>]+>} $startPos} res] ||
- [lindex $res 0] > [maxPos]} {
- return {0}
- }
- set tag1start [lindex $res 0]
- set tag1end [lindex $res 1]
- # get element name
- if {![regexp {<([^ \t]+).*>} [getText $tag1start $tag1end] tmp tag] ||
- [string range $tag 0 0] == "/"} {
- return {0}
- }
- # find closing tag
- # append x {</} $tag {[ \t]*[^>]*>}
- set x </${tag}>
- if {[catch {search -f 1 -r 1 -i 1 -m 0 $x $tag1end} res] ||
- [lindex $res 0] >= [maxPos]} {
- return {0}
- }
- set tag2start [lindex $res 0]
- set tag2end [lindex $res 1]
-
- # be careful of a container enclosed along with us
- if {$tag2end < $inclPos} {
- set tmp [htmlGetContainer [expr $tag1start - 1] $inclPos]
- goto $curPos
- return $tmp
- }
- goto $curPos
- return "$tag1start $tag1end $tag2start $tag2end"
- }
-
- #
- # dividing line
- #
- proc htmlDividingLine {} {
- global HTMLmodeVars fillColumn
- set wordWrap $HTMLmodeVars(wordWrap)
- set prefixString $HTMLmodeVars(prefixString)
- set suffixString $HTMLmodeVars(suffixString)
-
- set s "===================================================================================="
- set l [expr [string length $prefixString] + [string length $suffixString]]
- if {$wordWrap} {
- set l [expr $fillColumn - $l - 1]
- } else {
- set l [expr 75 - $l - 1]
- }
- insertText $prefixString [string range $s 0 $l] $suffixString
- }
-
-
- #
- # Carriage returns and tabs (much borrowed from latex.tcl)
- #
- # (there's a lot of cruft in here because I might lose it
- # if I don't keep it here while I'm working on it.
- #
-
- # A boolean function which takes any string and tests to see if
- # that string contains all whitespace characters. Carriage returns
- # are considered whitespace, as are spaces and tabs.
- proc htmlIsWhite {anyString} {
- set len [string length $anyString]
- for {set i 0} {$i < $len} {incr i} {
- set c [string index $anyString $i]
- if {($c != "\ ") && ($c != "\t") && ($c != "\r")} then {return 0}
- }
- return 1
- }
-
- # Insert a carriage return at the insertion point if any
- # character preceding the insertion point (on the same line)
- # is a non-whitespace character.
- proc htmlOpenCR {} {
- set end [getPos]
- set start [lineStart $end]
- set text [getText $start $end]
- if {![htmlIsWhite $text]} carriageReturn
- }
-
- # Insert a carriage return at the insertion point if any
- # character following the insertion point (on the same line)
- # is a non-whitespace character.
- proc htmlCloseCR {} {
- set start [getPos]
- set end [nextLineStart $start]
- set text [getText $start $end]
- if {![htmlIsWhite $text]} carriageReturn
- }
-
- # Set up tab stop mechanism.
- proc htmlTabGoto {directionIndicator} {
- set searchResult [search -n -f $directionIndicator -m 0 -i 1 -r 0 {Ñ} [getPos]]
- if {![llength $searchResult] || [lindex $searchResult 0] >= [maxPos]} {
- beep
- message "Tab stop not found"
- return 0
- } else {
- goto [lindex $searchResult 0]
- return 1
- }
- }
-
- proc htmlTabNext {} {
- if {[htmlTabGoto 1]} {deleteChar}
- }
-
- proc htmlTabPrev {} {
- if {[htmlTabGoto 0]} {deleteChar}
- }
-
- proc htmlTabDeleteAll {} {
- createTMark htmlDelTabMark [getPos]
- goto 0
- set searchpos 0
- while {1} {
- if {$searchpos == [maxPos]} break
- set searchResult [search -f 1 -r 0 -m 0 -n {Ñ} $searchpos]
- if {[llength $searchResult] == 0 || [lindex $searchResult 0] >= [maxPos]} break
- deleteText [lindex $searchResult 0] [lindex $searchResult 1]
- set searchpos [getPos]
- }
- message "Tab stops deleted"
- gotoTMark htmlDelTabMark
- removeTMark htmlDelTabMark
- }
-
-
-
-
- #===============================================================================
- # Building tags, including element attributes
- #===============================================================================
-
- # Opening or only tag of an element - include attributes
- proc htmlOpenElem {elem {used ""}} {
- global htmlActiveElem htmlElemAttrUsed htmlActiveUsed htmlActiveAttr htmlElemAttrChoices
- global HTMLmodeVars
- set promptNoisily $HTMLmodeVars(promptNoisily)
- set useStatusBar $HTMLmodeVars(useStatusBar)
- set URLAttrs $HTMLmodeVars(URLAttrs)
-
- if {![string length $used]} {set used $elem}
- set elem [string toupper $elem]
- set used [string toupper $used]
-
- set htmlActiveUsed $used
- set htmlActiveElem $elem
- set text "<"
- append text [htmlSetCase $elem]
-
- # if there are attributes to ask about, do so
- if {![catch {set atts $htmlElemAttrUsed($used)}] && [string length $atts]} {
- foreach attr $atts {
- catch {unset tmp}
- set htmlActiveAttr $attr
- if {[lsearch -exact $URLAttrs $attr] >= 0} {
- set v [htmlAskURL $attr]
- if {[string length $v]} {
- append text " " [htmlSetCase $attr] [htmlCheckQuotes $attr $v]
- }
- } elseif {$useStatusBar} {
- if {$promptNoisily} {beep}
- if {[string index $attr [expr [string length $attr] - 1]] == "="} {
- set v [string trim [statusPrompt ${elem}:$attr htmlAttrStatusFunc]]
- if {[string length $v]} {
- append text " " [htmlSetCase $attr] [htmlCheckQuotes $attr $v]
- }
- } else {
- set v [statusPrompt "${elem}:$attr \[n\] " htmlStatusAskYesOrNo]
- if {$v == "yes"} {append text " " [htmlSetCase $attr]}
- }
- } else {
- if {[string index $attr [expr [string length $attr] - 1]] == "="} {
- set v [htmlAttrChoicePrompt $elem $attr]
- if {[string length $v]} {
- append text " " [htmlSetCase $attr] [htmlCheckQuotes $attr $v]
- }
- } else {
- if {[askyesno "${elem}:${attr}?"] == "yes"} {append text " " [htmlSetCase $attr]}
- }
- }
- }
- }
- append text ">"
- catch {unset htmlActiveUsed}
- catch {unset htmlActiveElem}
- catch {unset htmlActiveAttr}
- return ${text}
- }
-
- # HREF attributes are handled as a listpick from a cached list
- proc htmlAskURL {attr} {
- global modifiedModeVars htmlURLTabSeen
- global HTMLmodeVars htmlActiveElem
- set URLs $HTMLmodeVars(URLs)
- set useStatusBar $HTMLmodeVars(useStatusBar)
- set promptNoisily $HTMLmodeVars(promptNoisily)
-
- if {$useStatusBar} {
- if {$promptNoisily} {beep}
- set htmlURLTabSeen 0
- if {[catch {statusPrompt ${htmlActiveElem}:$attr htmlURLStatusFunc} r] ||
- ![string length $r]} {
- return ""
- }
- } else {
- set r [htmlPromptURL $attr "http://" $URLs]
- }
- set r [string trim $r]
- if {[string length $r] && [lsearch -exact $URLs $r] < 0} {
- set URLs [lsort [lappend URLs $r]]
- # We have to spin the disk each time or the value of URLs
- # displayed in 'view user defs' won't be accurate.
- # So far I don't want to spin the disk (for powerbook users)
- # addArrDef HTMLmodeVars URLs $URLs
- set HTMLmodeVars(URLs) $URLs
- lappend modifiedModeVars {URLs HTMLmodeVars}
- }
- return $r
- }
-
- # popup prompt for one from a list of URLs
- proc htmlPromptURL {attr pr URLs} {
- global HTMLmodeVars htmlActiveElem
-
- if {![catch [concat [list prompt "${htmlActiveElem}:${attr}?" $pr ""] $URLs] r]} {
- return $r
- }
- return ""
- }
-
- proc htmlURLStatusFunc {curr c} {
- global HTMLmodeVars htmlActiveElem htmlActiveAttr htmlURLTabSeen
- set URLs $HTMLmodeVars(URLs)
-
- if {$c != "\t"} {
- set htmlURLTabSeen 0
- return $c
- }
- # # this was ctrl-y
- # if {$c == "\031"} {
- # set htmlURLTabSeen 0
- # return [getScrap]
- # }
-
- set matches {}
- set attr $htmlActiveAttr
- foreach w $URLs {
- if {[string match "$curr*" $w]} {
- lappend matches $w
- }
- }
- if {![llength $matches]} {
- beep
- } else {
- if {$htmlURLTabSeen} {
- set pr $curr
- if {![string length $pr]} {set pr "http://"}
- set ret [htmlPromptURL $attr $pr $matches]
- set ret [string range $ret [string length $curr] end]
- } else {
- set htmlURLTabSeen 1
- set ret [string range [largestPrefix $matches] [string length $curr] end]
- }
- if {[string length $ret]} {
- set htmlURLTabSeen 0
- return $ret
- }
- beep
- }
- return ""
- }
-
- # CDATA element attribute, status window match completion
- proc htmlAttrStatusFunc {curr c} {
- global htmlElemAttrChoices htmlActiveUsed htmlActiveAttr
-
- # should we set the case or not (are there predefined choices)?
- set choices {}
- catch {set choices [concat choices $htmlElemAttrChoices($htmlActiveUsed)]}
- set matches {}
- set attr $htmlActiveAttr
- foreach w $choices {
- if {[string match [string toupper "${attr}$curr*"] $w]} {
- lappend matches [string range $w [string length $attr] end]
- }
- }
- # ctrl-y pastes clipboard
- if {$c != "\t" && $c != "\031"} {
- if {[llength $matches]} { set c [htmlSetCase $c] }
- return $c
- }
- if {$c == "\031"} {
- set c [getScrap]
- if {[llength $matches]} { set c [htmlSetCase $c] }
- return $c
- }
- # it's a tab
- if {![llength $matches]} {
- beep
- } else {
- set ret [string range [largestPrefix $matches] [string length $curr] end]
- if {[string length $ret]} {return [htmlSetCase $ret]}
- beep
- }
- return ""
- }
-
- # Force yes or no in the status window
- proc htmlStatusAskYesOrNo {curr c} {
- set c [string tolower $c]
- if {[string length $curr] == 0} {
- if {$c == "n"} {return "no"}
- if {$c == "y"} {return "yes"}
- if {$c == "N"} {return "no"}
- if {$c == "Y"} {return "yes"}
- beep
- return ""
- }
- beep
- return ""
- }
-
- # Prompt in popup for attribute value, offering choices if any
- proc htmlAttrChoicePrompt {elem attr} {
- global HTMLmodeVars htmlElemAttrChoices
-
- set choices {}
- set matches {}
- catch {set choices [concat choices $htmlElemAttrChoices($elem)]}
- # see if there are choices
- foreach w $choices {
- if {[string match [string toupper "${attr}*"] $w]} {
- lappend matches [string range $w [string length $attr] end]
- }
- }
- set v ""
- if {[llength $matches]} {
- # if any, offer choices in a listpick
- if {[catch {listpick -p ${elem}:${attr}? $matches} v]} {
- return ""
- }
- } else {
- # else prompt for value
- if {[catch {prompt ${elem}:$attr "" } v]} {
- return ""
- }
- }
- set v [string trim $v]
- return $v
- }
-
- # If answer needs quotes, put them on
- proc htmlCheckQuotes {attr v} {
- global HTMLmodeVars
- set quotedAttrs $HTMLmodeVars(quotedAttrs)
-
- if {[string range $v 0 0] == "\""} {return $v}
- if {[lsearch -exact $quotedAttrs $attr] >= 0} {return [append tmp "\"" $v "\""]}
- return $v
- }
-
-
- # Closing tag of an element
- proc htmlCloseElem {theElem} {
- set text ""
- append text "</"
- append text [htmlSetCase $theElem]
- append text ">"
- return $text
- }
-
- # From menu, customize list of attributes which get asked about
- proc htmlUseAttrs {item} {
- global HTMLmodeVars htmlElemAttrAll htmlElemAttrUsed elemAttrsForAll
- global modifiedVars
-
- set attrname $item
- set usedname $item
- if {![info exists htmlElemAttrAll($item)]} {
- # hope it's A HREF/ANCHOR
- if {$item == "A HREF"} {
- set attrname A
- set usedname HREF
- } elseif {$item == "A ANCHOR"} {
- set attrname A
- set usedname ANCHOR
- } else {
- alertnote "Bug! There's an element in the menu which should not be there!"
- return 1
- }
- }
- if {![catch {listpick -l -p "Select the attributes you usually want for $usedname" \
- [concat $htmlElemAttrAll($attrname) $elemAttrsForAll]} newattrs]} {
- set newattrs [eval concat $newattrs]
- set htmlElemAttrUsed($usedname) $newattrs
- addArrDef htmlElemAttrUsed $usedname $newattrs
- # addUserLine "set htmlElemAttrUsed($usedname) \{ $newattrs \}"
- # lappend modifiedVars [append tmp {htmlElemAttrUsed(} $usedname {)}]
- }
- }
-
-
- #===============================================================================
- # Elements
- #===============================================================================
-
- #
- # First the ones with just one tag or which just don't fit elsewhere
- #
-
- proc htmlElemBase {} {
- # carriageReturn
- insertText [htmlOpenElem "BASE"]
- carriageReturn
- }
-
- proc htmlBreak {} {
- insertText [htmlOpenElem "BR"]
- carriageReturn
- }
-
- proc htmlComment {} {
- global htmlCurSel
- global htmlIsSel
- global HTMLmodeVars
- set useTabMarks $HTMLmodeVars(useTabMarks)
- set commentPreString $HTMLmodeVars(prefixString)
- set commentSufString $HTMLmodeVars(suffixString)
-
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- htmlOpenCR
- insertText $commentPreString $htmlCurSel
- set currpos [getPos]
- insertText $commentSufString
- htmlCloseCR
- if {!$htmlIsSel} {
- if {$useTabMarks} {insertText "Ñ"}
- goto $currpos
- }
- }
-
- proc htmlElemHR {} {
- carriageReturn
- insertText [htmlOpenElem "HR"]
- carriageReturn
- message "Horizontal Rule"
- }
-
- # processing instructions
- # proc htmlElemPI {} {
- # insertText "<?>Ñ"
- # backwardChar
- # backwardChar
- # }
-
- #
- # Element build routines
- #
-
- # This is used for almost all containers
- proc htmlBuildElem {ftype {attr ""}} {
- global HTMLmodeVars
- set useTabMarks $HTMLmodeVars(useTabMarks)
- global htmlCurSel
- global htmlIsSel
-
- set text ""
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- append text [htmlOpenElem $ftype $attr]
- append text $htmlCurSel
- set currpos [expr [getPos] + [string length $text]]
- append text [htmlCloseElem $ftype]
- if {!$htmlIsSel && $useTabMarks} {append text "Ñ"}
- insertText $text
- if {!$htmlIsSel} {goto $currpos}
- }
-
- # This is used for elements that should be surrounded by newlines
- proc htmlBuildCRElem {ftype {sel ""}} {
- global htmlCurSel htmlIsSel
- global HTMLmodeVars
- set useTabMarks $HTMLmodeVars(useTabMarks)
-
- set text ""
- htmlGetSel $sel
- if {$htmlIsSel} { deleteSelection }
- htmlOpenCR
- append text [htmlOpenElem $ftype]
- append text $htmlCurSel
- set currpos [expr [getPos] + [string length $text]]
- append text [htmlCloseElem $ftype]
- insertText $text
- carriageReturn
- if {!$htmlIsSel} {
- if {$useTabMarks} {insertText "Ñ"}
- goto $currpos
- }
- }
-
- # This is used for elements that should be surrounded by empty lines
- proc htmlBuildCR2Elem {ftype {sel ""}} {
- global HTMLmodeVars htmlCurSel htmlIsSel
- set useTabMarks $HTMLmodeVars(useTabMarks)
-
- htmlGetSel $sel
- if {$htmlIsSel} { deleteSelection }
- # note elems are currently placed at left margin, ignoring current indent
- htmlOpenCR ; insertText "\n"
- insertText [htmlOpenElem $ftype]
- carriageReturn
- insertText $htmlCurSel
- set currpos [getPos]
- insertText "\n"
- insertText [htmlCloseElem $ftype]
- htmlCloseCR ; carriageReturn
- if {!$htmlIsSel} {
- if {$useTabMarks} {insertText "Ñ"}
- goto $currpos
- }
- }
-
- # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
- # insertion point there. If anything is selected, makes it the first item.
- proc htmlBuildList {ltype} {
- global HTMLmodeVars
- set useTabMarks $HTMLmodeVars(useTabMarks)
- set allContainers $HTMLmodeVars(allContainers)
- global htmlCurSel
- global htmlIsSel
-
- htmlGetSel
- set sel $htmlCurSel
- set IsSel $htmlIsSel
- if {$IsSel} { deleteSelection }
- htmlOpenCR
- carriageReturn
- insertText [htmlOpenElem $ltype]
- carriageReturn
- if {$allContainers} {
- htmlBuildElem "LI"
- } else {
- insertText [htmlOpenElem "LI"]
- }
- if {$IsSel} { # bullet 1 already full
- insertText $sel
- if {$allContainers} {
- if {$useTabMarks} {
- htmlTabNext
- } else {
- goto [expr [getPos] + 5]
- }
- carriageReturn
- htmlBuildElem "LI"
- } else {
- carriageReturn
- insertText [htmlOpenElem "LI"]
- }
- }
- set currpos [getPos]
- if {$allContainers} {
- if {$useTabMarks} {
- set i 6
- } else {
- set i 5
- }
- goto [expr [getPos] + $i]
- }
- carriageReturn
- insertText [htmlCloseElem $ltype]
- carriageReturn
- if {$useTabMarks} {insertText "Ñ"}
- htmlCloseCR
- goto $currpos
- }
-
- # Add list entry. If there is a selection, make it the entry.
- proc htmlElemListEntry {} {
- global htmlCurSel htmlIsSel HTMLmodeVars
- set allContainers $HTMLmodeVars(allContainers)
- htmlGetSel
- htmlOpenCR
- set Sel $htmlCurSel
- if {$allContainers} {
- htmlBuildElem "LI"
- } else {
- insertText [htmlOpenElem "LI"]
- }
- insertText $Sel
- }
-
- # Discursive Lists (term and description elems)
- #
- # The selection becomes the *description* (*not* the term)
-
- # Build a discursive list
- proc htmlBuildDiscList {} {
- global htmlCurSel
- global htmlIsSel
- global HTMLmodeVars
- set allContainers $HTMLmodeVars(allContainers)
- set useTabMarks $HTMLmodeVars(useTabMarks)
- set dlEntries $HTMLmodeVars(dlEntries)
-
- htmlGetSel
- set Sel $htmlCurSel
- if {$htmlIsSel} { deleteSelection }
- htmlOpenCR
- carriageReturn
- insertText [htmlOpenElem "DL"]
- carriageReturn
-
- # The first entry
- if {$allContainers} {
- htmlBuildElem "DT"
- } else {
- insertText [htmlOpenElem "DT"]
- }
- # insertText [htmlOpenElem "DT"]
- set currpos [getPos]
- if {$allContainers} {
- if {$useTabMarks} {
- htmlTabNext
- } else {
- goto [expr [getPos] + 5]
- }
- }
- insertText "\t"
- if {$allContainers} {
- htmlBuildElem "DD"
- } else {
- insertText [htmlOpenElem "DD"]
- }
- # insertText [htmlOpenElem "DD"]
- if {[string length $Sel]} {
- insertText $Sel
- } else {
- if {$useTabMarks} {insertText "Ñ"}
- }
- if {$allContainers} {
- if {$useTabMarks} {
- htmlTabNext
- } else {
- goto [expr [getPos] + 5]
- }
- }
-
- # Now for the rest of the entries
- for {set i 1} {$i < $dlEntries} {incr i} {
- carriageReturn
- if {$allContainers} {
- htmlBuildElem "DT"
- } else {
- insertText [htmlOpenElem "DT"]
- }
- # insertText [htmlOpenElem "DT"]
- if {$useTabMarks} {insertText "Ñ"}
- if {$allContainers} {
- if {$useTabMarks} {
- htmlTabNext
- } else {
- goto [expr [getPos] + 5]
- }
- }
- insertText "\t"
- if {$allContainers} {
- htmlBuildElem "DD"
- } else {
- insertText [htmlOpenElem "DD"]
- }
- # insertText [htmlOpenElem "DD"]
- if {$useTabMarks} {insertText "Ñ"}
- if {$allContainers} {
- if {$useTabMarks} {
- htmlTabNext
- } else {
- goto [expr [getPos] + 5]
- }
- }
- }
- if {$allContainers && $useTabMarks} {insertText "Ñ"}
- carriageReturn
- insertText [htmlCloseElem "DL"]
- carriageReturn
- if {$useTabMarks} {insertText "Ñ"}
- htmlCloseCR
- goto $currpos
- }
-
- # Add an individual entry to a discursive list
- proc htmlElemDiscEntry {} {
- global htmlCurSel htmlIsSel
- global HTMLmodeVars
- set useTabMarks $HTMLmodeVars(useTabMarks)
- set allContainers $HTMLmodeVars(allContainers)
-
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- set Sel $htmlCurSel
- htmlOpenCR
-
- if {$allContainers} {
- htmlBuildElem "DT"
- } else {
- insertText [htmlOpenElem "DT"]
- }
- set currpos [getPos]
- if {$allContainers} {
- if {$useTabMarks} {
- htmlTabNext
- } else {
- goto [expr [getPos] + 5]
- }
- }
- insertText "\t"
- if {$allContainers} {
- htmlBuildElem "DD"
- } else {
- insertText [htmlOpenElem "DD"]
- }
- if {[string length $Sel]} {
- insertText $Sel
- } else {
- if {$useTabMarks} {insertText "Ñ"}
- }
- if {!$allContainers} {htmlCloseCR}
- goto $currpos
- }
-
-
- #
- # Here are all the things that use the Build procs
- #
-
- proc htmlElemParagraph {} {
- global htmlIsSel htmlCurSel HTMLmodeVars
- set allContainers $HTMLmodeVars(allContainers)
-
- set htmlCurSel ""
- htmlGetSel
- # we need to use a local variable to hold the selection since carriageReturn
- # deletes the current selection.
- set sel $htmlCurSel
- if {[string length $sel]} { deleteSelection }
- if ($allContainers) {
- if {![string length $sel]} {
- htmlOpenCR
- carriageReturn
- }
- htmlBuildCRElem "P"
- if {[string length $sel]} {insertText $sel}
- } else {
- if {![string length $sel]} {
- htmlOpenCR
- carriageReturn
- }
- insertText [htmlOpenElem "P"]
- if {[string length $sel]} {insertText $sel}
- }
- }
-
- proc htmlElemAddress {} {
- htmlBuildCRElem "ADDRESS"
- message "Address"
- }
- proc htmlElemBlockquote {} {
- htmlBuildCR2Elem "BLOCKQUOTE"
- message "Blockquote"
- }
- proc htmlElemBold {} {
- htmlBuildElem "B"
- message "Bold"
- }
- proc htmlElemCite {} {
- htmlBuildElem "CITE"
- message "Cite"
- }
- proc htmlElemCode {} {
- htmlBuildElem "CODE"
- message "Code"
- }
- proc htmlElemEmphasized {} {
- htmlBuildElem "EM"
- message "Emphasized"
- }
- proc htmlElemTT {} {
- htmlBuildElem "TT"
- message "Fixed Width"
- }
- proc htmlElemItalic {} {
- htmlBuildElem "I"
- message "Italic"
- }
- proc htmlElemKeyboard {} {
- htmlBuildElem "KBD"
- message "Keyboard"
- }
-
- proc htmlElemSample {} {
- htmlBuildElem "SAMP"
- message "Sample"
- }
- proc htmlElemStrong {} {
- htmlBuildElem "STRONG"
- message "Strong emphasis"
- }
- proc htmlElemVarname {} {
- htmlBuildElem "VAR"
- message "Variable name"
- }
- proc htmlElemPreformatted {} {
- htmlBuildCR2Elem "PRE"
- message "Preformatted"
- }
- proc htmlElemCenter {} {
- htmlBuildCR2Elem "CENTER"
- message "Netscape Enhanced center"
- }
-
- proc htmlElemTitle {} {
- htmlBuildCRElem "TITLE"
- message "External title"
- }
-
-
- proc htmlElemHeader1 {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCRElem H1 $sel
- }
- proc htmlElemHeader2 {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCRElem H2 $sel
- }
- proc htmlElemHeader3 {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCRElem H3 $sel
- }
- proc htmlElemHeader4 {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCRElem H4 $sel
- }
- proc htmlElemHeader5 {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCRElem H5 $sel
- }
- proc htmlElemHeader6 {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCRElem H6 $sel
- }
-
- #
- # These things use BuildList
- #
-
- proc htmlElemBulleted {} {
- htmlBuildList "UL"
- message "Bulleted list"
- }
- proc htmlElemNumbered {} {
- htmlBuildList "OL"
- }
- proc htmlElemMenu {} {
- htmlBuildList "MENU"
- }
- proc htmlElemDirectory {} {
- htmlBuildList "DIR"
- }
-
- # links
- #
- # Href and Anchor are an 'A' with different attribute sets.
-
- proc htmlElemHref {} {
- htmlBuildElem A HREF
- }
-
- # If text is selected it is the object of the href.
- proc htmlElemAnchor {} {
- htmlBuildElem A ANCHOR
- }
-
- # Inline image href
- proc htmlElemImg {} {
- insertText [htmlOpenElem IMG]
- }
-
- # Forms - no template (yet?)
- proc htmlElemForm {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCR2Elem "FORM" $sel
- }
- proc htmlElemSelect {} {
- htmlBuildCRElem SELECT
- }
- proc htmlElemOption {} {
- insertText [htmlOpenElem "OPTION"]
- }
- proc htmlElemInput {} {
- insertText [htmlOpenElem INPUT]
- }
- proc htmlElemTextarea {} {
- htmlBuildCRElem "TEXTAREA"
- }
-
- # Tables
- proc htmlElemTable {} {
- global htmlCurSel htmlIsSel
- set sel ""
- htmlGetSel
- if {$htmlIsSel} {set sel $htmlCurSel}
- carriageReturn
- htmlBuildCR2Elem "TABLE" $sel
- }
- proc htmlElemTR {} {
- htmlBuildCRElem "TR"
- }
- proc htmlElemTD {} {
- htmlBuildElem "TD"
- }
- proc htmlElemTH {} {
- htmlBuildElem "TH"
- }
- proc htmlElemCaption {} {
- htmlBuildCRElem "CAPTION"
- }
-
- #
- # Template for new file: HTML, TITLE, HEAD, BODY
- # We do not put in a DOCTYPE line.
- # Someday %include user-defined elements as well.
- #
- proc htmlNewTemplate {} {
- global htmlCurSel htmlIsSel HTMLmodeVars
- set useTabMarks $HTMLmodeVars(useTabMarks)
-
- htmlGetSel
- set htmlTTIsSel $htmlIsSel
- if {$htmlTTIsSel} {
- set htmlTTCurSel $htmlCurSel
- deleteSelection
- }
- insertText [htmlOpenElem "HTML"]
- htmlBuildCRElem "HEAD"
- htmlBuildCRElem "TITLE"
- if {$htmlTTIsSel} {
- insertText $htmlTTCurSel
- } else {
- createTMark htmlTTMark [getPos]
- }
- htmlTabNext; htmlTabNext
- htmlBuildCRElem "BODY"
- if {!$htmlTTIsSel} {
- if {$useTabMarks} {insertText "\nÑ\n"}
- } else {
- insertText "\n"
- createTMark htmlTTMark [getPos]
- insertText "\n"
- }
- htmlTabNext
- insertText [htmlCloseElem "HTML"]
- gotoTMark htmlTTMark
- removeTMark htmlTTMark
- message "Consider a DOCTYPE line for HTML version identification."
- }
-
-
- #===============================================================================
- # HTML character entities
- #===============================================================================
-
- proc htmlAddCommonChars {} {
- global modifiedModeVars HTMLmodeVars htmlAllChars
- set commonChars $HTMLmodeVars(commonChars)
-
- if {![catch {listpick -l -p "Select chars for the commonly used char list" \
- $htmlAllChars} newchars]} {
- # set newchars [eval concat $newchars]
- set dirty 0
- foreach c $newchars {
- if {[lsearch -exact $commonChars $c] < 0} {
- set dirty 1
- set commonChars [lsort [lappend commonChars $c]]
- }
- }
- if {$dirty} {
- lappend modifiedModeVars {commonChars HTMLmodeVars}
- set HTMLmodeVars(commonChars) $commonChars
- htmlBuildMenu
- }
- }
- }
-
- proc htmlClearCommonChars {} {
- global htmlAllChars modifiedModeVars HTMLmodeVars
-
- set HTMLmodeVars(commonChars) $HTMLmodeVars(defaultCommonChars)
- lappend modifiedModeVars {commonChars HTMLmodeVars}
- htmlBuildMenu
- message "Common character list reverted to default"
- }
-
- # less than
- proc htmlLt {} {
- global htmlIsSel
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- insertText "<\;"
- }
- # greater than
- proc htmlGt {} {
- global htmlIsSel
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- insertText ">\;"
- }
- # ampersand
- proc htmlAmp {} {
- global htmlIsSel
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- insertText "&\;"
- }
-
-
-
- #===============================================================================
- # Menu Processing
- #===============================================================================
-
- proc htmlMenuItem {menu item} {
- global htmlIsSel htmlMenu
-
- switch -glob $menu {
- "Ñ*" {
- switch $item {
- "Select Container" {htmlBalance}
- "Untag" {htmlUnTag}
- "Remove marks" {htmlTabDeleteAll}
- "New doc template" {htmlNewTemplate}
- }
- }
- "Headers" {
- switch $item {
- "Header1" {htmlElemHeader1}
- "Header2" {htmlElemHeader2}
- "Header3" {htmlElemHeader3}
- "Header4" {htmlElemHeader4}
- "Header5" {htmlElemHeader5}
- "Header6" {htmlElemHeader6}
- }
- }
- "Text Blocks" {
- switch $item {
- "paragraph" {htmlElemParagraph}
- "comment" {htmlComment}
- "address" {htmlElemAddress}
- "block quote" {htmlElemBlockquote}
- "preformatted" {htmlElemPreformatted}
- "center" {htmlElemCenter}
- }
- }
- "Styles" {
- switch $item {
- "emphasis" {htmlElemEmphasized}
- "strong" {htmlElemStrong}
- "bold" {htmlElemBold}
- "italic" {htmlElemItalic}
- "code" {htmlElemCode}
- "variable" {htmlElemVarname}
- "citation" {htmlElemCite}
- "keyboard" {htmlElemKeyboard}
- "typewriter" {htmlElemTT}
- "sample" {htmlElemSample}
- }
- }
- "Links" {
- switch $item {
- "href" {htmlElemHref}
- "anchor" {htmlElemAnchor}
- "image" {htmlElemImg}
- }
- }
- "Lists" {
- switch $item {
- "bulleted" {htmlElemBulleted}
- "numbered" {htmlElemNumbered}
- "directory" {htmlElemDirectory}
- "menu" {htmlElemMenu}
- "new list entry" {htmlElemListEntry}
- "discursive" {htmlBuildDiscList}
- "new discursive entry" {htmlElemDiscEntry}
- }
- }
- "Forms" {
- switch $item {
- form {htmlElemForm}
- select {htmlElemSelect}
- option {htmlElemOption}
- input {htmlElemInput}
- textarea {htmlElemTextarea}
- }
- }
- "Tables" {
- switch $item {
- table {htmlElemTable}
- tr {htmlElemTR}
- td {htmlElemTD}
- th {htmlElemTH}
- caption {htmlElemCaption}
- }
- }
- "Character Entities" {
- switch $item {
- "Add" {htmlAddCommonChars}
- "Clear" {htmlClearCommonChars}
- "less than" {htmlLt}
- "greater than" {htmlGt}
- "ampersand" {htmlAmp}
- default {
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- # set item [string trim $item]
- insertText &${item}\;
- }
- }
- }
- "all chars" {
- switch $item {
- default {
- htmlGetSel
- if {$htmlIsSel} { deleteSelection }
- # set item [string trim $item]
- insertText &${item}\;
- }
- }
- }
- "Other Elements" {
- switch $item {
- "line break" {htmlBreak}
- "horizontal rule" {htmlElemHR}
- "comment line" {htmlDividingLine}
- # "processing instructions" {htmlElemPI}
- "base" {htmlElemBase}
- "isindex" {insertText [htmlOpenElem "ISINDEX"]}
- "link" {htmlBuildCRElem "LINK"}
- "meta" {insertText [htmlOpenElem "META"]}
- "nextid" {insertText [htmlOpenElem "NEXTID"]}
- "title" {htmlElemTitle}
- }
- }
- "Custom" {
- catch {htmlElem${item}}
- }
- "URLs" {
- switch $item {
- "Add selection" {htmlSelToURL}
- "Add clipboard" {htmlScrapToURL}
- "Clean up" {htmlCleanUpURLs}
- }
- }
- "Use Attributes" {
- htmlUseAttrs $item
- }
- "HTML Helpers" {
- switch $item {
- "Send file to browser" {htmlSendWindow}
- "Weblint" {htmlNotYet}
- }
- }
- }
- }
-
- #
- # The menu.
- #
- # This is built up with lappends because I want parts of it to be
- # dynamic, to depend on which elements have attributes defined on
- # them and whether using ctl-cmd.
- #
- # After Pete's bug fixes, put icons in menus dynamically.
- # ctrl is B, opt is I, cmd is O, shift is U, dynamic is S
- #
- proc htmlBuildMenu {} {
- global htmlCustomMenuList htmlElemAttrAll
- global htmlMenu HTMLmodeVars htmlAllChars
- set commonChars $HTMLmodeVars(commonChars)
- set Mstr $HTMLmodeVars(htmlMenuPrefix)
- set SMstr $HTMLmodeVars(htmlSMenuPrefix)
-
- # start empty
- set htmlMenuList {}
-
- # Header1, Header2...
- set htmlHeadersMenu [list menu -M HTML -p htmlMenuItem -m -n Headers \
- [list ${Mstr}/1Header1 ${Mstr}/2Header2 ${Mstr}/3Header3 ${Mstr}/4Header4 \
- ${Mstr}/5Header5 ${Mstr}/6Header6]]
- lappend htmlMenuList $htmlHeadersMenu
-
-
- # Blocks
- set htmlBlocksMenu [list menu -M HTML -p htmlMenuItem -m -n "Text Blocks" \
- [list "${Mstr}/aparagraph" "${Mstr}/;comment" \
- ${Mstr}/Aaddress "${Mstr}/Qblock quote" \
- ${Mstr}/Ppreformatted center]]
- lappend htmlMenuList $htmlBlocksMenu
-
-
- # Styles
- set htmlStylesMenu [list menu -M HTML -p htmlMenuItem -m -n Styles \
- [list ${Mstr}/Eemphasis ${Mstr}/Sstrong ${Mstr}/Bbold ${Mstr}/Iitalic \
- ${Mstr}/Ccode ${Mstr}/Vvariable ${SMstr}/Ccitation ${Mstr}/Kkeyboard \
- ${Mstr}/Ftypewriter sample]]
- lappend htmlMenuList $htmlStylesMenu
-
-
- # Links
- set htmlLinksMenu [list menu -M HTML -p htmlMenuItem -m -n Links \
- [list ${Mstr}/>href ${Mstr}/<anchor ${Mstr}/\/image]]
- lappend htmlMenuList $htmlLinksMenu
-
-
- # Lists
- set htmlListsMenu [list menu -M HTML -p htmlMenuItem -m -n Lists \
- [list ${Mstr}/Ubulleted ${Mstr}/Onumbered ${Mstr}/Ddirectory \
- ${Mstr}/Mmenu "${Mstr}/Nnew list entry" "(-" \
- ${Mstr}/Gdiscursive "${SMstr}/Nnew discursive entry"]]
- lappend htmlMenuList $htmlListsMenu
-
-
- # Forms
- set htmlFormsMenu [list menu -M HTML -p htmlMenuItem -m -n Forms \
- [list ${SMstr}/Fform ${SMstr}/Sselect ${SMstr}/Ooption \
- ${SMstr}/Iinput ${SMstr}/Ttextarea]]
- lappend htmlMenuList $htmlFormsMenu
-
-
- # Tables
- set htmlTablesMenu [list menu -M HTML -p htmlMenuItem -m -n Tables \
- [list table tr td th caption]]
- lappend htmlMenuList $htmlTablesMenu
-
-
- # Character Entities
- set htmlAllChars {
- "aacute"
- "acirc"
- "acircumflex"
- "adieresis"
- "ae"
- "aelig"
- "agrave"
- "amp"
- "apple"
- "approxequal"
- "aring"
- "atilde"
- "auml"
- "breve"
- "bullet"
- "caron"
- "ccedil"
- "ccedilla"
- "cedilla"
- "cent"
- "circumflex"
- "copy"
- "copyright"
- "currency"
- "dagger"
- "daggerdbl"
- "degree"
- "dieresis"
- "divide"
- "dotaccent"
- "dotlessi"
- "eacute"
- "ecirc"
- "ecircumflex"
- "edieresis"
- "egrave"
- "ellipsis"
- "emdash"
- "emsp"
- "endash"
- "ensp"
- "eth"
- "euml"
- "exclamdown"
- "fi"
- "fl"
- "florin"
- "fraction"
- "germandbls"
- "greaterequal"
- "gt"
- "guillemotleft"
- "guillemotright"
- "guilsinglleft"
- "guilsinglright"
- "hellip"
- "hungarumlaut"
- "iacute"
- "icirc"
- "icircumflex"
- "idieresis"
- "igrave"
- "infinity"
- "integral"
- "iuml"
- "lessequal"
- "logicalnot"
- "lozenge"
- "lre"
- "lrm"
- "lro"
- "lt"
- "macron"
- "mdash"
- "mu"
- "nbsp"
- "ndash"
- "nobrkspace"
- "notequal"
- "ntilde"
- "oacute"
- "ocirc"
- "ocircumflex"
- "odieresis"
- "oe"
- "ogonek"
- "ograve"
- "ordfeminine"
- "ordmasculine"
- "oslash"
- "otilde"
- "ouml"
- "paragraph"
- "partialdiff"
- "pdf"
- "periodcentered"
- "perthousand"
- "pi"
- "plusminus"
- "questiondown"
- "quot"
- "quotedblbase"
- "quotedblleft"
- "quotedblright"
- "quoteleft"
- "quoteright"
- "quotesinglbase"
- "radical"
- "registered"
- "ring"
- "rlm"
- "rlo"
- "section"
- "shy"
- "sterling"
- "szlig"
- "thorn"
- "tilde"
- "trademark"
- "uacute"
- "ucirc"
- "ucircumflex"
- "udieresis"
- "ugrave"
- "uuml"
- "vellip"
- "yacute"
- "ydieresis"
- "yen"
- "yuml"
- "zwj"
- "zwnj"
- "(-"
- "Aacute"
- "Acirc"
- "Acircumflex"
- "Adieresis"
- "AE"
- "AElig"
- "Agrave"
- "Aring"
- "Atilde"
- "Auml"
- "Ccedil"
- "Ccedilla"
- "Delta"
- "Eacute"
- "Ecirc"
- "Ecircumflex"
- "Edieresis"
- "Egrave"
- "Eth"
- "Euml"
- "Iacute"
- "Icirc"
- "Icircumflex"
- "Idieresis"
- "Igrave"
- "Iuml"
- "Ntilde"
- "OE"
- "Oacute"
- "Ocirc"
- "Ocircumflex"
- "Odieresis"
- "Ograve"
- "Omega"
- "Oslash"
- "Otilde"
- "Ouml"
- "Pi"
- "Sigma"
- "Thorn"
- "Uacute"
- "Ucirc"
- "Ucircumflex"
- "Udieresis"
- "Ugrave"
- "Uuml"
- "Yacute"
- "Ydieresis"
- "Ygrave"
- }
- set htmlAllCharsMenu [list menu -M HTML -p htmlMenuItem -m -n "all chars" $htmlAllChars ]
- set tmp $commonChars
- lappend tmp "(-" Add Clear $htmlAllCharsMenu
- set htmlCharsMenu [list menu -M HTML -p htmlMenuItem -m -n "Character Entities" $tmp]
- lappend htmlMenuList $htmlCharsMenu
-
-
- # Other stuff, miscellaneous
- set htmlOtherMenu [list menu -M HTML -p htmlMenuItem -m -n "Other Elements" \
- [list "${Mstr}/!line break" "horizontal rule" "comment line" \
- "(-" base isindex link meta nextid title]]
- lappend htmlMenuList $htmlOtherMenu
-
-
- # Allow user to insert custom menu items
- if {![info exists htmlCustomMenuList]} { set htmlCustomMenuList {} }
- set htmlCustomMenu [list menu -M HTML -p htmlMenuItem -m -n "Custom" $htmlCustomMenuList]
- lappend htmlMenuList $htmlCustomMenu
-
- # Other top-level
- lappend htmlMenuList "(-" "/BSelect Container" ${SMstr}/UUntag "<O/cRemove marks" "${Mstr}/0New doc template"
-
- # URLs
- set htmlURLsMenu [list menu -M HTML -p htmlMenuItem -m -n "URLs" [list "Add selection" \
- "Add clipboard" "Clean up"]]
- lappend htmlMenuList $htmlURLsMenu
-
- # Use Attributes
- # Dynamically-built list of elements whose default attributes can be selected
- foreach a [array names htmlElemAttrAll] {
- if {[llength $htmlElemAttrAll($a)]} {lappend htmlPossibleToUse $a}
- }
- lappend htmlPossibleToUse "A HREF" "A ANCHOR"
- set htmlUseAttrsMenu [list menu -M HTML -p htmlMenuItem -m -n "Use Attributes" \
- [lsort $htmlPossibleToUse]]
- lappend htmlMenuList $htmlUseAttrsMenu
-
- # Helpers
- set htmlHelpersMenu [list menu -M HTML -p htmlMenuItem -m -n "HTML Helpers" {"<O<U/SSend file to browser" "Weblint"}]
- lappend htmlMenuList $htmlHelpersMenu
-
- # Put it all together
- menu -M HTML -m -p htmlMenuItem -n $htmlMenu $htmlMenuList
- insertMenu $htmlMenu
- }
-
- #===============================================================================
- # Key Bindings and Menu Definitions
- #
- # We make menu definition dynamic so that the little icons can change someday.
- #===============================================================================
-
- proc htmlBindKeys {} {
- global HTMLmodeVars htmlElemAttrAll
- global htmlMenu htmlCustomMenuList
- set htmlBStr $HTMLmodeVars(htmlBindPrefix)
- set htmlSBStr $HTMLmodeVars(htmlSBindPrefix)
-
- # # key bindings and menu entries look different if usectlcmd.
- # catch {set useCtlCmd $HTMLmodeVars(useCtlCmd)}
- # if {![info exists useCtlCmd]} {set useCtlCmd 0}
- # if ($useCtlCmd) {
- # set htmlBStr "zc"
- # set htmlSBStr "szc"
- # set htmlMStr "B"
- # } else {
- # set htmlBStr "oz"
- # set htmlSBStr "soz"
- # set htmlMStr "O"
- # }
- set htmlBStr "oz"
- set htmlSBStr "soz"
- set htmlMStr "O"
-
- catch {deleteModeBindings HTML}
-
- # tabs to tabmarks (Ñ)
- bind '\t' htmlTabNext HTML
- bind '\t' <s> htmlTabPrev HTML
- bind '\t' <c> htmlTabDeleteAll HTML
- # balance & untag
- bind 'b' <c> htmlBalance HTML
- bind 'u' <$htmlSBStr> htmlUnTag HTML
-
- #cmd-opt keys, in the same order as the menu
-
- #
- # new file template and headers
- #
- # a '0' sort of comes before any heading
- bind '0' <$htmlBStr> htmlNewTemplate HTML
- bind '1' <$htmlBStr> htmlElemHeader1 HTML
- bind '2' <$htmlBStr> htmlElemHeader2 HTML
- bind '3' <$htmlBStr> htmlElemHeader3 HTML
- bind '4' <$htmlBStr> htmlElemHeader4 HTML
- bind '5' <$htmlBStr> htmlElemHeader5 HTML
- bind '6' <$htmlBStr> htmlElemHeader6 HTML
-
- #
- # Text Blocks
- #
- # paragraph: Enter
- bind Enter htmlElemParagraph HTML
- bind '\r' <$htmlBStr> htmlElemParagraph HTML
- # for PowerBook 100
- bind 0x34 htmlElemParagraph HTML
- # Also on ctrl-M for those with awkward Enter keys
- bind 'm' <z> htmlElemParagraph HTML
-
- # Comment on semicolon
- bind 0x29 <$htmlBStr> htmlComment HTML
-
- bind 'a' <$htmlBStr> htmlElemAddress HTML
- bind 'q' <$htmlBStr> htmlElemBlockquote HTML
- bind 'p' <$htmlBStr> htmlElemPreformatted HTML
- # CENTER doesn't have a binding, since it will most likely go away
-
- #
- # Styles
- #
- bind 'e' <$htmlBStr> htmlElemEmphasized HTML
- bind 's' <$htmlBStr> htmlElemStrong HTML
- bind 'b' <$htmlBStr> htmlElemBold HTML
- bind 'c' <$htmlBStr> htmlElemCode HTML
- bind 'v' <$htmlBStr> htmlElemVarname HTML
- bind 'c' <$htmlSBStr> htmlElemCite HTML
- bind 'k' <$htmlBStr> htmlElemKeyboard HTML
- bind 'i' <$htmlBStr> htmlElemItalic HTML
- bind 'f' <$htmlBStr> htmlElemTT HTML
-
- #
- # Links
- #
- # A "<" is something pointed at. ">" points to it.
- bind '.' <$htmlBStr> htmlElemHref HTML
- bind ',' <$htmlBStr> htmlElemAnchor HTML
- # An image, right near the usual href
- bind '/' <$htmlBStr> htmlElemImg HTML
-
- #
- # Lists
- #
- bind 'u' <$htmlBStr> htmlElemBulleted HTML
- bind 'o' <$htmlBStr> htmlElemNumbered HTML
- bind 'd' <$htmlBStr> htmlElemDirectory HTML
- bind 'm' <$htmlBStr> htmlElemMenu HTML
- # n is for 'eNtry'
- bind 'n' <$htmlBStr> htmlElemListEntry HTML
- bind 'g' <$htmlBStr> htmlBuildDiscList HTML
- # A discursive list entry is N with the shift key
- bind 'n' <$htmlSBStr> htmlElemDiscEntry HTML
-
- #
- # Forms
- #
- bind 'f' <$htmlSBStr> htmlElemForm HTML
- bind 's' <$htmlSBStr> htmlElemSelect HTML
- bind 'o' <$htmlSBStr> htmlElemOption HTML
- bind 'i' <$htmlSBStr> htmlElemInput HTML
- bind 't' <$htmlSBStr> htmlElemTextarea HTML
-
- #
- # Other Elements
- #
- # break is '!', shift-cmd-opt-1
- bind '!' <$htmlBStr> htmlBreak HTML
- # comment line is ctrl-C L
- bind 'l' <C> htmlDividingLine HTML
-
- #
- # Character entities
- #
- # Only <, > and & are bound, to shift-cmd-opt-<char>
- bind '<' <$htmlBStr> htmlLt HTML
- bind '>' <$htmlBStr> htmlGt HTML
- bind '&' <$htmlBStr> htmlAmp HTML
-
- #
- # Helpers
- #
- bind right <$htmlBStr> htmlSendWindow HTML
-
-
- }
-
- htmlBindKeys
- htmlBuildMenu
-
- #===============================================================================
- # General Commands
- #===============================================================================
-
- # remove containing tags
- proc htmlUnTag {} {
- set curPos [getPos]
- set tags [htmlGetContainer $curPos [selEnd]]
- if {[llength $tags] < 4} {
- alertnote "Cannot decide on enclosing tags"
- return
- }
- # delete them back to front
- createTMark htmlUnTagMark $curPos
- deleteText [lindex $tags 2] [lindex $tags 3]
- deleteText [lindex $tags 0] [lindex $tags 1]
- gotoTMark htmlUnTagMark
- removeTMark htmlUnTagMark
- }
-
- # select container, like Balance (cmd-B)
- proc htmlBalance {} {
- # if </, stay there. If <?, back up one if possible
- # watch out for end of file, beginning of file
- set begin [getPos]
- set end [selEnd]
-
- set start $begin
- if {$start != 0 &&
- ![catch {getText $start [expr $start + 2]} lookingAt] &&
- $lookingAt != "</" &&
- [string range $lookingAt 0 0] == "<"} {
- set start [expr [getPos] - 1]
- }
- set tags [htmlGetContainer $start $end]
- if {[llength $tags] == 4} {
- select [lindex $tags 0] [lindex $tags 3]
- } else {
- beep
- select $begin $end
- }
- }
-
- #
- # launch a viewer and pass this window to it
- #
- proc htmlSendWindow {} {
- global htmlBrowserPath HTMLmodeVars
- if {![info exists htmlBrowserPath]} {
- if {[catch {addAppPath "HTML Browser" htmlBrowserPath}]} {
- alertnote "You must choose a browser"
- return
- }
- }
- set sig [getFileSig $htmlBrowserPath]
-
- set name [checkRunning "HTML Browser" $sig htmlBrowserPath]
- if {![string length $name]} {
- alertnote "Couldn't run browser"
- return
- }
-
- if {[winDirty]} {
- case [askyesno -c "Save '[lindex [winNames] 0]'?"] in {
- "yes" {save}
- "no" {}
- "cancel" {return}
- }
- }
- sendOpenEvent -n $name [lindex [winNames -f] 0]
- if {$HTMLmodeVars(browseInForeground)} { switchTo $name }
- }
-
-
- proc htmlCleanUpURLs {} {
- global HTMLmodeVars
- global modifiedModeVars
- set URLs $HTMLmodeVars(URLs)
-
- if {![llength $URLs]} {
- alertnote "No URLs are cached"
- return 1
- }
- if {![catch {listpick -l -p "Select the URLs to save" $URLs} newURLs]} {
- set URLs [eval concat $newURLs]
- set HTMLmodeVars(URLs) $URLs
- lappend modifiedModeVars {URLs HTMLmodeVars}
- }
- }
-
- proc htmlSelToURL {} {
- global HTMLmodeVars modifiedModeVars
- set URLs $HTMLmodeVars(URLs)
-
- set URLs [lsort [lappend URLs [getSelect]]]
- set HTMLmodeVars(URLs) $URLs
- lappend modifiedModeVars {URLs HTMLmodeVars}
- message [append tmp [getSelect] " added to URLs"]
- }
-
- proc htmlScrapToURL {} {
- global HTMLmodeVars modifiedModeVars
- set URLs $HTMLmodeVars(URLs)
-
- set URLs [lsort [lappend URLs [getScrap]]]
- set HTMLmodeVars(URLs) $URLs
- lappend modifiedModeVars {URLs HTMLmodeVars}
- message [append tmp [getScrap] " added to URLs"]
- }
-
- # called by Alpha to load HTML in. Use to force template in new empty window.
- proc htmlDummy {} {
- # if {![maxPos]} {
- # htmlNewTemplate
- # }
- }
-