/*
** $VER: arx_help.ced 2.9 (8.8.96) Rolf Rotvel
**
** Uses amigaguide.library & rexxtricks.library
**
** Save directory for converted ArexxGuide nodes 
** To disable saving of converted nodes specify an empty string
*/

ascdir = 'txt:ArexxGuide.asc'

/*
** End of cfg.
*/

signal on syntax
options results

call addlib('rexxsupport.library', 0, -30, 0)
call addlib('amigaguide.library', 0, -30, 0)
call addlib('rexxtricks.library', 0, -30, 0)

forceagcmd? = 0
if upper(arg(1)) = 'FORCEAGCMD' then forceagcmd? = 1
if ascdir ~= '' & exists(ascdir) then asc? = 1
else asc? = 0

/* Load the cross-ref file. Function returns quickly if the file is  */
/* already loaded, but -- like ADDLIB() it can return true even if   */
/* the file isn't available, so we check by looking for a known node */

call displaystatus('ARx_Help: Checking .xref files...')
call loadxref('ARx_Guide.xref')
if getxref('TRACEOPT1') = 10 then call cederror('Error loading .xref files!')

/* Add any extra files included in the env: variable */
extraxref = getenv('arexxguide/xrfiles')
do i = 1 for words(extraxref)
    /* 'Call' because we don't care about errors here */
    call loadxref(word(extraxref, i))
end

call displaystatus('ARexxGuide online help system...')

/* Get contents of current line stripped of tabs and eol */
hline = getcline()
hlinewds = words(hline)

select 
    when hlinewds = 0 then do
        lkup = getinput()
        if lkup = '' | lkup = 'RESULT' then signal cleanexit
        chklkup = strip(lkup, 'b', '·')
        if chklkup ~= lkup then call launchglossary(chklkup)
    end
    when hlinewds = 1 then do
        curpos = getcurpos()
        lkup = getcword(hline, curpos)
        chklkup = strip(lkup, 'b', '·')
        if chklkup ~= lkup then call launchglossary(chklkup)
    end
    otherwise do
        curpos = getcurpos()

        /* Cut a single clause out of preceding clauses */
        sempos = lastpos(';', hline, curpos) + 1
        /* This will break if a semicolon is used within a string */
        /* but checking for that seems like overkill.             */
        if sempos > 1 then do
            if sempos < curpos + 1 then do
                parse var hline =sempos hline ';'
                curpos = curpos - sempos + 1
            end
        end
        else parse var hline hline ';'  /* Cut it out of following clauses */

        /* The current keyword is used within mchar select clause */
        kwd = upper(word(hline, 1))
        lkup = getcword(hline, curpos)

        chklkup = strip(lkup, 'b', '·')
        if chklkup ~= lkup then call launchglossary(chklkup)

        spec_chars = '+-/*%|&^><=,;:~)("''?!.'
        if length(lkup) = 1 then mchar = pos(lkup, spec_chars)
        else mchar = pos(substr(hline, curpos, 1), spec_chars)

        lkup = getlkup()
    end
end

xrval = upper(getxref(lkup))

if find('10 NODE/K', xrval) > 0 then do
    if right(lkup, 2) = '()' then newlkup = left(lkup, length(lkup) - 2)
    else newlkup = lkup||'()'
    xrval = upper(getxref(newlkup))
    if find('10 NODE/K', xrval) > 0 then call notfound(lkup)
    else lkup = newlkup
end

/* Found a match. Now display it */

parse var xrval '"' node '"' '"' db '"'

if ~abbrev(db, 'ARX_') then src = 'Other ref:'
else src = 'ARexxGuide:'

dispstr = src||' '||lkup||' ['||word('Explanation Function Instruction', word(xrval, 3) + 1)||']'
call displaystatus(dispstr)

select
    when show('p','ARX_GUIDE') then do
        address 'ARX_GUIDE' 'link' lkup
    end
    when lkup = 'ARX_NDXCONT' | lkup = 'COMPCONT' | forceagcmd? then do
        agcmd = getenv('arexxguide/agcmd')
        if agcmd = '' then call cederror('Error loading AmigaGuide viewer')

        if abbrev(upper(agcmd), 'MULTI') then prtopt = ''
        else prtopt = 'portname ARX_GUIDE'

        address command 'run >nil: '||agcmd||' '||db||' document '||lkup||' '||prtopt||' requester'
    end
    otherwise do
        if asc? then showfile = makepath(ascdir, node)
        else showfile = 't:'||node

        if (asc? & ~exists(showfile)) | ~asc? then do
            nodetxt = getnode(node, db)
            nodetxt = stripag(nodetxt)
            call open('tmp', showfile, 'w')
            call writech('tmp', nodetxt)
            call close('tmp')
        end

        call showwin(showfile)
        if ~asc? then call delete(showfile)
    end
