/***********************************************************************
$VER: Upd8 1.0ß2 by Carl Licke / Turbid design ( http://come.to/turbid )
***********************************************************************/



/*** scheme ***/



SIGNAL ON halt
SIGNAL ON break_c
SIGNAL ON failure
SIGNAL ON ioerr
SIGNAL ON syntax

CALL init

CALL readprefsfile
CALL readlistfile

CALL main

CALL writelistfile

EXIT 0



/*** various ***/



init:
   version     ='1.0ß2'

   lf          =X2C('0A')
   cr          =X2C('0D')
   crlf        =X2C('0D0A')
   tab         =X2C('09')
   asterisk    =X2C('2A')
   off         =X2C('00000000')
   alllist.0   =0
   newlist.0   =0
   cyclegad.0  =2
   cyclegad.1  ='all'
   cyclegad.2  ='updated'
   alllistvalue=0
   newlistvalue=0

   PARSE SOURCE . . . src .
   progdir=LEFT(src,MAX(LASTPOS(':',src),LASTPOS('/',src)))

   IF ~SHOW('L','tritonrexx.library') THEN IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN DO
      SAY 'tritonrexx.library required.'
      CALL errorexit
   END

   taglist='TRCA_Name "Upd8"',
      'TRCA_LongName  "Upd8"',
      'TRCA_Info      "Detects updated webpages."',
      'TRCA_Version   "'version'"',
      'TRCA_Date      "8.8.1998"',
   'TAG_END'

   app=TR_CREATEAPP(taglist)
   IF app=off THEN CALL report(1,'Could not create application.')

   IF ~SHOW('L','rxsocket.library') THEN IF ~ADDLIB('rxsocket.library',0,-30,0) THEN CALL report(1,'rxsocket.library required.')
   IF ~SHOW('L','rexxsupport.library') THEN IF ~ADDLIB('rexxsupport.library',0,-30,0) THEN CALL report(1,'rexxsupport.library required.')

   taglist.main=WindowID(1),
      PubScreenName('Workbench'),
      WindowTitle('Upd8' version),
      'VertGroupA',
         'LineArray',
            'BeginLine',
               'SpaceS',
               TextNR('_list') 'TRAT_ID 101',
               'SpaceS',
               CycleGadget('cyclegad',0,101),
            'EndLine',
         'EndArray',
         'HorizGroupA',
            'VertGroupA',
               ListSS('alllist',102,0,0),
               'HorizGroupA',
                  Button('_verify',111),
                  Button('_add',105),
                  Button('_remove',106),
                  Button('_info',109),
                  Button('_browse',107),
                  ButtonR('_show',114),
               'EndGroup',
            'EndGroup',
         'EndGroup',
         'SpaceS',
         'HorizGroupA',
            'SpaceS',
            ClippedTextID('No locations verified.',110) 'TRAT_Flags TRTX_NOUNDERSCORE',
            'SpaceS',
         'EndGroup',
         'SpaceS',
         Progress(100,0,103),
         'HorizGroupA',
            Button('veri_fy all',104),
            Button('_prefs',112),
            ButtonE('_quit',108),
         'EndGroup',
      'EndGroup',
   'EndProject'

   taglist.add=WindowID(5),
      PubScreenName('Workbench'),
      WindowPosition('TRWP_CENTERDISPLAY'),
      WindowFlags('TRWF_ACTIVATESTRGAD'),
      WindowTitle('Upd8 - add location'),
      'VertGroupA',
         'SpaceS',
         'LineArray',
            'BeginLine',
               'SpaceS' TextNR('name') 'SpaceS',
               StringGadget('',511) 'SpaceS',
            'EndLine',
            'SpaceS',
            'BeginLine',
               'SpaceS' TextNR('URL') 'SpaceS',
               StringGadget('',512) 'SpaceS',
            'EndLine',
         'EndArray',
         'SpaceS',
         'HorizGroupA',
            ButtonR('a_dd',502),
            ButtonE('_abort',503),
         'EndGroup',
      'EndGroup',
   'EndProject'
RETURN 0



main:
   window.main =TR_OPENPROJECT(app,taglist.main)

   IF startcheck THEN CALL check
   CALL atalllist
   stoploop.main=0

   DO UNTIL stoploop.main
      CALL TR_WAIT(app,'')
      DO WHILE TR_HANDLEMSG(app,'event')
         SELECT
            WHEN event.trm_class='TRMS_ACTION' THEN SELECT
               WHEN event.trm_id=104 THEN CALL check
               WHEN event.trm_id=105 THEN CALL add
               WHEN event.trm_id=106 THEN CALL remove
               WHEN event.trm_id=107 THEN CALL browse
               WHEN event.trm_id=108 THEN stoploop.main=1
               WHEN event.trm_id=109 THEN CALL locationinfo
               WHEN event.trm_id=111 THEN CALL check(TR_GETATTRIBUTE(window.main,102,'TRAT_Value')+1)
               WHEN event.trm_id=114 THEN CALL showhtml
               WHEN event.trm_id=112 THEN CALL prefs
               OTHERWISE NOP
            END
            WHEN event.trm_class='TRMS_CLOSEWINDOW' THEN stoploop.main=1
            WHEN event.trm_class='TRMS_NEWVALUE' THEN DO
               IF event.trm_id=101 THEN DO
                  selected=TR_GETATTRIBUTE(window.main,102,'TRAT_Value')
                  IF event.trm_data=0 THEN DO
                     newlistvalue=selected
                     CALL atalllist
                     CALL TR_SETATTRIBUTE(window.main,102,'TRAT_Value',alllistvalue)
                  END
                  IF event.trm_data=1 THEN DO
                     alllistvalue=selected
                     CALL atnewlist
                     CALL TR_SETATTRIBUTE(window.main,102,'TRAT_Value',newlistvalue)
                  END
               END
               IF event.trm_id=102 THEN IF BITAND(D2X(event.trm_qualifier),X2C('0200'))=X2C('0200') THEN CALL showhtml
            END
            OTHERWISE NOP
         END
      END
   END

   CALL TR_DELETEAPP(app)
