/* --- Copyright University of Sussex 2001. All rights reserved. ----------
 > File:            $poplocal/local/auto/ved_html.p
 > Purpose:         Assist in editing HTML documents
 > Author:          David S Young, Sep  2 1997 (see revisions)
 > Documentation:   HELP * VED_HTML
 */

/*

         CONTENTS - (Use <ENTER> g to access required sections)

  1   Global variables and constants
      1.1   Tag end markers
      1.2   User-accessible variables and constants
      1.3   Private global variables
      1.4   Macros

  2   Tag properties
      2.1   Working out permitted abbreviations for tags
      2.2   Setting up the tag data structures
      2.3   Tag utilities
      2.4   Switching on and off P closers

  3   Ved utilities
      3.1   General utilities
      3.2   Ved search utilities

  4   Tag location

  5   URL recognition

  6   Text Scope
      6.1   Initial scope definition procedures
      6.2   Scope adjustment to allow for existing elements

  7   Tag insertion
      7.1   Tag highlighting
      7.2   Main insertion procedure
      7.3   Keyboard insertion

  8   Tag deletion

  9   Splicing deleted text

 10   Preprocessing routines
      10.1  Character attributes
      10.2  Special characters such as < and &
      10.3  Indexes
      10.4  REF/HELP/TEACH file headers
      10.5  Lists
      10.6  Paragraph separation
      10.7  Wrappers
      10.8  Graphics characters and special spaces
      10.9  Overall preprocessing

 11   Entry points
      11.1  Keyboard string interface
      11.2  Command line interface

 12   Customisation

 13   Set up the tag list

*/

compile_mode:pop11 +strict;

section;

vedputmessage('Compiling ved_html - please wait');

/*

-----------------------------------------------------------------------
1  Global variables and constants
-----------------------------------------------------------------------

1.1  Tag end markers
--------------------
*/

/* Make the tag end markers active so that a list of them can be
maintained, and right markers that are the same are also identical */

lvars
    htmlopenleft, htmlopenright, htmlcloseleft, htmlcloseright,
    htmlmarklist;

define lconstant setupmarklist;
    [% htmlopenleft, htmlopenright, htmlcloseleft,
        if htmlcloseright = htmlopenright then
            htmlopenright -> htmlcloseright     ;;; ensure identical
        else
            htmlcloseright                      ;;; different so in list
        endif %] -> htmlmarklist
enddefine;

define active vedhtmlopenleft; htmlopenleft enddefine;
define active vedhtmlopenright; htmlopenright enddefine;
define active vedhtmlcloseleft; htmlcloseleft enddefine;
define active vedhtmlcloseright; htmlcloseright enddefine;

define updaterof active vedhtmlopenleft with_nargs 1;
        -> htmlopenleft;
    setupmarklist()
enddefine;

define updaterof active vedhtmlopenright with_nargs 1;
        -> htmlopenright;
    setupmarklist()
enddefine;

define updaterof active vedhtmlcloseleft with_nargs 1;
        -> htmlcloseleft;
    setupmarklist()
enddefine;

define updaterof active vedhtmlcloseright with_nargs 1;
        -> htmlcloseright;
    setupmarklist()
enddefine;

'<' -> vedhtmlopenleft;
'>' -> vedhtmlopenright;
'</' -> vedhtmlcloseleft;
'>' -> vedhtmlcloseright;

;;; vedhtmlpunctchars is a string of characters to be treated as
;;; punctuation when inside ved_html - see vedhtmlchartype. Needs
;;; to be updated manually if the markers are changed.

vars vedhtmlpunctchars = '<>';

/*

1.2  User-accessible variables and constants
--------------------------------------------
*/

global vars
    vedhtmltagchars = '.-!',
    vedhtmltagtermin = [`.` `\s` `\r`],
    vedhtmlscopeattr = `\[7]`,
    vedhtmltagattr =`\[2b]`,

    vedhtmluppercase = true,

    vedhtmlcursormark = '^',
    vedhtmlurlmark = '*',

    vedhtmlurlstarts = ['http:' 'https:' 'file:' 'ftp:' 'mailto:'
        'news:' 'nntp:' 'wais:' 'gopher:' 'telnet:'
        'cid:' 'mid:' 'afs:' 'prospero:' 'x-exec:'],
    vedhtmlurlchars = '/.:@?#&',

    vedhtmlglobalreplace = ['/&/&amp;' '/>/&gt;' '/</&lt;' '/"/&quot;'],

    vedhtmlmainhead = "H1",
    vedhtmlauthors = "H2",
    vedhtmlmainheadsep = "HR",
    vedhtmlheaders = {H2 H3 H4},
    vedhtmlindextype = "UL",
    vedhtmlindexentry = "LI",
    vedhtmlindexmarks = {'' ' . . ' ' . . . . '},
    vedhtmlembeddedindextag = "P",
    vedhtmlcontents = 'Contents',
    vedhtmljumptoindex = 'Select headings to return to index',

    vedhtmllistentry = "LI",
    vedhtmlsymlist = "UL",
    vedhtmlnumlist = "OL",

    vedhtmlnormpara = "P",
    vedhtmlindentpara = "BLOCKQUOTE",
    vedhtmlraggedpara = "PRE",
    vedhtmlformatpara = "PRE",
    vedhtmlpromptpara = "PRE",
    vedhtml1linepara = "BLOCKQUOTE",

    procedure (
        vedhtmlchartype,
        vedhtmlinparagraph,
        vedhtmlparatype),

    vedhtmltagfile = '$poplib/ved_html_tags.p';

global constant
    vedhtmlattribtags = newproperty([[b 'B'] [i 'I'] [u 'U']],
    3, false, "perm"),

    vedhtmldump = {% false, false, false, false, false, false %},

    active (
        vedhtmltags,            ;;; list of tags. Updater sets up property

        vedhtmlkeys,          ;;; keyboard string for html operations

        vedhtmlPclosers);       ;;; whether P tags have closers

/*

1.3  Private global variables
-----------------------------
*/

lvars
    vedhtmlhighlight = false,       ;;; Controls tag highlighting

    vedchartype_orig = vedchartype; ;;; Needed by vedhtmlchartype

/*

1.4  Macros
-----------
*/

;;; Handy for saving ved's cursor position variables

lconstant macro VED_DLOCAL_POS =
    [ dlocal vedline, vvedlinesize, vedcolumn; ];

/*

-----------------------------------------------------------------------
2  Tag properties
-----------------------------------------------------------------------

2.1  Working out permitted abbreviations for tags
-------------------------------------------------
*/

define lconstant disambig(words, termchars) /* -> disamb */;
    ;;; Takes a list of words or strings.
    ;;; Returns a procedure which takes as its argument a character
    ;;; repeater. The procedure reads characters until it has enough
    ;;; to unambiguously identify one of the words or strings in the list,
    ;;; then returns that word or string. If the first character read is not
    ;;; the first character of a word in the list, returns false. If a word
    ;;; is an initial subword of another word, then any character in
    ;;; termchars can be used to terminate it.

    define lconstant disambtable(wordlist, i) -> prop;
        lvars wordlist, i, prop
            = newanyproperty([], 4, 1, 4, false, false, "perm", false, false);

        ;;; To be called with a list of words that are identical for all
        ;;; characters before position i. Returns a property tree.

        ;;; Collect together words with same character at position i.
        lvars w, c, wds, lw;
        for w in wordlist do
            if i > (length(w) ->> lw) then
                if i > lw + 1 then
                    mishap(w, 1, 'Same word occurs twice')
                else
                    termin -> c
                endif
            else
                w(i) -> c
            endif;
            if prop(c) ->> wds then
                if wds.ispair then
                    conspair(w, wds) -> prop(c)
                else
                    conspair(w, conspair(wds, [])) -> prop(c)
                endif
            else
                w -> prop(c)
            endif
        endfor;

        ;;; Make characters from termchars work as terminators.
        if prop(termin) ->> w then
            for c in termchars do
                if prop(c) then
                    mishap(c, 1, 'Terminator occurs inside tag name')
                else
                    w -> prop(c)
                endif
            endfor
        endif;

        ;;; Build new tree for words identical before i+1
        for c, wds in_property prop do
            if wds.ispair then
                disambtable(wds, i+1) -> prop(c)
            endif
        endfor
    enddefine;

    define lconstant procedure disamb(rep, p) -> result;
        lvars procedure rep, p, result = p(rep());
        while result.isproperty do
            result(rep()) -> result
        endwhile
    enddefine;

    disamb(% disambtable(words, 1) %)

enddefine;