end


CLEANEXIT:
call editorexit
exit 0


/*
** Main functions/procedures
*/

GETLKUP: 
select
    when mchar = 0 then nop
    when mchar <= 5 then do
        select
            when mchar <= 2 then do   /* + or - */
                if kwd = 'PARSE' then lkup = 'PARSETMP5'
                else lkup = 'ARITHMETIC'
            end
            when mchar <= 4 then do   /* / or * */
                /* This picks up the three characters surrounding a '*' or '/' */
                comchar = substr(hline, max(1, curpos - 1), 3)
                if pos('/*', comchar) + pos('*/', comchar) > 0 then lkup = 'COMMENT'
                else lkup = 'ARITHMETIC'
            end
            otherwise lkup = 'ARITHMETIC'   /* % */
        end
    end
    when mchar <= 13 then do
        select
            when mchar <= 8 then do   /* | or & or ^ */
                /* This picks up the three characters surrounding token */
                comchar = substr(hline, max(1, curpos - 1), 3)
                if pos('||', comchar) > 0 then lkup = 'CONCATENATION'
                else lkup = 'LOGICAL'
            end
            when mchar <= 10 then lkup = 'COMPARISON'   /* < or > */
            when mchar = 11 then do   /* = */
                if kwd = 'PARSE' then lkup = 'PARSETMP5'
                else do
                    if symbol(strip(left(hline, max(1, curpos - 1)))) = 'BAD' then lkup = 'COMPARISON'
                    else lkup = 'ASSIGNMENT'
                end
            end
            when mchar = 12 then lkup = 'COMMA'   /* , */
            otherwise lkup = 'SEMICOLON'   /* ; */
        end
    end
    when mchar <= 19 then do
        select
            when mchar = 14 then lkup = 'LABEL'   /* : */
            when mchar = 15 then do   /* ~ */
                /* Is the next character a comparison operator? */
                if pos(substr(hline, curpos , 2), '~=~>~<') > 0 then lkup = 'COMPARISON'
                else lkup = 'LOGICAL'
            end
            when mchar <=17 then do   /* ) or ( */
                if kwd = 'PARSE' then lkup = 'PARSETMP5'
                else lkup = 'PAREN'
            end
            otherwise lkup = 'STRING'   /* " or ' */
        end
    end
    otherwise do
        select
            when mchar = 20 then do   /* ? */
                if kwd = 'TRACE' then lkup = 'TRACEOPT1'
                else lkup = '?'
            end
            when mchar = 21 then do   /* ! */
                if kwd = 'TRACE' then lkup = 'TRACEOPT2'
                else lkup = '!'
            end
            when mchar = 22 then do   /* . -- dot  */
                /* Get the surrounding ARexx token */
                stpos = verify(' '||hline, '+-|/&=~\><^,;:()"'' ', 'm', lastpos(' ', ' '||hline, curpos))
                token = substr(hline, stpos, verify(hline||' ', '+-|/&=~\><^,;:()"'' ', 'm', curpos) - stpos)
                select
                    when token = '.' then do
                        if kwd = 'PARSE' then lkup = 'PARSETMP2'
                        else lkup = token
                    end
                    when datatype(token, 'n') then lkup = 'NUMBER'
                    when datatype(token, 's') then do
                        if datatype(left(token, 1), 'm') | verify(token, '!@#$', 'm') = 1 then lkup = 'COMPVAR'
                    end
                    otherwise lkup = token
                end
            end
            otherwise exit 10
        end
    end
end