RETURN 0



atalllist:
   CALL TR_SETATTRIBUTE(window.main,102,'TROB_Listview','alllist')
   CALL TR_SETATTRIBUTE(window.main,105,'TRAT_Disabled',0)
   IF alllist.0=0 THEN DO
      CALL TR_SETATTRIBUTE(window.main,104,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,106,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,111,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,109,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,107,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,114,'TRAT_Disabled',1)
   END
   ELSE DO
      CALL TR_SETATTRIBUTE(window.main,104,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,106,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,111,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,109,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,107,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,114,'TRAT_Disabled',0)
   END
RETURN 0



atnewlist:
   CALL TR_SETATTRIBUTE(window.main,102,'TROB_Listview','newlist')
   IF newlist.0=0 THEN DO
      CALL TR_SETATTRIBUTE(window.main,106,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,109,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,107,'TRAT_Disabled',1)
      CALL TR_SETATTRIBUTE(window.main,114,'TRAT_Disabled',1)
   END
   ELSE DO
      CALL TR_SETATTRIBUTE(window.main,106,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,109,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,107,'TRAT_Disabled',0)
      CALL TR_SETATTRIBUTE(window.main,114,'TRAT_Disabled',0)
   END
   CALL TR_SETATTRIBUTE(window.main,105,'TRAT_Disabled',1)
   CALL TR_SETATTRIBUTE(window.main,111,'TRAT_Disabled',1)
RETURN 0



prefs:
   CALL TR_LOCKPROJECT(window.main)

   taglist=WindowID(2),
      PubScreenName('Workbench'),
      WindowPosition('TRWP_CENTERDISPLAY'),
      WindowTitle('Upd8 - preferences'),
      'VertGroupA',
         'SpaceS',
         'LineArray',
            'BeginLine',
               'SpaceS' TextNR('verify all at start') 'SpaceS',
               'HorizGroupSA' CheckBox(211) 'TRAT_Value' startcheck 'EndGroup',
            'EndLine',
            'SpaceS',
            'BeginLine',
               'SpaceS' TextNR('browser path') 'SpaceS',
               'HorizGroupA',
                  StringGadget(browser,212),
                  GetFileButton(214) 'SpaceS',
               'EndGroup',
            'EndLine',
            'SpaceS',
            'BeginLine',
               'SpaceS' TextNR('viewer textwidth') 'SpaceS',
               'HorizGroupA',
                  SliderGadget(1,256,textwidth,213) 'SpaceS',
                  Integer(textwidth) 'TRAT_ID 201 TRAT_MinWidth 3',
                  'SpaceS' TextNR('columns') 'SpaceS',
               'EndGroup',
            'EndLine',
            'SpaceS',
            'BeginLine',
               'SpaceS' TextNR('connection timeout') 'SpaceS',
               'HorizGroupA',
                  SliderGadget(0,256,timeout,215) 'SpaceS',
                  Integer(timeout) 'TRAT_ID 216 TRAT_MinWidth 3',
                  'SpaceS' TextNR('seconds') 'SpaceS',
               'EndGroup',
            'EndLine',
            'SpaceS',
            'BeginLine',
               'SpaceS' TextNR('size threshold') 'SpaceS',
               'HorizGroupA',
                  SliderGadget(0,256,threshold,217) 'SpaceS',
                  Integer(threshold) 'TRAT_ID 218 TRAT_MinWidth 3',
                  'SpaceS' TextNR('bytes') 'SpaceS',
               'EndGroup',
            'EndLine',
         'EndArray',
         'SpaceS',
         'HorizGroupA',
            ButtonR('_save',204),
            Button('_use',202),
            ButtonE('_abort',203),
         'EndGroup',
      'EndGroup',
   'EndProject'

   stoploop.prefs=0

   window.prefs=TR_OPENPROJECT(app,taglist)
   DO UNTIL stoploop.prefs
      CALL TR_WAIT(app,'')
      DO WHILE TR_HANDLEMSG(app,'event')
         IF event.trm_class='TRMS_CLOSEWINDOW' THEN stoploop.prefs=1
         IF event.trm_class='TRMS_NEWVALUE' THEN DO
            IF event.trm_id=213 THEN CALL TR_SETATTRIBUTE(window.prefs,201,'TRAT_Value',event.trm_data)
            IF event.trm_id=215 THEN CALL TR_SETATTRIBUTE(window.prefs,216,'TRAT_Value',event.trm_data)
            IF event.trm_id=217 THEN CALL TR_SETATTRIBUTE(window.prefs,218,'TRAT_Value',event.trm_data)
         END
         IF event.trm_class='TRMS_ACTION' THEN DO
            IF event.trm_id=203 THEN stoploop.prefs=1
            IF (event.trm_id=202 | event.trm_id=204) & ~stoploop.prefs THEN DO
               startcheck    =TR_GETATTRIBUTE(window.prefs,211,'TRAT_Value')
               browser       =TR_GETATTRIBUTE(window.prefs,212,'TROB_String')
               textwidth     =TR_GETATTRIBUTE(window.prefs,213,'TRAT_Value')
               timeout       =TR_GETATTRIBUTE(window.prefs,215,'TRAT_Value')
               threshold     =TR_GETATTRIBUTE(window.prefs,217,'TRAT_Value')
               stoploop.prefs=1
               IF event.trm_id=204 THEN DO
                  CALL writeprefsfile
                  CALL writelistfile
               END
            END
            IF event.trm_id=214 THEN DO
               IF ASL_REQUESTFILE(window.prefs,'browser',LoadFile('Upd8 - select browser executable','_Select',progdir,'')) THEN DO
                  browser=browser.1
                  CALL TR_SETATTRIBUTE(window.prefs,212,'TROB_String',browser)
               END
            END
         END
      END
   END
   CALL TR_CLOSEPROJECT(window.prefs)

   CALL TR_UNLOCKPROJECT(window.main)