define lconstant disambig_abbrevs(words) /* -> abbrs */;
    ;;; Returns a list of the abbreviations disambig will use, as strings.
    ;;; Relies on fact that disambiguating procedure does not use
    ;;; stack to remember anything between calls.
    lconstant termins = [^(consref(termin))];
    lvars w, d = disambig(words, termins);
    [%
        for w in words do
            consstring( #|
                    d(stringin(w) <> dup) -> ;
                    if dup() == termin then erase(); `.` endif
                |#)
        endfor
    %]
enddefine;

/*

2.2  Setting up the tag data structures
---------------------------------------
*/

lconstant                  ;;; tag properties (set up later)
    tagprop = newanyproperty([], 4, 1, 4, false, false, "perm", false, false);

defclass lconstant
    tagrec {tag_name, tag_quals, tag_attribs, tag_cursor, tag_url};

lvars
    procedure tagabbrevs,       ;;; abbreviation recogniser
    taglist,                    ;;; raw form of tag list - see format below
    tagnamelist;                ;;; full names of tags

define lconstant removesubstr(str, substr) -> (str, pos);
    ;;; If substr is a substring of str, returns a string
    ;;; with substr deleted and the number of characters between
    ;;; the position of substr and the end of str.
    str and issubstring(substr, str) -> pos;
    if pos then
        lvars i, ls = length(str), lm = length(substr);
        for i from 1 to pos-1 do str(i) endfor;
        for i from pos+lm to ls do str(i) endfor;
        consstring(ls - lm) -> str;
        ls - pos - lm + 1 -> pos;       ;;; from end
    endif
enddefine;

define lconstant attribmarks(str) -> (str, curpos, urlpos);
    ;;; Returns a new string with vedhtmlcursormark and
    ;;; vedhtmlurlmark removed, and the number of characters
    ;;; the marks and the end of the output str.
    removesubstr(str, vedhtmlcursormark) -> (str, curpos);
    removesubstr(str, vedhtmlurlmark) -> (str, urlpos);
    if curpos and urlpos and urlpos < curpos then
        curpos - length(vedhtmlurlmark) -> curpos
    endif
enddefine;

define lconstant fixtagvec(v) -> (name, tagrec);
    ;;; Convert vector tag representation as in list below to record,
    ;;; separating out cursor and url position in attributes.

    unless length(v) == 3 then
        mishap(v, 1, 'Wrong length for tag property vector')
    endunless;
    lvars (name, quals, attrib) = explode(v);
    unless name.isword then
        mishap(name, 1, 'Expecting word in tag description')
    endunless;
    unless quals.islist then
    mishap(quals, 1, 'Expecting list in tag description')
    endunless;
    not(attrib == "N") and attrib -> attrib;
    unless attrib.isstring or not(attrib) then
        mishap(attrib, 1, 'Expecting string or N in tag description')
    endunless;

    constagrec(name, quals, attribmarks(attrib)) -> tagrec
enddefine;

define active vedhtmltags;
    ;;; Active variable returning taglist, and on updating
    ;;; updating tagnamelist, tagprop and tagabbrevs.
    taglist
enddefine;

define updaterof active vedhtmltags(l);
    l -> taglist;
    clearproperty(tagprop);
    [] -> tagnamelist;
    lvars v, w;
    for v in l do
        fixtagvec(v) -> (w, v);
        w :: tagnamelist -> tagnamelist;
        v -> tagprop(w)
    endfor;
    disambig(tagnamelist, vedhtmltagtermin) -> tagabbrevs
enddefine;

define lconstant vedhtmlreadtags(file);
    ;;; Read in a set of tags from a file.
    unless trycompile(file) then
        vederror('Tag file ' sys_>< file sys_>< ' not found')
    endunless -> vedhtmltags;
enddefine;

define lconstant vedhtmlprinttagnames;
    ;;; Prints the tag names and their abbreviations
    dlocal
        pop_charout_device
        = consveddevice('ved_html\'s tag abbreviations', 1, true);
    lvars a, w;
    lconstant printvec = initv(2);
    format_print('~%Abbreviation~15TTag name~2%', []);
    for a, w in ncrev(disambig_abbrevs(tagnamelist)), rev(tagnamelist) do
        a, w -> explode(printvec);
        format_print('~15A~A~%', printvec)
    endfor
enddefine;

define lconstant vedhtmlprinttags;
    ;;; Pretty prints the tag list in a working buffer.
    dlocal
        pop_charout_device = consveddevice('ved_html\'s tag list', 1, true),
        pop_=>_flag = nullstring,
        pop_pr_quotes = true;

    pretty(taglist)
enddefine;

/*

2.3  Tag utilities
------------------
*/

;;; Next three routines just test for attributes

define lconstant htmlseparates(tagrec) /* -> bool */;
    if tagrec.isword then tagprop(tagrec) -> tagrec endif;
    lmember("separates", tagrec.tag_quals)
enddefine;

define lconstant htmlhascloser(tagrec) /* -> bool */;
    if tagrec.isword then tagprop(tagrec) -> tagrec endif;
    lmember("hascloser", tagrec.tag_quals)
enddefine;

define lconstant htmlkeepspaces(tagrec) /* -> bool */;
    if tagrec.isword then tagprop(tagrec) -> tagrec endif;
    lmember("keepspaces", tagrec.tag_quals)
enddefine;

define lconstant vedhtmltagname /* -> tag */;
    ;;; Return the word from the cursor position to the next character
    ;;; that is illegal in a tag name (not a letter, digit, full stop
    ;;; or hyphen). Skips to first character of name if necessary.
    ;;; Used to get tag name if cursor just after tag left opener.
    ;;; Moves cursor to end of name.
    lvars c;
    until isalphacode(vedcurrentchar() ->> c)
    or locchar(c, 1, vedhtmltagchars) do
        vedcharnext()
    enduntil;
    consword( #|
            while isalphacode(vedcurrentchar() ->> c)
            or isnumbercode(c) or locchar(c, 1, vedhtmltagchars) do
                vedhtmluppercase and lowertoupper(c) or c;
                vedcharright()
            endwhile
        |# )
enddefine;

/*

2.4  Switching on and off P closers
-----------------------------------
*/

;;; A nasty hack really - but this is something users might well want to
;;; do, and it's not worth rebuilding the whole property and abbreviation
;;; structures to do it.

define lconstant taglistPentry -> Pentry;
    define lconstant istaglistPentry(v) /* -> bool */;
        v(1) == "P"
    enddefine;
    unless taglist = [=** =?Pentry:istaglistPentry =**] then
        vederror('No entry for P in tag list')
    endunless;
enddefine;

define lconstant vedhtmlPclosersoff;
    lvars Pentry = taglistPentry();
    delete("hascloser", Pentry(2)) -> Pentry(2);
    delete("hascloser", "P".tagprop.tag_quals) -> "P".tagprop.tag_quals
enddefine;

define lconstant vedhtmlPcloserson;
    lvars Pentry = taglistPentry(), l;
    unless lmember("hascloser", Pentry(2) ->> l) then
        "hascloser" :: l -> Pentry(2)
    endunless;
    unless lmember("hascloser", "P".tagprop.tag_quals ->> l) then
        "hascloser" :: l -> "P".tagprop.tag_quals
    endunless
enddefine;

lvars htmlPclosers = undef;     ;;; so overriden by file read in

define active vedhtmlPclosers /* -> bool */;
    lvars trec = tagprop("P");
    if trec then
        htmlhascloser(trec) ->> htmlPclosers
    else
        htmlPclosers
    endif
enddefine;

define updaterof active vedhtmlPclosers(Pclosers);
    if tagprop("P") then
        if Pclosers then
            vedhtmlPcloserson()
        else
            vedhtmlPclosersoff()
        endif
    endif;
    Pclosers -> htmlPclosers
enddefine;

define vedhtmlswitchPclosers(arg);
    lconstant son = 'on', soff = 'off';
    if arg /== [] then
        hd(arg) -> arg;
        if arg = son or arg = soff then
            arg = son -> vedhtmlPclosers
        endif
    endif;
    vedputmessage('Closers for P tag are ' sys_><
        if vedhtmlPclosers then son else soff endif)
enddefine;

/*

-----------------------------------------------------------------------
3  Ved utilities
-----------------------------------------------------------------------

3.1  General utilities
----------------------

Some Ved utilities are here, but some (e.g. vedsplice) occur later
either because they are only used locally or because they need
tag location routines.
*/

define lconstant vedbefore(l1, c1, l2, c2) /* -> bool */;
    ;;; True if first coordinates earlier than second
    l1 < l2 or (l1 == l2 and c1 < c2)
enddefine;

define lconstant vedinside(l0, c0, l1, c1, l2, c2) /* -> bool */;
    ;;; True if first coords after second coords and before
    ;;; third coords.
    vedbefore(l1, c1, l0, c0) and vedbefore(l0, c0, l2, c2)
enddefine;

include ast         ;;; for TIMER_CANCEL

define lconstant vedinascii_withprompt(prompt) /* -> char */;
    ;;; Calls vedinascii and puts the prompt on the status line if a
    ;;; character has not been typed after a second.
    ;;; Used later by key insert routine.

    define lconstant putmessage;
        vedputmessage(prompt)
    enddefine;

    lconstant wait = 1e6; ;;; microseconds to wait

    lvars msg = vedmessage;
    wait -> sys_timer(putmessage);
    vedinascii() /* -> char */;
    unless sys_timer(putmessage, TIMER_CANCEL) then
        vedputmessage(msg)
    endunless;
enddefine;

define lconstant vedleftcol /* -> col */;
    ;;; Returns the column of the leftmost text in the current line.
    dlocal vedcolumn;
    vedtextleft();
    vedcolumn
enddefine;

define lconstant vedadjustpos(l, c, l0, c0, text) -> (l, c);
    ;;; Adjusts the position of l and c to allow for the insertion
    ;;; of the text at l0, c0
    unless vedbefore(l, c, l0, c0) then     ;;; adjust cursor position
        if l == l0 then
            c + length(last(text)) -> c;
            unless tl(text) == [] then
                c - c0 + 1 -> c
            endunless
        endif;
        l + length(text) - 1 -> l;
    endunless;
enddefine;

define lconstant veddeletewholespan(l0, c0, l1, c1) /* -> text */;
    ;;; Deletes from l0,c0 to l1,c1 and adjusts cursor position
    ;;; to stay on same character (or move to just after deleted
    ;;; portion if it was in it). (Note: ved_cut does not seem
    ;;; to be consistent, so not used - specifically, if cut
    ;;; section is on more than one line, it replaces it with a
    ;;; line break.)
    ;;; Returns the text deleted as a list of lines. There is taken
    ;;; to be a line break between every pair of lines in this list,
    ;;; but not at either end of it.
    dlocal vveddump = [], vvedworddump = nullstring,
        0 % vedmarkpush(), vedmarkpop() %;
    lvars lg = vedline, cg = vedcolumn,
        sstring = false, estring = nullstring;

    ;;; First find final cursor position
    if vedbefore(l1, c1, lg, cg) then
        if l1 == lg then cg + c0 - c1 -> cg endif;
        lg + l0 - l1 -> lg;
    elseif vedbefore(l0, c0, lg, cg) then
        (l0, c0) -> (lg, cg)
    endif;

    if l1 > l0+1 then   ;;; delete intermediate lines in a chunk
        false -> vvedmarkprops;
        vedjumpto(l0+1, 1);
        vedmarklo();
        vedjumpto(l1-1, 1);
        vedmarkhi();
        ved_d();
        l0 + 1 -> l1;
    endif;
    if l0 == l1 then
        vedjumpto(l0, 1);
        if c1 > c0 then
            vedspandelete(c0, c1, true) -> estring
        endif
    else        ;;; successive lines
        vedjumpto(l0, c0);
        vedcleartail();
        vvedworddump -> sstring;
        vedjumpto(l1, c1);
        unless c1 == 1 then
            vedclearhead();
            vvedworddump -> estring
        endunless;
        vedchardelete();   ;;; delete line break
        ;;; may have to insert or remove spaces
        until vedcolumn <= c0 do
            vedchardelete() ;;; as vedchardelete may insert a space
        enduntil;
        until vedcolumn >= c0 do
            vedcharinsert(`\s`)  ;;; in case start was past end of line
        enduntil
    endif;

    vedjumpto(lg, cg);
    [% if sstring then sstring endif, explode(vveddump), estring %]
    /* -> text */
enddefine;

define vars vedhtmlchartype(char) /* -> type */;
    ;;; Needed so that eg >< is split into two.
    checkinteger(char, 0, false);
    char fi_&& 16:FF -> char;       ;;; get rid of attributes
    if locchar(char, 1, vedhtmlpunctchars) then
        `.`
    else
        vedchartype_orig(char)
    endif
enddefine;

define lconstant vedatstring(str) /* -> bool */;
    issubstring_lim(str, vedcolumn, vedcolumn, false, vedthisline())
enddefine;

define lconstant vedhtmlatsep /* -> bool */;
    ;;; Is current line an HTML separator tag?
    ;;; Does not use vedhtmlnexttag in order to avoid errors if
    ;;; vedhtmlinparagraph is used outside html context.
    VED_DLOCAL_POS
    lvars t;
    vedtextleft();
    vedatstring(htmlopenleft) and not(vedatstring(htmlcloseleft)) and
    tagprop(vedhtmltagname() ->> t) and htmlseparates(t)
enddefine;

define vars vedhtmlinparagraph /* -> bool */;
    ;;; Everything except a blank line is part of a paragraph.
    ;;; A line with . in the first column or with an HTML separator
    ;;; as the first text is a paragraph start.
    if vvedlinesize == 0 then
        false
    elseif vedlinestart('.') then
        1           ;;; roff-type macro
    else
        if vedhtmlatsep() then
            1
        else
            true
        endif
    endif
enddefine;

define lconstant vedwriteplain(filename);
    ;;; Write the current file without special Ved characters
    dlocal
        vedwriteoutplain = 1,
        vedargument = filename or nullstring;
    if filename then
        ved_w()
    else
        ved_w1()
    endif
enddefine;

/*

3.2  Ved search utilities
-------------------------

Best to have own search routines - can search for one of a set of
strings efficiently and can control scope more exactly. The routines
search for one of the strings in the list (if only one string is to be
used, it need not be in a list) and return the first one found searching
in the current direction up to the limit given.

In these two routines, cursor position is considered to be between
characters, just to the left of the position of the highlighted
character. String start and end points are the cursor positions
surrounding the string - in terms of character positions, start point
has coords of first character of string, but end point has coords of next
character after end of string.

The routines assume that no search string contains a newline. If the
cursor is inside a search string, this string is returned; otherwise
search proceeds forwards or backwards from the cursor position up to the
limit given.

If two strings match at a particular position, the longest is returned.

The algorithm may carry out repeated searches for a given string on one
line. This is certainly simpler and probably more efficient than keeping
a record of all search results.
*/

define lconstant vednextof(list, l1, c1) -> (s, l0s, c0s, l0s, c1s);
    ;;; Cursor left at end of string.
    ;;; Strings must start before l1, c1; l1 or c1 false means end of file.

    lvars s = false, l0s = false, c0s = false, c1s = false;

    lconstant singlist = [^false];
    if list.isstring then
        list -> front(singlist);
        singlist -> list
    endif;
    unless l1 and c1 then
        (vvedbuffersize + 1, 1) -> (l1, c1)
    endunless;

    vedtrimline();
    lvars l0 = vedline, s0 = vvedlinesize, startlim, line, ss, m, c;
    for vedline from l0 to l1 do
        vedsetlinesize();
        (vedline == l1) and c1-1 -> startlim;
        unless startlim and startlim <= 0 then
            vedthisline() -> line;
            for ss in list do
                (vedline == l0 and max(1, vedcolumn-length(ss)+1)) or 1 -> c;
                if (issubstring_lim(ss, c, startlim, false, line) ->> m)
                and (not(s)
                    or m < c0s
                    or (m == c0s and length(ss) > length(s))
                    )
                then
                    m -> c0s;
                    ss -> s
                endif
            endfor;
        quitif(s)
        endunless
    endfor;

    if s then
        vedline -> l0s;
        c0s + length(s) -> c1s;
        c1s -> vedcolumn
    else
        l0 -> vedline;
        s0 -> vvedlinesize
    endif
enddefine;

define lconstant vedlastof(list, l0, c0) -> (s, l0s, c0s, l0s, c1s);
    ;;; Cursor left at start of string.
    ;;; Strings must end after l0, c0; l0 or c0 false means start of file.

    lvars s = false, l0s = false, c0s = false, c1s = false;

    lconstant singlist = [^false];
    if list.isstring then
        list -> front(singlist);
        singlist -> list
    endif;
    unless l0 and c0 then
        (1, 1) -> (l0, c0)
    endunless;

    vedtrimline();
    lvars l1 = vedline, c = vedcolumn - 1, s0 = vvedlinesize,
        line, ss, m, m0, strt;
    for vedline from l1 by -1 to l0 do
        vedsetlinesize();
        c or vvedlinesize -> c;
        unless c <= 0 then
            vedthisline() -> line;
            for ss in list do
                (vedline == l0 and max(1, c0-length(ss)+1)) or 1 -> strt;
                false -> m;
                while issubstring_lim(ss, strt, c, false, line) ->> m0 do
                    m0 -> m;
                    m0 + 1 -> strt
                endwhile;
                if m
                and (not(s)
                    or m > c0s
                    or (m == c0s and length(ss) > length(s))
                    )
                then
                    m -> c0s;
                    ss -> s
                endif
            endfor;
        quitif(s)
        endunless;
        false -> c
    endfor;

    if s then
        vedline -> l0s;
        c0s + length(s) -> c1s;
        c0s -> vedcolumn
    else
        l1 -> vedline;
        s0 -> vvedlinesize
    endif
enddefine;

/*

-----------------------------------------------------------------------
4  Tag location
-----------------------------------------------------------------------
*/

define lconstant vedhtmlnexttag(ls, cs) -> (tag, opener, l0, c0, l1, c1);
    ;;; Searches forward for a tag ending after the cursor position
    ;;; and starting before ls, cs. Leaves the cursor at the end of the tag.
    ;;; If inside a tag starting before the current line and ending
    ;;; outside the search range and after the current line, will not see it.
    ;;; tag is returned as false if no tag found - other results
    ;;; undefined in this case.
    lvars tag = false, opener = false;

    unless ls and cs then
        (vvedbuffersize + 1, 1) -> (ls, cs)
    endunless;

    lvars s0, s1, c01, lg = vedline, cg = vedcolumn;
    vednextof(htmlmarklist, ls+1, 1) -> (s0, l0, c0, l1, c1);
    unless s0 then      ;;; May be inside a tag - check back to start of line
        vedlastof([% htmlopenleft, htmlcloseleft %], vedline, 1)
            -> (s0, l0, c0, l1, c1);
        if s0 then c1 -> vedcolumn endif
    endunless;

    if s0 then
        if s0 == vedhtmlopenright or s0 == vedhtmlcloseright then
            s0 -> s1;
            c0 -> vedcolumn;
            vedlastof(htmlmarklist, false, false) -> (s0, l0, c0, , c01)
        else
            c1 -> c01;
            vednextof(htmlmarklist, false, false) -> (s1, , , l1, c1)
        endif;

        unless ((s0 == htmlopenleft ->> opener) and s1 = htmlopenright)
        or (s0 == htmlcloseleft and s1 = htmlcloseright) then
            vederror('Incomplete tag or extra tag marker')
        endunless;
        vedjumpto(l0, c01);
        vedhtmltagname() -> tag;
        unless tagprop(tag) then
            vederror('Unrecognised tag ' sys_>< tag)
        endunless;

        ;;; As search was extended to check for case of being inside
        ;;; a long tag, must now check that this tag really is in
        ;;; the proper search area.
        if vedbefore(lg, cg, l1, c1) and vedbefore(l0, c0, ls, cs) then
            vedjumpto(l1, c1)
        else   ;;; tag outside range
            vedjumpto(lg, cg);
            false -> tag
        endif
    endif
enddefine;

define lconstant vedhtmlprevtag(ls, cs) -> (tag, opener, l0, c0, l1, c1);
    ;;; Searches backwards for a tag starting before the cursor position
    ;;; and ending after ls, cs. Leaves cursor at the start of tag.
    ;;; Same restriction on tag size if inside a tag as vedhtmlnexttag.

    lvars tag = false, opener = false;

    unless ls and cs then
        (1, 1) -> (ls, cs)
    endunless;

    lvars s0, s1, c01, lg = vedline, cg = vedcolumn;
    vedlastof(htmlmarklist, ls, 1) -> (s0, l0, c0, l1, c1);
    unless s0 then      ;;; check to end of line
        vednextof([% vedhtmlopenright, vedhtmlcloseright %], vedline+1, 1)
            -> (s0, l0, c0, l1, c1);
        if s0 then c0 -> vedcolumn endif
    endunless;

    if s0 then
        if s0 == vedhtmlopenright or s0 == vedhtmlcloseright then
            s0 -> s1;
            vedlastof(htmlmarklist, false, false) -> (s0, l0, c0, , c01)
        else
            c1 ->> c01 -> vedcolumn;
            vednextof(htmlmarklist, false, false) -> (s1, , , l1, c1)
        endif;

        unless ((s0 == htmlopenleft ->> opener) and s1 = htmlopenright)
        or (s0 == htmlcloseleft and s1 = htmlcloseright) then
            vederror('Incomplete tag or extra tag marker')
        endunless;
        vedjumpto(l0, c01);
        vedhtmltagname() -> tag;
        unless tagprop(tag) then
            vederror('Unrecognised tag ' sys_>< tag)
        endunless;

        if vedbefore(ls, cs, l1, c1) and vedbefore(l0, c0, lg, cg) then
            vedjumpto(l0, c0)
        else   ;;; tag outside range
            vedjumpto(lg, cg);
            false -> tag
        endif
    endif
enddefine;

define lconstant vedhtmlopener(tag) -> (t, l0, c0, l1, c1);
    ;;; Finds the opening tag for the element containing the cursor.
    ;;; Element contains cursor if cursor is after first character of
    ;;; opener and on or before last character of closer.
    ;;; If tag is non-false, ensures the tag found matches.
    ;;; Tags without closers ignored unless called with cursor inside
    ;;; when they form an element by themselves.
    ;;; Leaves cursor at l0, c0.

    lvars lg = vedline, cg = vedcolumn;

    define lconstant prevopener(tag);
        lvars opener, atcursor;
        repeat
            vedhtmlprevtag(false, false) -> (t, opener, l0, c0, l1, c1);
        quitunless (t);
            lg and vedinside(lg, cg, l0, c0, l1, c1) -> atcursor;
            false -> lg;        ;;; only check first tag found
            if opener then
            quitif (atcursor or htmlhascloser(t))
            elseunless atcursor then
                prevopener(t) ;;; skip element
            endif
        endrepeat;

        if tag and not(t) then
            vederror('Found start of file, wanted opener for ' sys_>< tag)
        endif;
        if tag and t /== tag then
            vederror('Found opener for '
                sys_>< t sys_>< ', wanted ' sys_>< tag)
        endif
    enddefine;

    prevopener(tag)
enddefine;

define lconstant vedhtmlcloser(tag) -> (t, l0, c0, l1, c1);
    ;;; Finds the closing tag for the element containing the cursor.

    lvars lg = vedline, cg = vedcolumn;

    define lconstant nextcloser(tag);
        lvars opener, atcursor, hascloser;
        repeat
            vedhtmlnexttag(false, false) -> (t, opener, l0, c0, l1, c1);
        quitunless (t);
            lg and vedinside(lg, cg, l0, c0, l1, c1) -> atcursor;
            false -> lg;        ;;; only check first tag found
            if opener then
                htmlhascloser(t) -> hascloser;
                if atcursor and not(hascloser) then
                    quitloop            ;;; special case - inside empty tag
                elseif not(atcursor) and hascloser then
                    nextcloser(t)   ;;; skip element
                    ;;; elseif atcursor and hascloser or
                    ;;; not(atcursor) and not(hascloser) then skip tag
                endif
            else        ;;; at closer
                quitloop
            endif
        endrepeat;

        if tag and not(t) then
            vederror('Found end of file, wanted closer for ' sys_>< tag)
        endif;
        if tag and t /== tag then
            vederror('Found closer for '
                sys_>< t sys_>< ', wanted ' sys_>< tag)
        endif
    enddefine;

    nextcloser(tag)
enddefine;

define lconstant vedhtmltagparts(withcloser)
        -> (tag, lt0, ct0, lt1, ct1, lc0, cc0, lc1, cc1);
    ;;; Returns locations of opener and closer of the element containing
    ;;; the cursor. If withcloser is <false> then the element can be an
    ;;; empty tag (one without a closer); otherwise a surrounding tag with
    ;;; content will be found. For a tag without a closer, the two sets of
    ;;; results are the same. Returns <false> for tag if not in a tag.
    ;;; Moves cursor to end of closer.
    repeat
        vedhtmlopener(false) -> (tag, lt0, ct0, lt1, ct1);
    quitunless(tag and withcloser and not(htmlhascloser(tag))) endrepeat;
    if tag then
        vedcharright();     ;;; move into opener
        vedhtmlcloser(tag) -> (tag, lc0, cc0, lc1, cc1);
    endif;
enddefine;

/*

-----------------------------------------------------------------------
5  URL recognition
-----------------------------------------------------------------------
*/

define lconstant vedhtmlinurl -> (l0, c0, l1, c1);
    ;;; Returns the coordinates of a URL surrounding the cursor.
    ;;; A URL is any string starting with something in urlstarts
    ;;; and terminated by a nonalphanumeric character not in urlchars.
    VED_DLOCAL_POS
    lvars cg = vedcolumn;
    vedcharright();         ;;; in case on first character
    vedlastof(vedhtmlurlstarts, vedline, 1) -> ( , l0, c0, l1, c1);
    if l0 then
        c1 -> vedcolumn;
        lvars c;
        while (vedcurrentchar() ->> c).isalphacode or c.isnumbercode
        or locchar(c, 1, vedhtmlurlchars) do
            vedcharright();
        endwhile;
        if vedcolumn > cg then
            vedcolumn -> c1
        else
            false ->> l0 ->> c0 ->> l1 -> c1
        endif
    endif
enddefine;

/*

-----------------------------------------------------------------------
6  Text Scope
-----------------------------------------------------------------------

6.1  Initial scope definition procedures
----------------------------------------
*/

lblock;

;;; Scopes for different kind of structures. l0, c0 are coords of first
;;; character in scope; l1, c0 are for first character after scope.

;;; In an lblock so that they can only be accessed through
;;; vedhtmlscopeprocs.

define lconstant cursorscope /* -> (l0, c0, l1, c1) */;
    vedline, vedcolumn, vedline, vedcolumn
enddefine;

define lconstant charscope /* -> (l0, c0, l1, c1) */;
    vedline, vedcolumn, vedline, vedcolumn + 1
enddefine;

define lconstant wordscope /* -> (l0, c0, l1, c1) */;
    VED_DLOCAL_POS
    lvars lg = vedline, cg = vedcolumn;
    vedcharright();  vedstartwordleft();
    vedline, vedcolumn;     /* -> l0, c0 */;
    vedendwordright();
    vedline, vedcolumn;     /* -> l1, c1 */
    unless vedbefore(lg, cg, vedline, vedcolumn) then
        vederror('Cursor not in word')
    endunless
enddefine;

define lconstant urlscope -> (l0, c0, l1, c1);
    vedhtmlinurl() -> (l0, c0, l1, c1);
    unless l0 then vederror('Not in a URL') endunless;
enddefine;

define lconstant linescope /* -> (l0, c0, l1, c1) */;
    VED_DLOCAL_POS
    vedtextleft();
    vedline, vedcolumn;     /* -> l0, c0 */;
    vedtextright();
    vedline, vedcolumn;     /* -> l1, c1 */
enddefine;

define lconstant sentscope /* -> (l0, c0, l1, c1) */;
    VED_DLOCAL_POS
    lvars lg = vedline, cg = vedcolumn;
    vedcharright();  vedprevsent();
    vedline, vedcolumn;     /* -> l0, c0 */;
    vednextsentend();
    vedline, vedcolumn + 1;     /* -> l1, c1 */
    if vedbefore(vedline, vedcolumn, lg, cg) then
        vederror('Cursor not in sentence')
    endif
enddefine;

define lconstant parascope /* -> (l0, c0, l1, c1) */;
    VED_DLOCAL_POS
    lvars lg = vedline, cg = vedcolumn;
    vedcharright();  vedprevpara();
    vedline, vedcolumn;     /* -> l0, c0 */;
    vednextparaend();
    vedline, vedcolumn;     /* -> l1, c1 */
    unless vedbefore(lg, cg, vedline+1, 1) then
        vederror('Cursor not in paragraph')
    endunless
enddefine;

define lconstant rangescope /* -> (l0, c0, l1, c1) */;
    VED_DLOCAL_POS
    vedmarkfind();
    vedline, vedcolumn;     /* -> l0, c0 */;
    vedendrange();  vedtextright();
    vedline, vedcolumn;     /* -> l1, c1 */
enddefine;

define lconstant filescope /* -> (l0, c0, l1, c1) */;
    1, 1, vvedbuffersize + 1, 1
enddefine;

define lconstant procscope -> (l0, c0, l1, c1);
    VED_DLOCAL_POS
    dlocal 0 % vedmarkpush(), vedmarkpop() %;
    lvars lg = vedline, cg = vedcolumn;
    ved_mcp();
    rangescope() -> (l0, c0, l1, c1);
    unless vedbefore(lg, cg, l1, c1) then
        vederror('Cursor not in procedure')
    endunless
enddefine;

define lconstant elemscope -> (l0, c0, l1, c1);
    VED_DLOCAL_POS
    lvars tag;
    vedhtmltagparts(false) -> (tag, l0, c0, , ,  , , l1, c1);
    unless tag then vederror('Not in an HTML element') endunless;
enddefine;

define lconstant inelemscope -> (l0, c0, l1, c1);
    VED_DLOCAL_POS
    lvars tag;
    vedhtmltagparts(true) -> (tag, , , l0, c0,  l1, c1, , );
    unless tag then vederror('Not in an HTML element') endunless;
enddefine;

define lconstant xselscope /* -> (l0, c0, l1, c1) */;
    ;;; This uses an undocumented system variable, so maybe
    ;;; not reliable. It is about time this sort of thing was available
    ;;; properly documented.
    lconstant noseln = {1 1 1 1};    ;;; who decided on this??
    if vedusewindows == "x" then
        lvars v = valof("vedselectioncoords");
        if v = noseln then
            vederror('No X selection made')
        else
            explode(v)
        endif
    else
        vederror('X selection only available in xved')
    endif
enddefine;

define lconstant stackscope -> (l0, c0, l1, c1);
    ;;; Top two elements of position stack used. Stack is popped
    ;;; (can dlocal vedpositionstack to preserve it, but it gets
    ;;; meaningless anyway after the insertions).
    VED_DLOCAL_POS
    vedpositionpop();
    (vedline, vedcolumn) -> (l0, c0);
    vedpositionpop();
    (vedline, vedcolumn) -> (l1, c1);
    if vedbefore(l1, c1, l0, c0) then
        (l1, c1, l0, c0) -> (l0, c0, l1, c1)
    endif
enddefine;

[
    [. ^cursorscope]
    [c ^charscope]
    [w ^wordscope]
    [u ^urlscope]
    [l ^linescope]
    [s ^sentscope]
    [p ^parascope]
    [o ^procscope]
    [r ^rangescope]
    [x ^xselscope]
    [k ^stackscope]
    [i ^inelemscope]
    [e ^elemscope]
    [f ^filescope]
];          ;;; on stack to escape from lblock

endlblock;

;;; vedhtmlscopeprocs is central property - maps scope characters to
;;; scope procedure defined above. vedhtmlscopechars is for information.

lconstant
    vedhtmlscopelist = identfn(),    ;;; get list from lblock
    vedhtmlscopeprocs = newproperty(vedhtmlscopelist, 20, false, "perm"),
    vedhtmlscopechars
        = consstring(#| applist(vedhtmlscopelist, hd <> explode) |#);

/*

6.2  Scope adjustment to allow for existing elements
----------------------------------------------------
*/

define lconstant vedhtmladjustscope(l0, c0, l1, c1) -> (l0, c0, l1, c1);
    ;;; Adjust the scope to avoid overlaps between elements.
    ;;; As much of the current scope as possible is included, working
    ;;; from the cursor position.
    VED_DLOCAL_POS

    if vedbefore(vedline, vedcolumn, l0, c0) then
        vedjumpto(l0, c0)
    elseif vedbefore(l1, c1, vedline, vedcolumn) then
        vedjumpto(l1, c1)
    endif;

    lvars lg = vedline, cg = vedcolumn,
        tag, opener, l0i, c0i, l1i, c1i, l0e, c0e, l1e, c1e;

    ;;; Go left from cursor, finding restrictions on scope
    repeat
        vedhtmlprevtag(l0, c0) -> (tag, opener, l0e, c0e, l0i, c0i);
    quitunless(tag);
        if opener and htmlhascloser(tag) then
            vedcharright();
            vedhtmlcloser(tag) -> ( , l1i, c1i, l1e, c1e);
            if vedbefore(l0e, c0e, l0, c0) or vedbefore(l1, c1, l1e, c1e) then
                (l0i, c0i) -> (l0, c0);     ;;; stay inside element
                if vedbefore(l1i, c1i, l1, c1) then
                    (l1i, c1i) -> (l1, c1)  ;;; stay inside
                endif;
                quitloop
            elseif vedbefore(lg, cg, l1e, c1e) then
                (l1e, c1e) -> (lg, cg)  ;;; stay outside
            endif;
            vedjumpto(l0e, c0e);
        else
            vedcharright();     ;;; in case of empty tag
            vedhtmlopener(tag) -> ( , l1i, c1i, l1e, c1e);
            if vedbefore(lg, cg, l0i, c0i) then
                (l0i, c0i) -> (lg, cg)   ;;; stay to right of element
            endif;
            if vedbefore(l1i, c1i, l0, c0) then
                (l0i, c0i) -> (l0, c0);   ;;; stay to right
                quitloop
            endif
        endif
    endrepeat;

    ;;; Go right from cursor
    vedjumpto(lg, cg);
    repeat
        vedhtmlnexttag(l1, c1) -> (tag, opener, l0e, c0e, l0i, c0i);
    quitunless(tag);
        if opener then
            vedcharleft();      ;;; in case of empty tag
            vedhtmlcloser(tag) -> ( , , , l1e, c1e);
            if vedbefore(l1, c1, l1e, c1e) then
                (l0e, c0e) -> (l1, c1);     ;;; stay to left of element
                quitloop
            endif
        else ;;; Closer - must be operating inside this element
            (l0e, c0e) -> (l1, c1);     ;;; stay inside element
            quitloop
        endif
    endrepeat;

    if vedbefore(l1, c1, l0, c0) then
        vederror('Scope error - cursor or start or end of scope inside tag?')
    endif
enddefine;

define lconstant vedhtmlscope(scope) /* -> (l0, c0, l1, c1) */;
    ;;; Specify scope as 4 integers, list or vector with 4 integers,
    ;;; or word giving scope character. Returns adjusted scope.

    if scope.isinteger then     ;;; should be 3 more integers on stack
        scope
    elseif scope.islist or scope.isvector then
        unless length(scope) == 4 then
            mishap(scope, 1, 'Scope list or vector should have length 4')
        endunless;
        explode(scope)
    elseif scope.isword then
        lvars p = vedhtmlscopeprocs(scope);
        if p then
            p()
        else
            vederror('Unrecognised scope option: ' sys_>< scope)
        endif
    else
        mishap(scope, 1, 'Expecting integer, list, vector or word')
    endif;

    vedhtmladjustscope()

enddefine;

/*

-----------------------------------------------------------------------
7  Tag insertion
-----------------------------------------------------------------------

7.1  Tag highlighting
---------------------
*/

define lconstant vedsetattr(attr, l0, c0, l1, c1);
    ;;; Sets the attributes of all the characters in the current range.
    ;;; Throws away the old attributes (Cf setattribs)
    ;;; If first arg is false, unsets attributes.
    VED_DLOCAL_POS
    unless attr then 0 -> attr endunless;
    lvars line, col0, col1;
    for line from l0 to l1 do
        vedjumpto(line, 1);
        if line == l0 then c0 else 1 endif -> col0;
        if line == l1 then c1-1 else vvedlinesize endif -> col1;
        for vedcolumn from col0 to col1 do
            attr || vedcurrentchar() -> vedcurrentdchar()
        endfor
    endfor
enddefine;

define lconstant vedhtmlsettagattrs(attr, l0, c0, l1, c1);
    ;;; Set the attributes of all tags in the range given.
    VED_DLOCAL_POS
    dlocal vedediting = false;
    vedjumpto(l0, c0);
    repeat
        lvars (tag, , tl0, tc0, tl1, tc1) = vedhtmlnexttag(l1, c1);
    quitunless(tag);
        vedsetattr(attr, tl0, tc0, tl1, tc1)
    endrepeat;
    true -> vedediting; vedrefresh();
enddefine;

define lconstant vedhtmlsetallattrs;
    dlocal vedautowrite = false;
    vedhtmlsettagattrs(vedhtmlhighlight and vedhtmltagattr,
        1, 1, vvedbuffersize+1, 1);
enddefine;

define lconstant vedhtmlshowtags;
    ;;; Toggles display of tags.
    not(vedhtmlhighlight) -> vedhtmlhighlight;
    vedputmessage('Changing tag characters - please wait');
    vedhtmlsetallattrs();
    vedputmessage(if vedhtmlhighlight then
            'Tag highlighting is on - use "html write" to write file'
        else
            'Tag highlighting is off'
        endif)
enddefine;

/*

7.2  Main insertion procedure
-----------------------------
*/

define lconstant vedhtmlinsert(scope, tag);
    ;;; Insert tag round scope. Scope can be specified by line
    ;;; and column numbers or as a word specifying one of the
    ;;; scope procedures above.
    dlocal vvedworddump;        ;;; because uses vedspandelete

    lvars (l0, c0, l1, c1) = vedhtmlscope(scope);

    lvars
        tagrec = tagprop(tag),
        issep = htmlseparates(tagrec),
        hascloser = htmlhascloser(tagrec),
        keepspaces = htmlkeepspaces(tagrec),
        attr = tagrec.tag_attribs,
        curspos = tagrec.tag_cursor,
        urlpos = tagrec.tag_url,
        linecurs = vedline, colcurs = vedcolumn;

    ;;; Opening tag
    vedjumpto(l0, c0);

    ;;; Put separator tags on new lines to help find paragraphs
    if issep then
        lvars lcol = vedleftcol();
        if keepspaces and c0 > 1 and c0 <= lcol then
            ;;; put tag at left margin to preserve initial indent in
            ;;; formatted text
            1 ->> c0 -> vedcolumn;
        elseif c0 > lcol then ;;; separator tag being put in middle of text
            if linecurs == l0 and colcurs >= c0 then
                colcurs - c0 + 1 -> colcurs
            endif;
            linecurs + 1 -> linecurs;
            if l1 == l0 then
                c1 - c0 + 1 -> c1
            endif;
            l1 + 1 -> l1;
            1 -> c0;
            l0 + 1 -> l0;
            vedcharinsert(`\n`);
        endif
    endif;

    ;;; Get an opening URL if there is one
    lvars urlc0, urlc1, url = false;
    if urlpos then
        vedhtmlinurl() -> ( , urlc0, , urlc1);
        if urlc0 == vedcolumn then
            if urlpos == curspos then
                false -> curspos
            elseif curspos and urlpos < curspos then
                curspos + urlc1 - urlc0 -> curspos
            endif;
            vedspandelete(urlc0, urlc1, true) -> url
        endif
    endif;

    ;;; Insert the opening tag (assume vedbreak set false by caller)
    vedinsertstring(htmlopenleft);
    vedinsertstring(tag);
    if attr then
        vedcharinsert(`\s`);
        vedinsertstring(attr);
        if url then
            vedcolumn - urlpos -> vedcolumn;
            vedinsertstring(url);
            vedcolumn + urlpos -> vedcolumn
        endif
    endif;
    vedinsertstring(htmlopenright);

    ;;; Highlight opening tag if required
    if vedhtmlhighlight then
        vedsetattr(vedhtmltagattr, l0, c0, vedline, vedcolumn)
    endif;

    ;;; Adjust other positions. lenopen is length of opening tag.
    lvars colopenright = vedcolumn, lenopen = colopenright - c0;
    if url then lenopen - urlc1 + urlc0 -> lenopen endif;
    if l0 == linecurs and colcurs >= c0 then
        if url and colcurs < urlc1 then     ;;; cursor was in URL
            colcurs - urlpos - length(htmlopenright) -> colcurs
        endif;
        colcurs + lenopen -> colcurs;
    endif;
    if l0 == l1 then
        c1 + lenopen -> c1
    endif;

    ;;; Closing tag
    if hascloser then
        vedjumpto(l1, c1);
        vedinsertstring(htmlcloseleft);
        vedinsertstring(tag);
        vedinsertstring(htmlcloseright);

        ;;; Highlight closing tag if required
        if vedhtmlhighlight then
            vedsetattr(vedhtmltagattr, l1, c1, vedline, vedcolumn)
        endif;

        ;;; Adjust cursor position for closing tag
        if l1 == linecurs and colcurs > c1 then
            colcurs + vedcolumn - c1 -> colcurs
        endif;
    elseif issep then
        l0 -> l1            ;;; closer and opener same
    endif;

    ;;; Line break and maybe blank line after closing separator
    if issep then
        if vedusedsize(vedthisline()) >= vedcolumn then
            if linecurs == vedline and colcurs >= vedcolumn then
                linecurs + 1 -> linecurs;
                colcurs - vedcolumn + 1 -> colcurs
            elseif linecurs > l1 then
                linecurs + 1 -> linecurs
            endif;
            vedcharinsert(`\n`);
        else
            vedchardown()
        endif;
        if vedinparagraph() == true then  ;;; not 1 or false
            vedlineabove();
            if linecurs > l1 then linecurs + 1 -> linecurs endif;
        endif
    endif;

    ;;; Set final cursor position
    if curspos then
        vedjumpto(l0, colopenright - length(htmlopenright) - curspos)
    else
        vedjumpto(linecurs, colcurs)
    endif
enddefine;

/*

7.3  Keyboard insertion
-----------------------
*/

define lconstant vedsplice(l, c, text, upd_attr);
    ;;; Insert the text, in the form returned by veddeletewholespan,
    ;;; into the file at l,c.
    ;;; If upd_attr is true, set attributes of any tags in the spliced text.
    ;;; Restores the cursor.

    lvars (lg, cg) = vedadjustpos(vedline, vedcolumn, l, c, text);

    vedjumpto(l, c);
    vedinsertstring(dest(text) -> text);
    lvars line;
    for line in text do
        vedcharinsert(`\n`);
        vedinsertstring(line)
    endfor;

    if upd_attr then
        vedhtmlsettagattrs(vedhtmlhighlight and vedhtmltagattr,
            l, c, vedline, vedcolumn)
    endif;

    vedjumpto(lg, cg)
enddefine;

define lconstant setattribs(attrib, l0, c0, l1, c1) -> oldtext;
    ;;; Sets attributes in the given scope to attrib.
    ;;; The original text is returned for reinstatement later (Cf vedsetattr).
    ;;; This together with restoretext preserve both the original
    ;;; attributes and embedded data.
    VED_DLOCAL_POS
    dlocal vedediting = false;
    veddeletewholespan(l0, c0, l1, c1) -> oldtext;

    vedsplice(l0, c0,
        [% lvars str; for str in oldtext do
                lvars l = length(str), i;
                consdstring(
                    for i from 1 to l do
                        attrib || (str(i) && 16:FFFF)
                    endfor, l)
            endfor %], false);

    true -> vedediting; vedrefresh()
enddefine;

define lconstant restoretext(oldtext, l0, c0, l1, c1);
    ;;; Deletes the given scope and restores the text
    ;;; (including attributes and embedded data).
    VED_DLOCAL_POS
    dlocal vedediting = false;
    veddeletewholespan(l0, c0, l1, c1) -> ;
    vedsplice(l0, c0, oldtext, false);
    true -> vedediting; vedrefresh()
enddefine;

lvars procedure vedhtmldeletescope;         ;;; forward ref

define lconstant vedhtmlkeyinsert(scope);
    ;;; Show scope, then get tag and do vedhtmlinsert.

    lvars (l0, c0, l1, c1) = vedhtmlscope(scope);

    lvars saved_text = false;
    if vedhtmlscopeattr then        ;;; change the scope
        setattribs(vedhtmlscopeattr, l0, c0, l1, c1) -> saved_text
    endif;

    ;;; Get tag
    lvars firsttagchar = false;
    define lconstant readtag -> ch;   ;;; repeater for reading tag
        unless firsttagchar then
            vedinascii_withprompt(
                'Start of tag name, or tag termination character, or <DEL>'
            ) ->> ch -> firsttagchar
        else
            vedinascii_withprompt(
                'Continue tag name or type a tag termination character'
            ) -> ch
        endunless;
        if vedhtmluppercase then lowertoupper(ch) -> ch endif
    enddefine;

    lvars tag = tagabbrevs(readtag);            ;;; try to read tag

    ;;; Unmark the scope
    if saved_text then
        restoretext(saved_text, l0, c0, l1, c1);
    endif;

    if tag then         ;;; if a tag read then insert it
        vedhtmlinsert(l0, c0, l1, c1, tag)
    else
        if firsttagchar == `\^?` then       ;;; delete scope
            vedhtmldeletescope(l0, c0, l1, c1)
        elseif not(lmember(firsttagchar, vedhtmltagtermin)) then
            vederror('Unrecognised tag')
        endif
    endif
enddefine;


/*

-----------------------------------------------------------------------
8  Tag deletion
-----------------------------------------------------------------------
*/

define lconstant vedhtmldel(l, c) -> tag;
    ;;; Deletes the tag and its closer that surround (l, c),
    ;;; restoring the cursor position.
    ;;; Uses current cursor position if l false.
    ;;; Stores deleted text and positions in vedhtmldump - position
    ;;; for closer is position before closer restored.

    lvars lg = vedline, cg = vedcolumn;
    if l then vedjumpto(l, c) endif;
    lvars
        (tag, lt0,ct0,lt1,ct1, lc0,cc0,lc1,cc1) = vedhtmltagparts(false);
    unless tag then vederror('Not in an HTML element') endunless;
    if htmlhascloser(tag) then
        if lt1 == lc0 then cc0 + ct0 - ct1 -> cc0 endif;
        if lt1 == lc1 then cc1 + ct0 - ct1 -> cc1 endif;
        lc0 + lt0 - lt1 -> lc0;
        lc1 + lt0 - lt1 -> lc1;
    endif;

    vedjumpto(lg, cg);
    lt0, ct0, veddeletewholespan(lt0, ct0, lt1, ct1);  ;;; on stack
    if htmlhascloser(tag) then
        lc0, cc0, veddeletewholespan(lc0, cc0, lc1, cc1)
    else
        false, false, false
    endif;
        -> explode(vedhtmldump)
enddefine;

define lvars procedure vedhtmldeletescope(scope);
    ;;; Deletes the entire scope.
    lvars (l0, c0, l1, c1) = vedhtmlscope(scope);
    l0, c0, veddeletewholespan(l0, c0, l1, c1), false, false, false
        -> explode(vedhtmldump)
enddefine;

/*

-----------------------------------------------------------------------
9  Splicing deleted text
-----------------------------------------------------------------------
*/

define lconstant vedhtmlundo;
    ;;; Splice back deleted text in the positions it came from.
    ;;; May not work if edits have been made since deletion.
    lvars (lt, ct, textt, lc, cc, textc) = explode(vedhtmldump);
    if lt then
        if lc then
            vedhtmladjustscope(lt, ct, lc, cc) -> (lt, ct, lc, cc);
        endif;
        vedsplice(lt, ct, textt, true)
    else
        vederror('Nothing to undo')
    endif;
    if lc then
        vedadjustpos(lc, cc, lt, ct, textt) -> (lc, cc);
        vedsplice(lc, cc, textc, true)
    endif;
enddefine;

define lconstant vedhtmlsplice(scope);
    ;;; Splice text back round current scope, or in front of it if
    ;;; no closer.
    lvars
        (l0, c0, l1, c1) = vedhtmlscope(scope),
        textt = vedhtmldump(3), textc = vedhtmldump(6),
        lg = vedline, cg = vedcolumn;
    if textt then
        vedsplice(l0, c0, textt, true)
    else
        vederror('Nothing to splice')
    endif;
    if textc then
        vedadjustpos(l1, c1, l0, c0, textt) -> (l1, c1);
        vedsplice(l1, c1, textc, true)
    endif
enddefine;

/*

-----------------------------------------------------------------------
10  Preprocessing routines
-----------------------------------------------------------------------

10.1  Character attributes
--------------------------
*/

define lconstant attribstotags(str) -> str;
    ;;; Converts some character attributes into tags and
    ;;; ignores the rest.  Ensures tags nest, using special purpose code.

    lconstant attrnames = {b i u};  ;;; must match vedhtmlattribtags
    lconstant macro b = 1, i = 2, u = 3;
    lconstant testbits = { ^(
        integer_leastbit(`\[b]`),
        integer_leastbit(`\[i]`),
        integer_leastbit(`\[u]`) ) };

    define lconstant tag(name, sw);
        if sw then
            explode(htmlopenleft)
        else
            explode(htmlcloseleft)
        endif;
        explode(name);
        if sw then
            explode(htmlopenright)
        else
            explode(htmlcloseright)
        endif
    enddefine;

    lconstant switchedon = initv(3);
    (false, false, false) -> explode(switchedon);   ;;; in case of mishap
    lvars onlist = [];      ;;; stack of atrributes switched on

    define lconstant puton(attr);
        lvars tagname = vedhtmlattribtags(attrnames(attr));
        if tagname then
            attr :: onlist -> onlist;
            true -> switchedon(attr);
            tag(tagname, true)
        endif
    enddefine;

    define lconstant procedure putoff(attr);
        repeat
            lvars a = (dest(onlist) -> onlist);
            false -> switchedon(a);
            tag(vedhtmlattribtags(attrnames(a)), false);
        quitif(a == attr) endrepeat
    enddefine;

    if str.isdstring then
        lvars bld, ita, und;
        consstring( #|
                lvars ind, c;
                for ind from 1 to vedusedsize(str) do
                    str(ind) -> c;
                    unless vedchartype(c) == `\s` then
                        testbit(c, testbits(b)) -> bld;
                        testbit(c, testbits(i)) -> ita;
                        if not(bld) and switchedon(b) then putoff(b) endif;
                        if not(ita) and switchedon(i) then putoff(i) endif;
                    endunless;
                    testbit(c, testbits(u)) -> und;
                    if not(und) and switchedon(u) then putoff(u) endif;
                    unless vedchartype(c) == `\s` then
                        if bld and not(switchedon(b)) then puton(b) endif;
                        if ita and not(switchedon(i)) then puton(i) endif;
                    endunless;
                    if und and not(switchedon(u)) then puton(u) endif;
                    c && 16:FF          ;;; ordinary char
                endfor;
                if switchedon(b) then putoff(b) endif;
                if switchedon(i) then putoff(i) endif;
                if switchedon(u) then putoff(u) endif;
            |# ) -> str
    endif
enddefine;

define lconstant vedhtmlattribs;
    ;;; Replace character attributes with tags
    vedtopfile();
    until vedatend() do
        attribstotags(vedthisline()) -> vedthisline();
        vedchardown()
    enduntil
enddefine;

/*

10.2  Special characters such as < and &
----------------------------------------
*/

define lconstant vedhtmlspecchars;
    ;;; Replaces special characters, using vedhtmlglobalreplace
    dlocal vedargument;
    for vedargument in vedhtmlglobalreplace do
        ved_sgs();
    endfor
enddefine;

/*

10.3  Indexes
-------------
*/

define lconstant parseindex(indstr) -> (type, headstr);
    ;;; Tries to identify the type of a string from an index
    lvars type = false;
    lvars pd, ps = issubstring('\s\s', 1, indstr), l = length(indstr);
    if isstartstring('...', indstr) and ps == 4 then
        3 -> type;
        substring(6, l - 5, indstr) -> headstr
    else
        if (locchar(`.`, 2, indstr) ->> pd) and pd < ps then
            2 -> type
        else
            1 -> type
        endif;
        substring(ps + 2, l - ps - 1, indstr) -> headstr
    endif
enddefine;

define lconstant concatstrings(strlist) /* -> string */;
    ;;; Joins strings (and words) together. Avoids intermediate string
    ;;; construction at the expense of the list to pass the strings in.
    lvars s, n = 0;
    consstring( #|
            for s in strlist do
                explode(s)
            endfor
        |# )
enddefine;

uses ved_newindex

define lconstant get_next_indexline -> string;
    lvars string;
    ;;; Like $-ved$-find_new_indexline except will not go past a
    ;;; non-index line (so can ignore embedded index fragments as found,
    ;;; for example, in REF * VEDCOMMS)
    until ($-ved$-is_new_indexline(vedthisline()) ->> string) or
        vvedlinesize /== 0 or vedline >= vvedbuffersize  do
        vedchardown()
    enduntil
enddefine;

define lconstant reindexify /* -> indexline */;
    ;;; Reconstruct headers and index in standard form
    ;;; Actually, ref files sometimes have out of date indexes, so quite
    ;;; a good idea to renumber and redo index anyway.
    dlocal vedargument = 'r ref';
    ved_newheading();   ;;; replace all headings in new ref style
    vedtopfile();
    'nosp' -> vedargument;
    ved_newindex();  ;;; new index without spacing
    vedline
enddefine;

define lconstant vedhtmlfixindex(indexline);
    ;;; Rather than rewriting most of the indexing material,
    ;;; call it. May redo some work, but reliable as long as
    ;;; styles implemented by ved_newindex and ved_newheading do not change.

    vedjumpto(indexline, 1);

    ;;; The CONTENTS line will not exist if there was an index
    ;;; without one previously, so put in an extra line for it.
    unless issubstring('CONTENTS', 1, vedthisline()) then
        vedchardown();
        vedlinebelow();
        vedcharup()
    endunless;

    lvars lcont = vedline, ccont = vedcolumn, iline;

    ;;; Delete old_type index entries (not done when index rebuilt)
    unless ved_g_string = nullstring then
        lvars s = '@^\s' sys_>< ved_g_string;
        while ved_try_search(s, [nowrap]) do
            vedlinedelete(); vedcharup()
        endwhile
    endunless;
    vedjumpto(lcont+1, 1);

    ;;; Do each index entry. Index entries and headers can point to
    ;;; each other mutually to make it easy to jump between
    ;;; index and text.
    1 ->> gensym("index") -> gensym("heading");
    nullstring -> vedargument;
    lvars hasindex = false;
    while get_next_indexline() ->> iline do
        true -> hasindex;
        lvars
            li = vedline, lc = vedcolumn,     ;;; index line
            (htype, hstring) = parseindex(iline),
            nameh = gensym("heading"), namei = gensym("index");

        ved_g();                                ;;; to heading

        if htype == 1 then           ;;; delete over- and underlining
            vedcharup(); vedlinedelete();
        endif;
        vedchardown(); nullstring -> vedthisline(); vedcharup();

        concatstrings([%
                htmlopenleft, vedhtmlheaders(htype), htmlopenright,
                htmlopenleft, 'A NAME="', nameh, '"',
                if vedhtmljumptoindex then
                    ' HREF="#', namei, '"'
                endif,
                htmlopenright,
                hstring,
                htmlcloseleft, 'A', htmlcloseright,
                htmlcloseleft, vedhtmlheaders(htype), htmlcloseright
            %]) -> vedthisline();

        vedjumpto(li, lc);                      ;;; back to index
        concatstrings([%
                htmlopenleft, vedhtmlindexentry, htmlopenright,
                htmlopenleft, 'A HREF="#', nameh, '"',
                if vedhtmljumptoindex then
                    ' NAME="', namei, '"'
                endif,
                htmlopenright,
                vedhtmlindexmarks(htype), hstring,
                htmlcloseleft, 'A', htmlcloseright,
                htmlcloseleft, vedhtmlindexentry, htmlcloseright
            %]) -> vedthisline();
        vedchardown()
    endwhile;

    ;;; Terminate index
    if hasindex then
        vedjumpto(li, 1);
        vedlinebelow();
        htmlcloseleft sys_>< vedhtmlindextype sys_>< htmlcloseright
            -> vedthisline()
    endif;

    ;;; Some REF files have mini-indices in the text (e.g. REF * VEDCOMMS)
    ;;; Ideally these ought to become references too, but for now just
    ;;; remove their numbers which have become meaningless and make
    ;;; them separate objects.
    while $-ved$-find_new_indexline() ->> iline do
        parseindex(iline) -> (htype, hstring);
        concatstrings([%
                htmlopenleft, vedhtmlembeddedindextag, htmlopenright,
                vedhtmlindexmarks(htype), hstring,
                htmlcloseleft, vedhtmlembeddedindextag, htmlcloseright
            %]) -> vedthisline()
    endwhile;

    ;;; Start index or delete contents line
    vedjumpto(lcont, 1);        ;;; back to contents line
    if hasindex then
        concatstrings([%
                htmlopenleft, vedhtmlheaders(1), htmlopenright,
                vedhtmlcontents,
                htmlcloseleft, vedhtmlheaders(1), htmlcloseright
            %]) -> vedthisline();
        if vedhtmljumptoindex.isstring then
            vedlinebelow(); vedlinebelow();
            vedhtmljumptoindex -> vedthisline();
            vedlinebelow();
        endif;
        vedchardown();
        htmlopenleft sys_>< vedhtmlindextype sys_>< htmlopenright
            -> vedthisline()
    else
        vedlinedelete();  vedlinedelete()
    endif
enddefine;

/*

10.4  REF/HELP/TEACH file headers
---------------------------------
*/

define lconstant vedhtmlsimplepara /* -> inpara */;
    ;;; For recognising paragraphs simply separated by blank lines
    vvedlinesize /== 0
enddefine;

define lconstant noattribs(dstr) /* -> str */;
    ;;; Strips attributes from string
    mapdata(dstr, nonop fi_&&(% 16:FF %))
enddefine;

uses int_parameters

define lconstant vedhtmldocheads -> (title, authors, heading);
    ;;; Deletes the name, authors, and heading box of a ref file and
    ;;; returns them.
    ;;; Must be called before special characters are replaced.

    lvars title = false, authors = false, heading = false;

    dlocal
        vedlinemax = pop_max_int,
        vedargument,
        vedinparagraph = vedhtmlsimplepara,
        0 %vedmarkpush(), vedmarkpop() %;
    lconstant
        startheader =
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>',
        endheader =
        '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<',
        maxhdsize = 10;      ;;; max number of lines in a header

    vedtopfile();
    lvars first = vednextitem();
    if lmember(first, [REF TEACH DOC HELP]) then
        vedwordrightdelete();
        first sys_>< '\s' sys_>< vednextitem() -> title;
        vedwordrightdelete();
        vedmarkparagraph();
        ved_al();
        ved_fill();
        noattribs(vedthisline()) -> authors;
        vedlinedelete();

        if ved_try_search(startheader, []) then
            vedmarklo();
            vedline + maxhdsize -> vedline; vedsetlinesize();
            vedmarkhi();
            vedline - maxhdsize + 1 -> vedline; vedsetlinesize();
            if ved_try_search(endheader, [range]) then
                vedmarkhi();
                '/>//' -> vedargument;
                ved_sgsr();
                '/<//' -> vedargument;
                ved_sgsr();
                ved_al();
                ved_fill();
                vedprevpara();
                noattribs(vedthisline()) -> heading;
                vedlinedelete()
            endif
        endif
    endif
enddefine;

/*

10.5  Lists
-----------
*/

define lconstant parastart -> found;
    ;;; Goes forwards until vedinparagraph true (or end of file)
    until (vedinparagraph() ->> found) or vedatend() do
        vedchardown()
    enduntil
enddefine;

define lconstant paraend;
    ;;; Goes forwards while vedinparagraph true
    vedchardown();
    until vedinparagraph() /== true do
        vedchardown()
    enduntil;
    vedcharup()
enddefine;

define lconstant listline -> (indent, startitem, startlen);
    ;;; Tests whether a line is a potential list item first line.
    ;;;
    ;;; Call with the cursor on the first line of the potential para.
    ;;;
    ;;;     Is a candidate if the characters before the first space on
    ;;;     the first line are
    ;;;
    ;;;         a single non-alphanumeric character or "o" or "x"
    ;;;      or a single letter followed by "." or ")"
    ;;;      or an integer optionally followed by ".", ")" or ".)"
    ;;;      or two integers separated by "." optionally followed ditto
    ;;;
    ;;; Returns false for all results if condition not met; otherwise gives
    ;;; the indent of the first line, the item before the punctuation, and the
    ;;; length of the stuff up to the first space. Two numbers separated by
    ;;; a dot are returned as a pair.

    VED_DLOCAL_POS

    define :inline lconstant nonneg(x) /* -> x */;
        (x).isreal and (x) >= 0 and (x)
    enddefine;

    define splitstring(str) /* -> strings on stack */;
        ;;; like sys_parse_string but uses `.` instead of white space
        lvars i = 1, j;
        while locchar(`.`, i, str) ->> j do
            substring(i, j-i, str);      ;;; on stack
            j+1 -> i
        endwhile;
        substring(i, datalength(str)-i+1, str)
    enddefine;

    false ->> indent ->> startitem -> startlen;
    vedtextleft();
    lvars c0 = vedcolumn;

    lvars str, len;
    consstring(#|
            repeat
                lvars ch = vedcurrentchar(), chtype = vedchartype(ch);
            quitif (chtype == `\s` or chtype == `\t` or chtype == `\n`);
                ch;
                vedcharright();
            endrepeat |# ->> len) -> str;

returnif (str = nullstring);   ;;; line starting with special space

    if len == 1 then
        lvars ch = str(1);
        if ch == `o` or ch == `x` or not(ch.isalphacode or ch.isnumbercode)
        then
            consword(str) -> startitem
        endif
    elseif len == 2 then
        lvars ch = str(1), ch2 = str(2);
        if (ch2 == `.` or ch2 == `)`) and ch.isalphacode then
            ch -> startitem  ;;; can treat as if a number (at least if ASCII!)
        endif
    endif;
    unless startitem then  ;;; maybe it is a number or two
        lvars l = len, ch = str(len);
        if ch == `.` or ch == `)` then
            allbutlast(1, str) -> str;
            l - 1 -> l
        endif;
        lvars nitems = #| splitstring(str) |#;
        if nitems == 1 then
            strnumber() -> startitem;
            nonneg(startitem) -> startitem;
        elseif nitems == 2 then
            lvars i2 = strnumber(), i1 = strnumber();
            nonneg(i1) -> i1;  nonneg(i2) -> i2;
            if i1 and i2 then conspair(i1, i2) -> startitem endif
        else
            erasenum(nitems)
        endif
    endunless;
    if startitem then
        c0 -> indent;
        len -> startlen
    endif
enddefine;

define lconstant testlistline(indent1, startitem1)
        -> (indent, startitem, startlen);
    ;;; If arguments not false, then tests whether current line
    ;;; is the first line of a possible continuation paragraph.
    ;;; A para can continue a list if its indent is the same as the
    ;;; previous one, and its startitem is the same if a word or
    ;;; increments appropriately if a number. In this case indent is <true>.
    ;;; A para can start a sublist if it changes from a number to two
    ;;; numbers, or if its indent increases. In this case indent is an int.
    ;;; Otherwise indent is false.

    listline() -> (indent, startitem, startlen);

    if indent1 then
        if indent == indent1
        and (
                (startitem.isword and startitem == startitem1)
            or (startitem.isinteger and startitem1.isinteger
                and startitem == startitem1 + 1)
            or (startitem.ispair and startitem1.ispair
                and front(startitem) == front(startitem1)
                and back(startitem) == back(startitem1) + 1)
            ) then
            true -> indent
        elseif indent
        and (
                (indent > indent1 and startitem.isword and startitem == startitem1)
            or (indent >= indent1 and startitem.ispair and startitem1.isinteger
                and front(startitem) == startitem1)
            ) then
            ;;; leave it alone
        else
            false -> indent
        endif
    endif
enddefine;

define lconstant marklist(indent1, startitem1, startlen1) -> lend;
    ;;; Called with cursor on first line of para.
    ;;; Three cases when called:
    ;;;     not already in a list - all args <false>
    ;;;     already in a list but current para not looked at yet
    ;;;         - startlen1 only <false>
    ;;;     first para in a sublist - no args <false>
    ;;;
    ;;; Returns line no of last line of list, or false if not
    ;;; a list.

    lvars lg = vedline;

    define lconstant restoreline;
        vedjumpto(lg, 1)
    enddefine;

    define lconstant markthispara(indent, startlen);
        dlocal 0 % vedmarkpush(), vedmarkpop() %;
        vedmarkparagraph();
        vedspandelete(indent, indent+startlen+1, false);
        ved_al();           ;;; remove indentation
        vedhtmlinsert("r", vedhtmllistentry)
    enddefine;

    define lconstant markthislist(startitem, lend);
        VED_DLOCAL_POS
        dlocal 0 % vedmarkpush(), vedmarkpop() %;
        vedmarklo();
        vedjumpto(lend, 1);
        vedmarkhi();
        vedhtmlinsert("r",
            if startitem.ispair or startitem.isinteger then
                vedhtmlnumlist
            elseif startitem then
                vedhtmlsymlist
            else
                vedhtmllistentry        ;;; for wrapping sublist
            endif)
    enddefine;

    define lconstant nextpara -> (lastline, found);
        ;;; Jumps to start of next para; returns last line of this one
        paraend();
        vedline -> lastline;
        vedchardown();
        parastart() -> found
    enddefine;

    lvars indent, startitem, startlen, more;

    if indent1 and startlen1 then           ;;; at first para in sublist
        (indent1, startitem1, startlen1) -> (indent, startitem, startlen);
        nextpara() -> (lend, more);
        if more then
            marklist(indent, startitem, false) or lend -> lend
        endif;
        restoreline();
        markthispara(indent, startlen);
        markthislist(startitem, lend);

    elseif indent1 then                     ;;; in a list already
        testlistline(indent1, startitem1) -> (indent, startitem, startlen);
        if indent == true then          ;;; current para is a continuation
            nextpara() -> (lend, more);
            if more then
                marklist(indent1, startitem, false) or lend -> lend
            endif;
            restoreline();
            markthispara(indent1, startlen);
        elseif indent then              ;;; current para starts a sublist
            marklist(indent, startitem, startlen) -> lend;
            restoreline();
            markthislist(false, lend);  ;;; wrap whole sublist as entry
            vedjumpto(lend, 1);
            nextpara() -> (lend, more);
            if more then
                marklist(indent1, startitem1, false) or lend -> lend
            endif;
        else
            false -> lend
        endif

    else                    ;;; may be at start of a list
        listline() -> (indent, startitem, startlen);
        if indent then
            nextpara() -> (lend, more);
            ;;; next line different to above as lone list-type para not
            ;;; a list
            more and marklist(indent, startitem, false) -> lend;
            if lend then
                restoreline();
                markthispara(indent, startlen);
                markthislist(startitem, lend);
            endif
        else
            false -> lend
        endif
    endif;

    restoreline();
enddefine;

define lconstant vedhtmlmarklists;
    ;;; Put list element tags round things that look like lists.

    define dlocal vedinparagraph;
        lconstant lline = listline <> erase <> erase;
        (lline() and 1) or vedhtmlinparagraph()
    enddefine;

    lvars lend;
    vedtopfile();
    while parastart() do
        if marklist(false, false, false) ->> lend then
            vedjumpto(lend+1, 1)
        else
            paraend();
            vedchardown()
        endif
    endwhile
enddefine;

/*

10.6  Paragraph separation
--------------------------
*/

define lconstant identifierline(str) /* -> bool */;
    ;;; Tries to recognise ref-file style identifier lines
    lvars c, l, b;
    (length(str) ->> l) > 4
and last(str) == `]`                        ;;; ends with [ ... ]
and ((vedhtmlchartype(str(1)) ->> c) == `a` ;;; starts in col 1 with
    or c == `+`                             ;;; with an identifier of
    or c == `_`)                            ;;; some sort
and (locchar_back(`[`, l, str) ->> b)       ;;; has a [
and (issubstring('constant', b, str)        ;;; and has a suitable word
    or issubstring('procedure', b, str)     ;;; between the brackets
    or issubstring('operator', b, str)
    or issubstring('variable', b, str)
    or issubstring('syntax', b, str)
    or issubstring('macro', b, str)
    or issubstring('datatype', b, str)
    or issubstring('property', b, str))
enddefine;

define lconstant vedhtmlsplitidlines;
    ;;; Puts a blank line below each ref-file identifier line. Best
    ;;; done before inserting attribute tags.
    lvars onidline;
    vedtopfile();
    until vedatend() do
        until (identifierline(vedthisline()) ->> onidline) or vedatend() do
            vedchardown()
        enduntil;
        if onidline then
            repeat
                vedchardown();
                vedtextleft();
                if vedcolumn == 1 then
                    vedlineabove();
                    vedchardown()
                endif;
            quitif (vedcolumn == 9) endrepeat;        ;;; go to following text
            vedlineabove()
        endif
    enduntil
enddefine;

define vars vedhtmlparatype(l0, l1) -> tag;
    ;;; Returns a tag for the type of the paragraph from lines l0 to l1.
    VED_DLOCAL_POS
    l0 -> vedline;
    if vedhtmlatsep() then
        false -> tag            ;;; already separated
    else
        vedtextleft();
        lvars c, c0 = vedcolumn;
        if c0 == 1 then
            if (vedcurrentchar() ->> c) == `\Sf` then
                vedhtmlformatpara
            elseif c == `\Sp` then
                vedhtmlpromptpara
            else
                vedhtmlnormpara
            endif
        else
            vedhtml1linepara
        endif -> tag;
        for vedline from l0 + 1 to l1 do
            vedtextleft();
            if vedcolumn /== c0 then
                vedhtmlraggedpara -> tag;
                quitloop
            elseif vedcolumn > 1 then
                vedhtmlindentpara -> tag
            endif
        endfor
    endif
enddefine;

define lconstant vedhtmlinsertseps;
    ;;; Insert separators to break up text into paragraphs. Do after
    ;;; inserting attribute tags.
    ;;; Uses vedhtmlparatype to decide which tag to insert.
    vedtopfile();
    while parastart() do
        lvars l0 = vedline;
        paraend();
        lvars l1 = vedline;
        lvars tag = vedhtmlparatype(l0, l1);
        vedtextleft();
        if tag then
            vedhtmlinsert("p", tag);
            if htmlhascloser(tag) then
                vedhtmlcloser(tag) -> ( , , , l1, );
                vedjumpto(l1+1, 1)
            else
                vednextline()
            endif
        else
            vednextline()
        endif
    endwhile
enddefine;

/*

10.7  Wrappers
--------------
*/

define lconstant vedhtmlwrappers(title, authors, heading);
    ;;; Put in body, head and html wrappers
    heading or title -> heading;    ;;; use heading if no title
    vedtopfile();
    if heading then
        vedlineabove();
        heading -> vedthisline();
        vedhtmlinsert("l", vedhtmlmainhead);
        vedchardown();
    endif;
    if authors then
        vedlineabove();
        authors -> vedthisline();
        vedhtmlinsert("l", vedhtmlauthors);
        vedchardown();
    endif;
    if (heading or authors) and vedhtmlmainheadsep then
        vedlineabove();
        vedhtmlinsert(".", vedhtmlmainheadsep)
    endif;
    vedhtmlinsert("f", "BODY");
    vedtopfile();
    vedlineabove();
    if title then title -> vedthisline() endif;
    vedhtmlinsert("l", "TITLE");
    vedhtmlinsert("e", "HEAD");
    vedhtmlinsert("f", "HTML")
enddefine;

/*

10.8  Graphics characters and special spaces
--------------------------------------------
*/

define vedhtmlgraphchars;
    ;;; Replace graphics characters and special spaces with their
    ;;; nearest ASCII equivalents.  Could do this on writing more
    ;;; easily but logically part of preparation procedure.
    dlocal vedscreengraphtrans;
    vednographics();        ;;; set vedscreengraphtrans to default
    lvars c;
    for vedline from 1 to vvedbuffersize do
        vedsetlinesize();
        for vedcolumn from 1 to vvedlinesize do
            if vedhtmlchartype(vedcurrentchar() ->> c) == `\s` then
                `\s` -> vedcurrentchar()
            elseif c fi_>= 16:80 then
                if c fi_<= 16:9C and c /== 16:80 then
                    vedscreengraphtrans(c) -> (vedcurrentchar(), )
                else
                    `\s` -> vedcurrentchar()
                endif
            endif
        endfor
    endfor
enddefine;

/*

10.9  Overall preprocessing
---------------------------
*/

define lconstant vedhtmlprep(args);
    ;;; Runs each of the preprocessing actions in a sensible order.
    ;;; args is a list of strings. If empty everything is done,
    ;;; if it starts with 'not' then everything apart from the actions
    ;;; identified is done, otherwise only the actions identified are done.
    dlocal vedautowrite = false, vedediting = false;

    ;;; Sort out arguments
    lvars todo = [], nottodo = [];
    ncmaplist(args, consword) -> args;
    if args /== [] and hd(args) == "not" then
        tl(args) ->> nottodo -> args    ;;; reassign to args for check below
    else
        args -> todo
    endif;
    lvars doall = todo == [];

    ;;; check args were all legal
    lconstant ops = [titles htmlchars headers attributes lists
        paragraphs graphchars wrappers];
    lvars w;
    for w in args do
        unless lmember(w, ops) then
            vederror('Illegal prep option: ', sys_>< w)
        endunless
    endfor;

    define lconstant putmessage(str);
        dlocal vedediting = true;
        vedputmessage(str)
    enddefine;

    define lconstant macro allor word;
        ;;; (doall and not(lmember(word,nottodo))) or lmember(word,todo) then
        "(", "doall", "and",
        "not", "(", "lmember", "(", """, word, """, ",", "nottodo", ")", ")",
        ")", "or", "lmember", "(", """, word, """, ",", "todo", ")", "then"
    enddefine;

    ;;; Tags are inserted in various ways, so highlighting will not work
    false -> vedhtmlhighlight;

    ;;; These may need remembering between calls
    lconstant
        title = consref(false),
        authors = consref(false),
        heading = consref(false);

    ;;; Order of these matters
    if allor titles
        putmessage('Extracting titles');
        vedhtmldocheads() -> (cont(title), cont(authors), cont(heading))
    endif;
    if allor headers
        putmessage('Reindexing');
        lvars indexline = reindexify();
    endif;
    if allor htmlchars
        putmessage('Replacing HTML special characters');
        vedhtmlspecchars()
    endif;
    if allor headers
        putmessage('Doing headers and index');
        vedhtmlfixindex(indexline)
    endif;
    if allor paragraphs
        putmessage('Separating out REF-file identifier lines');
        vedhtmlsplitidlines()
    endif;
    if allor attributes
        putmessage('Tagging characters with ved attributes');
        vedhtmlattribs()
    endif;
    if allor lists
        putmessage('Doing lists');
        vedhtmlmarklists()
    endif;
    if allor paragraphs
        putmessage('Inserting paragraph separators');
        vedhtmlinsertseps()
    endif;
    if allor graphchars
        putmessage('Replacing graphics and special space characters');
        vedhtmlgraphchars()
    endif;
    if allor wrappers
        putmessage('Inserting overall wrappers');
        vedhtmlwrappers(cont(title), cont(authors), cont(heading))
    endif;

    vedtopfile();       ;;; might as well end up here
    putmessage('HTML preprocessing done');
    true -> vedediting;
    vedrefresh();
enddefine;

/*

-----------------------------------------------------------------------
11  Entry points
-----------------------------------------------------------------------
*/

;;; Next macro needs to be in every entry point

lconstant macro TOP_LEVEL_DLOCAL =
    [ dlocal
        ved_search_state,
        vedbreak = false,
        vvedpromptchar = false,
        vedleftmargin = 0,
        vedinparagraph = vedhtmlinparagraph,
        vedchartype_orig = vedchartype,
        vedchartype = vedhtmlchartype; ];

/*

11.1  Keyboard string interface
-------------------------------
*/

define lconstant vedhtmlkeyaction;
    ;;; To be called when vedhtmlkeys typed.
    TOP_LEVEL_DLOCAL

    ;;; x scope does not work when vedinascii called
    lconstant xscopeerr = 'Use <ENTER> html commands for x scope';

    lconstant
        deletecmd = consword(`\^?`, 1),
        prompt = 'Enter scope from ' sys_>< vedhtmlscopechars
            sys_>< ', or <DEL> or one of DUS',
        Dprompt = 'Enter scope to delete from ' sys_>< vedhtmlscopechars,
        Sprompt = 'Enter scope to splice round from ' sys_>< vedhtmlscopechars;
    lvars cmd = consword(vedinascii_withprompt(prompt), 1);

    if cmd == deletecmd then
        vedputmessage('Deleted tag ' sys_>< vedhtmldel(false, false))
    elseif cmd == "D" then
        lvars scope = consword(vedinascii_withprompt(Dprompt), 1);
        if scope == "x" then vederror(xscopeerr) endif;
        vedhtmldeletescope(scope)
    elseif cmd == "U" then
        vedhtmlundo()
    elseif cmd == "S" then
        lvars scope = consword(vedinascii_withprompt(Sprompt), 1);
        if scope == "x" then vederror(xscopeerr) endif;
        vedhtmlsplice(scope)
    elseif cmd == "x" then
        vederror(xscopeerr)
    else
        vedhtmlkeyinsert(cmd)
    endif
enddefine;

lvars htmlkeys = false;

define active vedhtmlkeys;
    ;;; Returns string value; on update stores string and does vedsetkey
    ;;; to make string initiate vedhtmlkeyaction. Initialised at end of file.
    htmlkeys
enddefine;

define updaterof active vedhtmlkeys(s);
    if htmlkeys.isstring then
        vedsetkey(htmlkeys, undef)
    endif;
    s -> htmlkeys;
    if s then
        vedsetkey(s, vedhtmlkeyaction)
    endif
enddefine;

/*

11.2  Command line interface
----------------------------
*/

define lconstant tagfromargs(arglist) -> tag;
    ;;; tag from string or from string in hd of list
    if arglist.islist then hd(arglist) -> arglist endif;
    lvars tagreader = stringin(arglist);
    if vedhtmluppercase then tagreader <> lowertoupper -> tagreader endif;
    tagabbrevs(tagreader) -> tag;
    unless tag then
        vederror('Unrecognised tag: ' sys_>< arglist)
    endunless
enddefine;

define lconstant vedhtmlkeystring /* -> str */;
    ;;; Stripped down vedinkeys. Prints message and returns
    ;;; keys typed up to 3 ESCs.
    vedputmessage(
        'Type keyboard sequence for html, then <ESC> 3 times');
    lvars x, z;
    consstring( #|
            repeat
                vedinascii() -> z;
                if z == `\e` then   ;;; esc typed
                    vedinascii() -> x;
                    if x == z then      ;;; second esc typed
                        vedinascii() -> x;
                    quitif (x == z);     ;;; quit if third esc typed
                        z; z; x
                    else
                        z; x
                    endif
                else
                    z
                endif
            endrepeat
        |#);
    vedputmessage(nullstring)
enddefine;

define ved_html;
    ;;; Command line driver procedure.
    TOP_LEVEL_DLOCAL

    lvars
        args = sysparse_string(vedargument, true),
        key = args /== [] and consword(dest(args) -> args);

    if key == "prep" then
        vedhtmlprep(args)
    elseif key == "keys" then
        vedhtmlkeystring() -> vedhtmlkeys
    elseif key == "del" then
        if args == [] then
            vedhtmldel(false, false)
        else
            vedhtmldeletescope(consword(hd(args)))
        endif
    elseif key == "undo" then
        vedhtmlundo()
    elseif key == "splice" then
        if args == [] then
            vederror('Need scope for splicing round after "splice"')
        else
            vedhtmlsplice(consword(hd(args)))
        endif
    elseif key == "show" then
        vedhtmlshowtags()
    elseif key == "write" then
        vedwriteplain(args /== [] and hd(args))
    elseif key == "printtags" then
        vedhtmlprinttags()
    elseif key == "abbrevs" then
        vedhtmlprinttagnames()
    elseif key == "readtags" then
        vedhtmlreadtags(args /== [] and hd(args) or vedhtmltagfile)
    elseif key == "pclosers" then
        vedhtmlswitchPclosers(args)
    elseif args /== [] then
        vedhtmlinsert(key, tagfromargs(args))
    elseif key then
        vederror('ved_html command not recognised: ' sys_>< key)
    else
        vedputmessage('ved_html loaded')
    endif
enddefine;

/*

-----------------------------------------------------------------------
12  Customisation
-----------------------------------------------------------------------
*/

;;; Do this at end so that variables can be updated

trycompile('$poplib/ved_html_init.p') -> ;

;;; Set up keyboard string if not done from init file.

unless vedhtmlkeys then '\e\eh' -> vedhtmlkeys endunless;

/*

-----------------------------------------------------------------------
13  Set up the tag list
-----------------------------------------------------------------------
*/

;;; Needs to come after the customisation in case the name of
;;; the tag file has been changed

lvars Pclosers = vedhtmlPclosers;       ;;; record Pcloser state

#_IF sys_file_exists(vedhtmltagfile)

    vedhtmlreadtags(vedhtmltagfile);

#_ELSE

/* Adapted from the w3 list at
http://www.w3.org/TR/REC-html40/index/elements.html

hascloser is set for all elements for which an ending tag is not forbidden
separates is set for all %block elements plus others which I think are
  structural, plus list elements
keepspaces is set for PRE, also for CODE and SAMP which may be wrong
  as they are not block elements - see how it works out

     tag_name   qualities               attributes   */
[   {!--        []                      '^ --'}
    {A          [hascloser]             'HREF="^*"'}
    {ABBR       [hascloser]             N}
    {ACRONYM    [hascloser]             N}
    {ADDRESS    [hascloser separates]   N}
    {APPLET     [hascloser]             'CODE="^" WIDTH="" HEIGHT=""'}
    {AREA       []                      'COORDS="^" ALT=""'}
    {B          [hascloser]             N}
    {BASE       []                      'HREF="^*"'}
    {BASEFONT   []                      'SIZE=^'}
    {BDO        [hascloser]             'DIR=^'}
    {BIG        [hascloser]             N}
    {BLOCKQUOTE [hascloser separates]   N}
    {BODY       [hascloser separates]   N}
    {BR         []                      N}
    {BUTTON     [hascloser]             N}
    {CAPTION    [hascloser separates]   N}
    {CENTER     [hascloser separates]   N}
    {CITE       [hascloser]             N}
    {CODE       [hascloser keepspaces]  N}
    {COL        []                      N}
    {COLGROUP   [hascloser]             N}
    {DD         [hascloser separates]   N}
    {DEL        [hascloser]             N}
    {DFN        [hascloser]             N}
    {DIR        [hascloser separates]   N}
    {DIV        [hascloser separates]   N}
    {DL         [hascloser separates]   N}
    {DT         [hascloser separates]   N}
    {EM         [hascloser]             N}
    {FIELDSET   [hascloser separates]   N}
    {FONT       [hascloser]             'SIZE=^'}
    {FORM       [hascloser separates]   'ACTION="^*"'}
    {FRAME      []                      N}
    {FRAMESET   [hascloser separates]   N}
    {H1         [hascloser separates]   N}
    {H2         [hascloser separates]   N}
    {H3         [hascloser separates]   N}
    {H4         [hascloser separates]   N}
    {H5         [hascloser separates]   N}
    {H6         [hascloser separates]   N}
    {HEAD       [hascloser separates]   N}
    {HR         [separates]             N}
    {HTML       [hascloser separates]   N}
    {I          [hascloser]             N}
    {IFRAME     [hascloser]             N}
    {IMG        []                      'SRC="^" ALT=""'}
    {INPUT      []                      N}
    {INS        [hascloser]             N}
    {ISINDEX    [separates]             N}
    {KBD        [hascloser]             N}
    {LABEL      [hascloser]             N}
    {LEGEND     [hascloser]             N}
    {LI         [hascloser separates]   N}
    {LINK       []                      'HREF="^*"'}
    {MAP        [hascloser]             'NAME="^"'}
    {MENU       [hascloser separates]   N}
    {META       []                      'CONTENT="^"'}
    {NOFRAMES   [hascloser separates]   N}
    {NOSCRIPT   [hascloser separates]   N}
    {OBJECT     [hascloser]             N}
    {OL         [hascloser separates]   N}
    {OPTGROUP   [hascloser]             N}
    {OPTION     [hascloser]             N}
    {P          [hascloser separates]   N}
    {PARAM      []                      'NAME="^" VALUE=""'}
    {PRE        [hascloser separates keepspaces]   N}
    {Q          [hascloser]             N}
    {S          [hascloser]             N}
    {SAMP       [hascloser keepspaces]  N}
    {SCRIPT     [hascloser]             'TYPE="^" SRC=""'}
    {SELECT     [hascloser]             'NAME="^"'}
    {SMALL      [hascloser]             N}
    {SPAN       [hascloser]             N}
    {STRIKE     [hascloser]             N}
    {STRONG     [hascloser]             N}
    {STYLE      [hascloser separates]   'TYPE="^"'}
    {SUB        [hascloser]             N}
    {SUP        [hascloser]             N}
    {TABLE      [hascloser separates]   N}
    {TBODY      [hascloser separates]   N}
    {TD         [hascloser]             N}
    {TEXTAREA   [hascloser]             'NAME="^" ROWS="" COLS=""'}
    {TFOOT      [hascloser separates]   N}
    {TH         [hascloser]             N}
    {THEAD      [hascloser separates]   N}
    {TITLE      [hascloser separates]   N}
    {TR         [hascloser]             N}
    {TT         [hascloser]             N}
    {U          [hascloser]             N}
    {UL         [hascloser separates]   N}
    {VAR        [hascloser]             N}
] -> vedhtmltags;

#_ENDIF

if Pclosers /== undef then
    Pclosers -> vedhtmlPclosers;        ;;; restore P closer state
endif;

endsection;


/* --- Revision History ---------------------------------------------------
--- David Young, Jun  4 2001
        Changed vedhtmlauthors from AU (obsolete) to H2.
--- David Young, Oct 21 1999
        Updated default tag list to HTML 4.0
--- David S Young, Jan 21 1999
        - Added "!" to vedhtmltagchars and modified vedhtmltagname so that
        comments are seen as valid tags.
        - Changed test in parascope so that cursor can be after end of
        text on last line of paragraph.
--- David S Young, Sep 20 1997
        Added delete option to vedhtmlinsertkey.
--- David S Young, Sep 18 1997
        Erroneous lconstant removed from vedhtmltags definition.
--- David S Young, Sep 16 1997
        - Added URL scope and made leading URLs move into attributes
        when tags such as <A> inserted.
        - Added scope highlighting during tag insertion.
        - Added "html show" and "html write" commands.
        - Added options to "html prep" command.
        - Changed escape sequences: all now start with the same string
        to allow more commands. This changes the sequences for deletion.
        Sequences for undo and splice added. ikeys, dkeys and Dkeys
        commands all replaced by single keys command.
        - Some reordering and tidying of procedures.
--- David S Young, Sep 10 1997
        Switched off vedediting in setattribs and restoretext.
--- David S Young, Sep  9 1997
        Added scope highlighting during keyboard insertion.
        Some consequent reordering of procedures.
        Removed position restore and vedrefresh from vedhtmlattribs.
--- David S Young, Sep  4 1997
        Changed vedhtmlfixindex to leave blank lines under headings when
        deleting underlining to maintain paragraph separation.
 */