/* Check for special words like `command' in `address command' */
/* and most of the subkeywords in instructions like DO.        */
if word(hline, 1) ~= lkup then do checkopt = 1 for 1    /* Let's us leave */
    if getxref(lkup) = 10 | find('ARG PULL UPPER COMMAND', upper(lkup)) > 0 then do
        if word(getxref(kwd), 3) = 2 then select
            when kwd = 'DO' then do
                specword = find('UNTIL WHILE TO FOR BY FOREVER ', upper(lkup))
                if specword > 0 then lkup = word('DOOPT4 DOOPT4 DOOPT2 DOOPT3 DOOPT2 DOOPT5', specword)
            end
            when kwd = 'PARSE' then do
                specword = find('ARG PULL EXTERNAL NUMERIC SOURCE VERSION VALUE VAR WITH', upper(lkup))
                if specword > 0 then do
                    lkup = 'PARSESRC'||specword
                    if specword = 9 then lkup = 'PARSESRC7'
                end
                else lkup = 'PARSETMP1'
            end
            when kwd = 'OPTIONS' then do
                if find('RESULTS PROMPT FAILAT CACHE ON OFF', upper(lkup)) > 0 then lkup = kwd
            end
            when kwd = 'TRACE' then do
                if verify(upper(right(lkup, 1)), 'IRACLENOBS') = 0 then lkup = 'TRACEOPT'
            end
            when kwd = 'SIGNAL' then do
                if find('ON OFF', upper(lkup)) > 0 then lkup = 'SIGTRAP'
                else do
                    if pos('BREAK_', upper(lkup)) = 1 then lkup = 'BREAK_'
                    else lkup = 'SIGTRAN'
                end
            end
            when upper(lkup) = 'UPPER' then do
                if kwd ~= 'UPPER' then lkup = 'UPPER()'
            end
            when kwd = 'ADDRESS' then do
                if abbrev(word(hline, 2), lkup) then do
                    lkup = kwd
                    leave checkopt   /* So we don't get address() */
                end
            end
            otherwise nop
        end
        if getxref(lkup||'()') ~= 10 then lkup = lkup||'()'
    end
end
return lkup


GETNODE: procedure expose dispstr
parse arg lkup, db

call displaystatus(dispstr||' searching...')

agpathlist = getenv('amigaguide/path')

do words(agpathlist)
    parse var agpathlist agdir agpathlist
    agpath = makepath(agdir, db)
    if exists(agpath) then leave
end

if ~exists(agpath) then call cederror('Couldn''t find '||agpath)

if right(lkup, 2) = '()' then do
    parse var lkup ag '()'
    ag = ag||"'(')"
end
else ag = lkup

/* '#?' checks for quotes around node title */
startbyte = searchpattern(agpath, '@node #?'||ag||'#?',, 'b')
if startbyte = -1 then do
    okay1 'Guide and xref file doesn''t match!'||'0a'x||'Couldn''t find "'||lkup||'"'
    call notfound(lkup)
end
endbyte = searchpattern(agpath, '@endnode', startbyte, 'b')

call open('ag', agpath, 'r')
call seek('ag', startbyte, 'b')
nodetxt = readch('ag', endbyte - startbyte)
call close('ag')

return nodetxt


STRIPAG: procedure expose dispstr
parse arg nodetxt

call displaystatus(dispstr||' converting...')

nodeasc = ''
nl = '0a'x

do forever
    parse var nodetxt line (nl) nodetxt
    if nodetxt = '' then leave
    linkpos = pos('@{', line)
    gnyfpos = pos('@', line)
    select 
        when gnyfpos = 1 & linkpos = 0 then nop     /* Filter out '@' commands */
        when line = '' then do
            /* Filter out empty lines before start of actual nodetxt */
            if nodeasc ~= '' then nodeasc = nodeasc||line||nl
        end
        when linkpos > 0 then do 
            do until pos('@{', line) = 0 
                parse var line start '@{' rest
                if pos('"', rest) = 1 then do    /* Real link */
                    parse var rest '"' button '"' rest
                    wd = upper(word(rest, 1))
                    parse var rest . link '}' end
                    select      
                        when wd = 'LINK' then do
                            button = strip(button)
                            link = dequote(word(filepart(link), 1))
                            if getxref(link) ~= 10 then do 
                                chkbut = upper(strip(translate(button, '', '><')))
                                chklnk = upper(link)
                                if chkbut = chklnk | chkbut||'()' = chklnk then button = '{'||button||'}'
                                else button = button||'{'||link||'}'
                            end
                        end
                        when wd = 'RX' then do
                            button = strip(button, 'b', ' ·')
                            parse upper var link '"' chk link '"'
                            link = strip(link)
                            if pos('ARX_GLOSSARY.REXX', chk) > 0 then do
                                chg? = 0
                                do w = 1 to words(button)
                                    wd = word(button, w)
                                    chkwd = strip(translate(wd, '', '><'))
                                    if upper(chkwd) = link then do
                                        parse var button but1 (wd) but2
                                        button = but1||'{·'||chkwd||'·}'||but2
                                        chg? = 1
                                        leave
                                    end
                                end                                
                                if ~chg? then button = button||'{·'||link||'·}'
                            end
                        end
                        otherwise button = strip(button)
                    end
                end
                else do     /* ANSI control character */
                    parse var rest '}' end
                    button = ''
                end
                line = start||button||end
            end
            nodeasc = nodeasc||line||nl
        end
        otherwise nodeasc = nodeasc||line||nl
    end