RETURN 0



report:
   IF ARG(1,'E') THEN error=ARG(1)
   ELSE error=1

   IF ARG(2,'O') THEN SELECT
      WHEN reportcase='prefsfileerror'  THEN msg='Problem with prefsfile.'
      WHEN reportcase='listfileerror'   THEN msg='Problem with listfile.'
      OTHERWISE msg='Undefined error.'
   END
   ELSE msg=ARG(2)

   taglist=WindowID(6),
      PubScreenName('Workbench'),
      WindowPosition('TRWP_CENTERDISPLAY'),
      WindowTitle('Upd8 - message'),
      'VertGroupA',
         'HorizGroupA',
            'SpaceS',
            'VertGroupA',
               'SpaceS',
               TextN(msg) 'TRAT_Flags TRTX_NOUNDERSCORE',
               'SpaceS',
            'EndGroup',
            'SpaceS',
         'EndGroup',
         'HorizGroupA',
            ButtonRE('_close',601),
         'EndGroup',
      'EndGroup',
   'EndProject'

   CALL TR_AUTOREQUEST(app,off,taglist)

   IF error THEN CALL errorexit
RETURN 0



halt:
break_c:
   SAY 'line' sigl': interrupted'
   CALL writelistfile
   CALL TR_DELETEAPP(app)
EXIT 5



errorexit:
   CALL TR_DELETEAPP(app)
EXIT 10



failure:
ioerr:
syntax:
   SAY 'line' sigl':'lf||SOURCELINE(sigl)||lf||'error' rc':' ERRORTEXT(rc)||lf
   CALL TR_DELETEAPP(app)
EXIT 10



locationinfo:
   CALL getinfo

   taglist=WindowID(3),
      PubScreenName('Workbench'),
      WindowPosition('TRWP_CENTERDISPLAY'),
      WindowTitle('Upd8 - location info'),
      'VertGroupA',
         'SpaceS',
         'HorizGroupA',
            'SpaceS',
            'LineArray',
               'Beginline',
                  TextNR('name:'),
                  'SpaceS',
                  TextN(COMPRESS(SUBWORD(name,2),asterisk)) 'TRAT_Flags TRTX_NOUNDERSCORE',
               'EndLine',
               'BeginLine',
                  TextNR('URL:'),
                  'SpaceS',
                  TextN(url) 'TRAT_Flags TRTX_NOUNDERSCORE',
               'EndLine',
               'BeginLine',
                  TextNR('comparison method:'),
                  'SpaceS',
                  TextN(SUBSTR(name,2,4)),
               'EndLine',
               'BeginLine',
                  TextNR('comparison data:') 'TRAT_Flags TRTX_NOUNDERSCORE',
                  'SpaceS',
                  TextN(data),
               'EndLine',
            'EndArray',
            'SpaceS',
         'EndGroup',
         'SpaceS',
         ButtonRE('_close',301),
      'EndGroup',
   'EndProject'

   CALL TR_AUTOREQUEST(app,window.main,taglist)
RETURN 0



browse:
   IF ARG(1,'E') THEN url=ARG(1)
   ELSE CALL getinfo

   SELECT
      WHEN SHOW('P','IBROWSE.1') THEN ADDRESS 'IBROWSE.1' 'NEWWINDOW' url
      WHEN SHOW('P','IBROWSE') THEN ADDRESS 'IBROWSE' 'GOTOURL' url
      WHEN SHOW('P','AWEB.1') THEN ADDRESS 'AWEB.1' 'OPEN' url
      WHEN SHOW('P','AWebControlPort') THEN ADDRESS 'AWebControlPort' 'OPEN' url
      WHEN SHOW('P','VOYAGER') THEN ADDRESS 'VOYAGER' 'OPENURL' url 'NEW'
      OTHERWISE DO
         IF browser='' THEN CALL report(0,'No active browser found. Select browser executable.')
         ELSE DO
            IF EXISTS(browser) THEN ADDRESS COMMAND 'run >NIL:' browser url
            ELSE CALL report(0,'The file' browser 'does not exist.')
         END
      END
   END
RETURN 0



showhtml:
   CALL TR_LOCKPROJECT(window.main)

   button2   ='try _browse'
   button3   ='_abort'
   showpage  =1
   linelist.0=0

   taglist=WindowID(4),
      PubScreenName('Workbench'),
      WindowPosition('TRWP_CENTERDISPLAY'),
      WindowTitle('Upd8 - show location'),
      'VertGroupA',
         'HorizGroupA',
            FWListRO('linelist',401,0) 'TRAT_MinWidth' textwidth,
         'EndGroup',
         'SpaceS',
         'HorizGroupA',
            'SpaceS',
            ClippedTextID('Preparing...',402) 'TRAT_Flags TRTX_NOUNDERSCORE',
            'SpaceS',
         'EndGroup',
         'SpaceS',
         'LineArray',
            'BeginLine',
               'SpaceS',
               TextNR('URL'),
               'SpaceS',
               StringGadget('',403),
            'EndLine',
         'EndArray',
         'HorizGroupA',
            ButtonR('_get',407),
            Button('_abort',404),
            Button('_browse',406),
            ButtonE('_close',405),
         'EndGroup',
      'EndGroup',
   'EndProject'

   window.show=TR_OPENPROJECT(app,taglist)
   IF window.show=off THEN CALL report(0,'Could not open window. Try lower textwidth.')
   ELSE DO
      CALL getinfo
      CALL TR_SETATTRIBUTE(window.show,403,'TROB_String',url)

      CALL showhtmlbridge

      DO UNTIL stoploop.show
         CALL TR_WAIT(app,'')
         DO WHILE TR_HANDLEMSG(app,'event')
            IF event.trm_class='TRMS_CLOSEWINDOW' THEN stoploop.show=1
            IF event.trm_class='TRMS_ACTION' THEN DO
               IF event.trm_id=407 THEN DO
                  linelist.0=0
                  CALL TR_SETATTRIBUTE(window.show,401,'TROB_Listview','linelist')
                  url =TR_GETATTRIBUTE(window.show,403,'TROB_String')
                  name='(????) unknown'
                  CALL showhtmlbridge
               END
               IF event.trm_id=405 THEN stoploop.show=1
               IF event.trm_id=406 THEN CALL browse(TR_GETATTRIBUTE(window.show,403,'TROB_String'))
            END
         END
      END
      CALL TR_CLOSEPROJECT(window.show)
   END
   CALL TR_UNLOCKPROJECT(window.main)
RETURN 0



showhtmlbridge:
   infotextadd=''
   pagetitle  ='no title'
   CALL TR_SETATTRIBUTE(window.show,403,'TRAT_Disabled',1)
   CALL TR_SETATTRIBUTE(window.show,405,'TRAT_Disabled',1)
   CALL TR_SETATTRIBUTE(window.show,406,'TRAT_Disabled',1)
   CALL TR_SETATTRIBUTE(window.show,407,'TRAT_Disabled',1)
   CALL TR_SETATTRIBUTE(window.show,402,'TRAT_Text','Contacting host...')
   CALL TR_SETATTRIBUTE(window.show,404,'TRAT_Disabled',0)

   CALL getdata

   CALL TR_SETATTRIBUTE(window.show,403,'TROB_String',url)
   CALL TR_SETATTRIBUTE(window.show,403,'TRAT_Disabled',0)
   CALL TR_SETATTRIBUTE(window.show,405,'TRAT_Disabled',0)
   CALL TR_SETATTRIBUTE(window.show,406,'TRAT_Disabled',0)
   CALL TR_SETATTRIBUTE(window.show,407,'TRAT_Disabled',0)
   CALL TR_SETATTRIBUTE(window.show,404,'TRAT_Disabled',1)

   stoploop.show=0
   SELECT
      WHEN success THEN CALL TR_SETATTRIBUTE(window.show,402,'TRAT_Text',infotextadd'Now showing' COMPRESS(pagetitle,asterisk)'.')
      WHEN retry=3 THEN CALL TR_SETATTRIBUTE(window.show,402,'TRAT_Text','Could not get' url'.')
      WHEN retry=2 THEN DO
         CALL browse(url)
         CALL TR_SETATTRIBUTE(window.show,402,'TRAT_Text','Could not get' url'. Tried browse.')
      END
      OTHERWISE NOP
   END
RETURN 0



/*** internal list handling ***/



add:
   CALL TR_LOCKPROJECT(window.main)

   button2     ='a_dd anyway'
   button3     ='_abort'
   showpage    =0
   stoploop.add=0

   window.add  =TR_OPENPROJECT(app,taglist.add)
   DO UNTIL stoploop.add
      CALL TR_WAIT(app,'')
      DO WHILE TR_HANDLEMSG(app,'event')
         IF event.trm_class='TRMS_CLOSEWINDOW' THEN stoploop.add=1
         IF event.trm_class='TRMS_ACTION' THEN DO
            IF event.trm_id=503 THEN stoploop.add=1
            IF event.trm_id=502 THEN DO
               name        ='(????)' TR_GETATTRIBUTE(window.add,511,'TROB_String')
               url         =TR_GETATTRIBUTE(window.add,512,'TROB_String')
               inputurl    =url
               stoploop.add=1

               CALL TR_LOCKPROJECT(window.add)
               CALL getdata
               IF success | retry=2 THEN DO
                  IF retry=2 THEN data='not verified'
                  number=alllist.0+1

                  SELECT
                     WHEN data='not verified' THEN alllist.number=OVERLAY('(????)',name)
                     WHEN DATATYPE(data,'N')  THEN alllist.number=OVERLAY('(size)',name)
                     OTHERWISE alllist.number=OVERLAY('(date)',name)
                  END

                  alllist.number.urlstring =inputurl
                  alllist.number.datastring=data
                  alllist.0                =number
                  CALL atalllist
               END
               ELSE stoploop.add=0
               CALL TR_UNLOCKPROJECT(window.add)
            END
         END
      END
   END
   CALL TR_CLOSEPROJECT(window.add)

   CALL TR_UNLOCKPROJECT(window.main)
RETURN 0



remove:
   number=TR_GETATTRIBUTE(window.main,102,'TRAT_Value')+1

   IF alllist.0>0 THEN DO
      IF TR_GETATTRIBUTE(window.main,101,'TRAT_Value')=0 THEN DO
         DO i=number WHILE i<alllist.0
            o=i+1
            alllist.i           =alllist.o
            alllist.i.urlstring =alllist.o.urlstring
            alllist.i.datastring=alllist.o.datastring
         END
         alllist.0=alllist.0-1
         CALL atalllist
      END
      ELSE DO
         DO i=number WHILE i<newlist.0
            o=i+1
            newlist.i           =newlist.o
            newlist.i.urlstring =newlist.o.urlstring
            newlist.i.datastring=newlist.o.datastring
         END
         newlist.0=newlist.0-1
         CALL atnewlist
      END
   END