end
return nodeasc


LAUNCHGLOSSARY: procedure expose asc? ascdir
parse arg chklkup
lkup = upper(chklkup)

dispstr = 'ArexxGuide glossary: '||lkup

if asc? then showfile = makepath(ascdir, 'glossary.'||lkup)
else showfile = 't:glossary.'||lkup

if (asc? & ~exists(showfile)) | ~asc? then do
    call displaystatus(dispstr||' searching...')
    grx = 'rexx:arx_glossaryport.rexx'
    if ~readfile(grx, gstem) then call cederror('Couldn''t find '||grx)
    num = lsearch('glossary.'||chklkup||'#?', gstem, 147,, 'p')
    if num = -1 then call cederror('Glossary error!')
    glossary = ''
    nl = '0a'x
    do forever
        num = num + 1   /* Skip first line */
        select
            when gstem.num = '' then leave
            when left(gstem.num, 1) = "'" then do
                glossary = glossary||substr(gstem.num, 2, lastpos("'", gstem.num) - 2)||nl
            end
            otherwise do
                parse upper var gstem.num . 'LINK' chk 
                if chk ~= '' then do
                    parse var chk "/" link "'" 
                    if getxref(link) ~= 10 then glossary = glossary||'{'||link||'} '
                end
            end
        end
    end
    call open('tmp', showfile, 'w')
    call writech('tmp', glossary||nl)
    call close('tmp')
end

call displaystatus(dispstr||' loading...')
/* Always show glossary files in CED window */
call showwin(showfile)
if ~asc? then call delete(showfile)
signal cleanexit

/*
** Utility procedures
*/

DEQUOTE: procedure
str = arg(1)
parse var str '"' unq '"'
if unq = '' then return str
return unq


REPLACE: procedure
parse arg src, old, new
str = ''
do while src ~= ''
  chk = pos(old, src)
  parse var src pre (old) src
  str = str||pre
  if chk > 0 then str = str||new
end
return str

/*
** CED specific routines
*/

SHOWWIN: procedure expose dispstr
parse arg showfile

call displaystatus(dispstr||' loading...')

helpfile = getclip('ced.helpwindow')
'status restname'
if helpfile ~= result then do
    'status totalnumviews'
    do numwins = result - 1 to 1 by -1 until result = helpfile
        'next view'
        'status restname'
    end
end
if result ~= helpfile then do
    'next view'
    'open new'
end
else do
    'status numchanges'
    if result ~= 0 then do
        'next view'
        'open new'
    end
end

'open' showfile

'status restname'
call setclip('ced.helpwindow', result)

return


GETCLINE: procedure
'status linebuffer' ; line = strip(result, 't', '0a'x)
tab = '09'x
if pos(tab, line) > 0 then do
    'status tabsize' ; tabsize = result
    line = replace(line, tab, copies(' ', tabsize))
end
return line


GETCURPOS: procedure
'status cursorcolumn'
return result + 1


GETCWORD: procedure
parse arg wds, cpos                         
'getword' ; word = result
if word = '0' then do   /* Cursor was on white space */
    'status linenumber' ; line = result + 1
    if cpos < wordindex(wds, 1) then 'next word'
    else 'prev word'                      /* Fall back on 'prev word' */
    'getword' ; word = result
    'jumpto' line cpos
end

if countchars('·', word) = 1 then do
    select
        when left(word, 1) = '·' then do
            parse var wds (word) more '·'
            word = word||more
        end
        when right(word, 1) = '·' then do
            parse var wds (word) more '·'
            word = word||more
        end
        otherwise nop
    end
end
if pos('(', wds) = pos(word, wds) + length(word) then word = word||'()'

return strip(word,, '0a'x)


NOTFOUND:
parse arg lkup
'okay2' '"'||lkup||'" not found.'||'0a'x||'Show ARexxGuide index?'
if result = 1 then call displayag('ARX_NDXCONT')   /* Display Index file */
signal cleanexit


DISPLAYSTATUS: procedure
'dm' '"'arg(1)'"'
return 0


EDITOREXIT: procedure
'dm'
return 0


CEDERROR: procedure
'okay1' arg(1)
signal cleanexit


GETINPUT: procedure
'getstring' '" "' '"Arexx help"'
return strip(upper(result))


SYNTAX:
/* Use while developing... */
err = rc ; line = sigl
if show('p', 'rexx_ced') then do
  address 'rexx_ced'
  'cedtofront'
  'jump to line' line
  if datatype(err, 'n') then 'okay1' 'Error '||err||': '||errortext(err)||'0a'x||'in line '||line
end
exit