RETURN 0



getinfo:
   IF ARG(1,'E') THEN number=ARG(1)
   ELSE number=TR_GETATTRIBUTE(window.main,102,'TRAT_Value')+1

   IF TR_GETATTRIBUTE(window.main,101,'TRAT_Value')=0 THEN DO
      name=alllist.number
      url =alllist.number.urlstring
      data=alllist.number.datastring
   END
   ELSE DO
      name=newlist.number
      url =newlist.number.urlstring
      data=newlist.number.datastring
   END
RETURN 0



/*** listfile handling ***/



readlistfile:
   reportcase='listfileerror'
   IF EXISTS(progdir'Upd8.locations') THEN DO
      IF ~OPEN('listfile',progdir'Upd8.locations','R') THEN CALL report
      IF READLN('listfile')~=='Upd8 - locations' THEN CALL report

      count   =0
      newcount=0

      DO UNTIL EOF('listfile')
         temp=READLN('listfile')
         IF temp~='' THEN DO
            IF WORD(temp,1)='NAME' THEN DO
               count=count+1
               alllist.count=SUBWORD(temp,2)
               temp=READLN('listfile')
               IF WORD(temp,1)='URL' THEN DO
                  alllist.count.urlstring=SUBWORD(temp,2)
                  temp=READLN('listfile')
                  IF WORD(temp,1)='DATA' THEN DO
                     alllist.count.datastring=SUBWORD(temp,2)
                  END
                  ELSE CALL report
               END
               ELSE CALL report
            END
            ELSE IF WORD(temp,1)='NEW' THEN DO
               newcount=newcount+1
               newlist.newcount=SUBWORD(temp,2)
               temp=READLN('listfile')
               IF WORD(temp,1)='URL' THEN DO
                  newlist.newcount.urlstring=SUBWORD(temp,2)
                  temp=READLN('listfile')
                  IF WORD(temp,1)='DATA' THEN DO
                     newlist.newcount.datastring=SUBWORD(temp,2)
                  END
                  ELSE CALL report
               END
               ELSE CALL report
            END
            ELSE CALL report
         END
      END
      alllist.0=count
      newlist.0=newcount
      CALL CLOSE('listfile')
   END
   ELSE CALL defaultlist
RETURN 0



defaultlist:
   alllist.1           ='(size) Turbid design'
   alllist.1.urlstring ='http://home2.swipnet.se/~w-24653/index.html'
   alllist.1.datastring='not verified'
   alllist.2           ='(date) AWD - Amiga news'
   alllist.2.urlstring ='http://www.cucug.org/atnews.html'
   alllist.2.datastring='not verified'
   alllist.3           ='(date) recent Aminet uploads'
   alllist.3.urlstring ='http://wuarchive.wustl.edu/~aminet/recent.html'
   alllist.3.datastring='not verified'
   alllist.0           =3
RETURN 0



writelistfile:
   reportcase='listfileerror'
   IF ~OPEN('listfile',progdir'Upd8.locations','W') THEN CALL report
   bigstring='Upd8 - locations'lf
   delay=30
   DO i=1 TO alllist.0
      bigstring=bigstring||lf'NAME 'alllist.i||lf'URL  'alllist.i.urlstring||lf'DATA 'alllist.i.datastring||lf
      IF i>delay THEN DO
         CALL WRITECH('listfile',bigstring)
         bigstring=''
         delay=delay+30
      END
   END
   DO i=1 TO newlist.0
      bigstring=bigstring||lf'NEW  'newlist.i||lf'URL  'newlist.i.urlstring||lf'DATA 'newlist.i.datastring||lf
      IF i>delay THEN DO
         CALL WRITECH('listfile',bigstring)
         bigstring=''
         delay=delay+30
      END
   END
   CALL WRITECH('listfile',bigstring)
   CALL CLOSE('listfile')
RETURN 0



/*** prefsfile handling ***/



readprefsfile:
   reportcase='prefsfileerror'

   IF EXISTS(progdir'Upd8.prefs') THEN DO
      IF ~OPEN('prefsfile',progdir'Upd8.prefs','R') THEN CALL report
      IF READLN('prefsfile')~=='Upd8 - preferences' THEN CALL report

      DO UNTIL temp~=''
         temp=READLN('prefsfile')
      END

      IF WORD(temp,1)='STARTCHECK' THEN DO
         startcheck=SUBWORD(temp,2)
         temp=READLN('prefsfile')
         IF WORD(temp,1)='BROWSER' THEN DO
            browser=SUBWORD(temp,2)
            temp=READLN('prefsfile')
            IF WORD(temp,1)='TEXTWIDTH' THEN DO
               textwidth=SUBWORD(temp,2)
               temp=READLN('prefsfile')
               IF WORD(temp,1)='TIMEOUT' THEN DO
                  timeout=SUBWORD(temp,2)
                  temp=READLN('prefsfile')
                  IF WORD(temp,1)='THRESHOLD' THEN DO
                     threshold=SUBWORD(temp,2)
                  END
                  ELSE CALL report
               END
               ELSE CALL report
            END
            ELSE CALL report
         END
         ELSE CALL report
      END
      ELSE CALL report

      CALL CLOSE('prefsfile')
   END
   ELSE CALL defaultprefs
RETURN 0



defaultprefs:
   startcheck=0
   browser   =''
   textwidth =60
   timeout   =20
   threshold =12
RETURN 0



writeprefsfile:
   reportcase='prefsfileerror'
   IF ~OPEN('prefsfile',progdir'Upd8.prefs','W') THEN CALL report
   CALL WRITELN('prefsfile','Upd8 - preferences'lf||lf'STARTCHECK 'startcheck||lf'BROWSER    'browser||lf'TEXTWIDTH  'textwidth||lf'TIMEOUT    'timeout||lf'THRESHOLD  'threshold)
   CALL CLOSE('prefsfile')
RETURN 0



/*** file verifying ***/



check:
   CALL TR_LOCKPROJECT(window.main)
   CALL TR_SETATTRIBUTE(window.main,103,'TRAT_Value',0)
   CALL TR_SETATTRIBUTE(window.main,103,'TROB_Progress',alllist.0)

   button2    ='a_bort all'
   button3    ='_abort'
   showpage   =0

   continuecheck=1
   x            =newlist.0
   oldlistlength=newlist.0

   IF ARG(1,'O') THEN DO
      infotextadd='Verified all. '
      DO number=1 WHILE number<=alllist.0 & continuecheck
         name=alllist.number
         url =alllist.number.urlstring
         data=alllist.number.datastring
         CALL TR_SETATTRIBUTE(window.main,110,'TRAT_Text','Verifying' SUBSTR(name,2,4) 'of' SUBWORD(name,2)'...')
         olddata=data
         CALL getdata
         IF ~success THEN infotextadd='Partial verification. '
         IF retry=2 THEN continuecheck=0
         IF olddata~=data & success THEN CALL newdata
         CALL TR_SETATTRIBUTE(window.main,103,'TRAT_Value',number)
      END
      IF x>oldlistlength THEN infotext=infotextadd||x-oldlistlength 'updates found.'
      ELSE infotext=infotextadd'No updates found.'
      IF x=oldlistlength+1 THEN infotext=infotextadd'1 update found.'
   END
   ELSE DO
      number=ARG(1)
      name=alllist.number
      url =alllist.number.urlstring
      data=alllist.number.datastring
      CALL TR_SETATTRIBUTE(window.main,110,'TRAT_Text','Verifying' SUBSTR(name,2,4) 'of' SUBWORD(name,2)'...')
      olddata=data
      CALL getdata
      IF olddata~=data & success THEN CALL newdata
      IF x>oldlistlength THEN infotext=SUBWORD(name,2) 'updated.'
      ELSE infotext=SUBWORD(name,2) 'not updated.'
      IF ~success THEN infotext='Failed to verify' SUBWORD(name,2)'.'
   END

   CALL TR_SETATTRIBUTE(window.main,103,'TRAT_Value',alllist.0)
   CALL TR_SETATTRIBUTE(window.main,110,'TRAT_Text',infotext)
   CALL TR_UNLOCKPROJECT(window.main)
RETURN 0



newdata:
   IF DATATYPE(data,'N') THEN DO
      IF ~DATATYPE(olddata,'N') THEN olddata=0
      IF ABS(data-olddata)<threshold THEN DO
         alllist.number.datastring=data
         RETURN 0
      END
   END

   x        =x+1
   newlist.0=x

   IF DATATYPE(data,'N') THEN DO
      newlist.x=OVERLAY('(size)',name)
      alllist.number=newlist.x
      IF data-olddata>0 THEN prefix='+'
      ELSE prefix=''
      newlist.x=newlist.x '('prefix||data-olddata 'bytes)'
   END
   ELSE DO
      newlist.x     =OVERLAY('(date)',name)
      alllist.number=newlist.x
   END

   newlist.x.urlstring      =url
   newlist.x.datastring     =data
   alllist.number.datastring=data

   IF x=oldlistlength+1 THEN DO
      CALL TR_SETATTRIBUTE(window.main,101,'TRAT_Value',1)
      CALL atnewlist
   END
   ELSE CALL TR_SETATTRIBUTE(window.main,102,'TROB_Listview','newlist')
RETURN 0



getdata:
   DO UNTIL retry=3 | retry=2
      retry     =3
      closesock =0
      success   =0
      failreason='Reason unknown.'

      CALL recieve
      IF closesock THEN CALL CLOSESOCKET(sock)

      IF ~success THEN DO
         taglist=WindowID(7),
            PubScreenName('Workbench'),
            WindowPosition('TRWP_CENTERDISPLAY'),
            WindowTitle('Upd8 - get location'),
            'VertGroupA',
               'HorizGroupA',
                  'SpaceS',
                  'VertGroupA',
                     'SpaceS',
                     TextN('Could not get location:'),
                     'SpaceS',
                     'LineArray',
                        'Beginline',
                           TextNR('name:'),
                           'SpaceS',
                           TextN(COMPRESS(SUBWORD(name,2),asterisk)) 'TRAT_Flags TRTX_NOUNDERSCORE',
                        'EndLine',
                        'BeginLine',
                           TextNR('URL:'),
                           'SpaceS',
                           TextN(url) 'TRAT_Flags TRTX_NOUNDERSCORE',
                        'EndLine',
                     'EndArray',
                     'SpaceS',
                     TextN(failreason),
                     'SpaceS',
                  'EndGroup',
                  'SpaceS',
               'EndGroup',
               'HorizGroupA',
                  ButtonR('_retry',1),
                  Button(button2,2),
                  ButtonE(button3,3),
               'EndGroup',
            'EndGroup',
         'EndProject'

         retry=TR_AUTOREQUEST(app,off,taglist)
      END
   END
RETURN 0



recieve:
   IF ~openurl() THEN RETURN 0

   DO redirect=1 WHILE redirect<5 & 299<statuscode & 400>statuscode
      DO UNTIL ABBREV(UPPER(line),'LOCATION:')
         IF ~getline() THEN RETURN 0
         IF line='' THEN DO
            failreason='Bad redirection-header.'
            RETURN 0
         END
      END
      PARSE VAR line .' 'url
      IF ~openurl() THEN RETURN 0
   END

   IF statuscode~=200 THEN DO
      failreason='Server responded:' statusphrase
      RETURN 0
   END

   mime    =''
   data    =''
   nodate  =1
   position=1
   DO UNTIL field=''
      IF ~getline() THEN RETURN 0
      PARSE VAR line field': 'content
      field=UPPER(field)
      SELECT
         WHEN field='LAST-MODIFIED' THEN DO
            nodate=0
            data  =content
         END
         WHEN field='CONTENT-LENGTH' & nodate THEN DO
            nodate=0
            data  =content
         END
         WHEN field='CONTENT-TYPE' THEN mime=content
         OTHERWISE NOP
      END
   END

   IF showpage THEN DO
      IF mime~='text/html' & mime~='text/plain' THEN DO
         failreason='Filetype' mime 'unknown.'
         RETURN 0
      END

      CALL TR_SETATTRIBUTE(window.show,402,'TRAT_Text','Recieving and formatting as 'mime'...')

      buffer      =''
      tagpart     =''
      bufferlength=0
      datalength  =1
      count       =0

      IF mime='text/html'  THEN CALL formathtml
      IF mime='text/plain' THEN CALL formattext

      linelist.0=count
      topline=TR_GETATTRIBUTE(window.show,401,'TRLV_Top')
      CALL TR_SETATTRIBUTE(window.show,401,'TROB_Listview','linelist')
      CALL TR_SETATTRIBUTE(window.show,401,'TRLV_Top',topline)
   END
   ELSE DO
      IF nodate THEN DO
         filelength=0
         DO UNTIL datalength=0
            datalength=RECV(sock,'DATA',4096)
            IF datalength=-1 THEN DO
               failreason='Recieve failed.'
               RETURN 0
            END
            filelength=filelength+datalength
         END
         data=filelength
      END
   END

   success=1
RETURN 0



openurl:
   IF closesock THEN CALL CLOSESOCKET(sock)
   closesock=0

   newurl=STRIP(url)
   IF ~ABBREV(UPPER(newurl),'HTTP://') THEN newurl='http://'newurl
   IF POS('/',newurl,8)<1 THEN newurl=newurl'/'

   PARSE VAR newurl 8 host'/'file
   file='/'file
   PARSE VAR host host':'port
   IF port='' THEN port=80

   IF ~DATATYPE(port,'N') | POS('://',newurl,8)>0 THEN DO
      failreason='Bad HTTP URL.'
      RETURN 0
   END
   url=newurl

   IF ~ISLIBON('SOCKET') THEN DO
      failreason='No TCP/IP-stack available.'
      RETURN 0
   END
   sock=SOCKET('INET','STREAM')
   IF sock=-1 THEN DO
      failreason='Could not allocate socket.'
      RETURN 0
   END
   closesock=1

   x.ADDRPORT=port
   x.ADDRFAMILY='INET'
   x.ADDRADDR=RESOLVE(host)
   IF x.ADDRADDR=-1 THEN DO
      failreason='Unknown host.'
      RETURN 0
   END

   CALL SETSOCKOPT(sock,"SOCKET","RCVTIMEO",timeout)
   CALL SETSOCKOPT(sock,"SOCKET","SNDTIMEO",timeout)
   IF CONNECT(sock,'X')<0 THEN DO
      failreason='Connection failed.'
      RETURN 0
   END
   IF SEND(sock,'GET' file 'HTTP/1.0'crlf'User-Agent: Upd8/'version 'AmigaOS'crlf'Host:' host||crlf||crlf)<0 THEN DO
      failreason='Request failed.'
      RETURN 0
   END

   IF ~getline() THEN RETURN 0
   PARSE VAR line protocol' 'statuscode' 'statusphrase
   IF ~DATATYPE(statuscode,'N') | ~ABBREV(UPPER(protocol),'HTTP') THEN DO
      failreason='Bad HTTP-response.'
      RETURN 0
   END
RETURN 1



getline:
   IF RECVLINE(sock,'LINE',1024)<1 THEN DO
      failreason='Recieve failed.'
      RETURN 0
   END
   line=COMPRESS(line,crlf)
RETURN 1



moredata:
   DO WHILE TR_HANDLEMSG(app,'event')
      IF (event.trm_class='TRMS_ACTION' & event.trm_id=404) | event.trm_class='TRMS_CLOSEWINDOW' THEN DO
         infotextadd='Transfer aborted. '
         RETURN 0
      END
   END

   linelist.0=count
   topline=TR_GETATTRIBUTE(window.show,401,'TRLV_Top')
   CALL TR_SETATTRIBUTE(window.show,401,'TROB_Listview','linelist')
   CALL TR_SETATTRIBUTE(window.show,401,'TRLV_Top',topline)

   datalength=RECV(sock,'DATA',4096)
   IF datalength=-1 THEN DO
      infotextadd='Transfer interrupted. '
      RETURN 0
   END
   buffer =buffer||tagpart||TRANSLATE(COMPRESS(data,removechars),' ',tab)
   tagpart=''
RETURN 1



formathtml:
   removechars=crlf
   DO UNTIL (bufferlength=0 & datalength=0)
      IF bufferlength<=textwidth & datalength>0 THEN DO
         IF ~moredata() THEN RETURN 0
         CALL htmltags
      END

      bufferlength=LENGTH(buffer)
      breakpoint  =POS(lf,buffer)
      IF breakpoint>textwidth | (breakpoint=0 & bufferlength>textwidth) THEN DO
         breakpoint=LASTPOS(' ',buffer,textwidth)
         IF breakpoint=0 THEN breakpoint=textwidth
      END
      IF datalength=0 & breakpoint=0 & bufferlength<=textwidth THEN breakpoint=bufferlength

      count         =count+1
      linelist.count=COMPRESS(SUBSTR(buffer,1,breakpoint),lf)
      buffer        =SUBSTR(buffer,breakpoint+1)
      bufferlength  =LENGTH(buffer)
   END
RETURN 0



formattext:
   removechars=cr
   pagetitle  ='plain text'
   DO UNTIL (bufferlength=0 & datalength=0)
      IF bufferlength<=textwidth & datalength>0 THEN DO
         IF ~moredata() THEN RETURN 0
      END

      bufferlength=LENGTH(buffer)
      breakpoint  =POS(lf,buffer)
      IF breakpoint>textwidth | (breakpoint=0 & bufferlength>textwidth) THEN DO
         breakpoint=LASTPOS(' ',buffer,textwidth)
         IF breakpoint=0 THEN breakpoint=textwidth
      END
      IF datalength=0 & breakpoint=0 & bufferlength<=textwidth THEN breakpoint=bufferlength

      count         =count+1
      linelist.count=COMPRESS(SUBSTR(buffer,1,breakpoint),lf)
      buffer        =SUBSTR(buffer,breakpoint+1)
      bufferlength  =LENGTH(buffer)
   END
RETURN 0



htmltags:
   position=0
   taglength=0
   DO UNTIL position=0 | taglength<2; position=POS('&',buffer,position+1)
      IF position>0 THEN DO; taglength=POS(';',buffer,position+1)-position+1
         IF taglength>1 & taglength<10 THEN DO
            tag        =SUBSTR(buffer,position+1,taglength-2)
            replacement='?'
            SELECT
               WHEN POS('#X',UPPER(tag)) THEN IF DATATYPE(SUBSTR(tag,3),'X') THEN replacement=X2C(SUBSTR(tag,3))
               WHEN POS('#',UPPER(tag)) THEN IF DATATYPE(SUBSTR(tag,2),'N') THEN replacement=D2C(SUBSTR(tag,2))
               OTHERWISE SELECT
                  WHEN tag='nbsp'  THEN replacement=' '
                  WHEN tag='copy'  THEN replacement='©'
                  WHEN tag='reg'   THEN replacement='®'
                  WHEN tag='szlig' THEN replacement='ß'
                  WHEN tag='quot'  THEN replacement='"'
                  WHEN tag='amp'   THEN replacement='&'
                  WHEN tag='lt'    THEN replacement='<'
                  WHEN tag='gt'    THEN replacement='>'

                  WHEN tag='uuml'  THEN replacement='ü'
                  WHEN tag='aring' THEN replacement='å'
                  WHEN tag='auml'  THEN replacement='ä'
                  WHEN tag='ouml'  THEN replacement='ö'

                  WHEN tag='Uuml'  THEN replacement='Ü'
                  WHEN tag='Aring' THEN replacement='Å'
                  WHEN tag='Auml'  THEN replacement='Ä'
                  WHEN tag='Ouml'  THEN replacement='Ö'
                  OTHERWISE NOP
               END
            END
            buffer=INSERT(replacement,DELSTR(buffer,position,taglength),position-1)
         END
      END
   END

   position =1
   taglength=0
   DO UNTIL position=0 | taglength<2
      position=POS('<',buffer,position)
      IF position>0 THEN DO
         taglength=POS('>',buffer,position+1)-position+1
         IF taglength>1 THEN DO
            taghead    =UPPER(WORD(SUBSTR(buffer,position+1,taglength-2),1))
            tagname    =COMPRESS(taghead,'/')
            replacement=''
            SELECT
               WHEN taghead='BR'     THEN replacement=lf
               WHEN taghead='A'      THEN replacement='['
               WHEN taghead='/A'     THEN replacement=']'
               WHEN taghead='P'      THEN replacement=lf||lf
               WHEN taghead='/P'     THEN replacement=lf
               WHEN taghead='HR'     THEN replacement=lf'--------------------------------'lf
               WHEN taghead='IMG'    THEN DO
                  tag   =SUBSTR(buffer,position+1,taglength-2)
                  alt   =''
                  altpos=POS('ALT=',UPPER(tag))
                  IF altpos>0 THEN DO
                     altpos=altpos+4
                     PARSE VAR tag =altpos '"'alt1'"' =altpos "'"alt2"'"
                     alt=alt1||alt2
                  END
                  replacement='{'alt'}'
               END
               WHEN tagname='H1'|tagname='H2'|tagname='H3'|tagname='H4'|tagname='H5'|tagname='H6' THEN replacement=lf
               WHEN taghead='TH'|taghead='TD'|taghead='DT'|taghead='/DL'|taghead='/OL'|taghead='/UL' THEN replacement=lf||lf
               WHEN tagname='PRE'|tagname='DIV'|tagname='TABLE' THEN replacement=lf
               WHEN taghead='DD'     THEN replacement=' - '
               WHEN taghead='LI'     THEN replacement=lf||lf'* '
               WHEN taghead='TITLE'  THEN DO
                  titlelength=POS('</TITLE>',UPPER(buffer),position+taglength)-position-taglength
                  pagetitle  =SUBSTR(buffer,position+taglength,titlelength)
                  taglength  =taglength+titlelength+8
               END
               OTHERWISE NOP
            END
            IF replacement~='' THEN buffer=INSERT(replacement,DELSTR(buffer,position,taglength),position-1)
            ELSE buffer=DELSTR(buffer,position,taglength)
         END
         ELSE DO
            tagpart=SUBSTR(buffer,position)
            buffer =DELSTR(buffer,position)
         END
      END
   END
RETURN 0