home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: OtherApp / OtherApp.zip / hl_news.zip / News / HL_News.CMD next >
OS/2 REXX Batch file  |  1999-04-26  |  53KB  |  1,755 lines
  1. /*
  2. HL_News: A  Headline News Viewer (ver 1.0)
  3. By Tom Fredrickson
  4. 4-21-1999
  5.  
  6.  
  7. Citation:
  8.    Headline News Viewer is based on  the  Deja News Reader  by
  9.    Eric Walker (ftp.highboskage.com/dnreader)
  10.  
  11. Requirements:
  12.    Headline News requires the following dynamic link libraries (DLL):
  13.        REXXLIB.DLL and RXWIN30.DLL from Quercus Systems at
  14.               http://www.quercus-sys.com/files/rexxlib.zip
  15.        RXSOCK.DLL:  the IBM EWS RxSock library is usually installed with 
  16.                 OS/2. If you do not a copy of RXSOCK.DLL, you  can find it at
  17.                  ftp.ibm.com/pub/pccbbs/os2_ews/rxsock.zip
  18.    These DLL library files must be in your LIBPATH (say, in x:\os2\dll, where
  19.     x: is your boot drive), or in the same directory as HL_NEWS.CMD
  20.  
  21. Installation:
  22.   a)  Copy HL_NEWS.CMD., NEWS.CFG, and  possibly the aforementioned DLLs
  23.         to one of your applications directory.
  24.   b)  create a LOADS and SAVE subdirectories under this directory --
  25.        these are used for workspace.
  26.        If you want to use diffferent names for these workspace directories,
  27.       you can modify NEWS.CFG.
  28.  
  29.   Caution:
  30.          The  LOADS subdirectory is subject to bulk erasal -- do NOT put anything in
  31.          LOADS that you want to keep!
  32.  
  33.  
  34.  Acknowlegements:
  35.    *  This program  downloads a list, maintained by Derek Decker, of article
  36.       headlines for viewing in a textmode window. You can check this list,
  37.       at http://www.iglou.com/DeckerAutomation/news.html, with a java
  38.       enabled  browser. 
  39.  
  40.       For more info about Decker Automation, and what Derek J Decker REALLY does,
  41.         take a look at    http://www.cris.com/~djd
  42.  
  43.   * I must give specal thanks to Daniel Hellerstein author of HTML_TXT
  44.      Without his help I would have probably not been able to get the text
  45.      formatted in such a nice way.
  46.  
  47.  
  48.  
  49. */
  50.  
  51.  
  52.  
  53.  
  54. /***SETUP & INITIALIZATION:***************************************************/
  55.  
  56. /*   Rexx Function Extensions:  */
  57.  
  58. /*      Add Extended REXX Functions.  */
  59. junk='Found RexxUtil DLL already available.'
  60. If RxFuncQuery('SysLoadFuncs')=1 Then
  61.   Do
  62.     rexxutils=1
  63.     junk='Loaded RexxUtils DLL functions locally.'
  64.     If RxFuncAdd('SysLoadFuncs','RexxUtil','SysLoadFuncs')=0 Then Call SysLoadFuncs
  65.      Else
  66.       Do
  67.         Say 'HL_News Unable to register OS/2 RexxUtils DLL functions.'
  68.         Say
  69.         Exit -1
  70.       End
  71.   End
  72.  
  73.  
  74. /*      Add Quercus REXXLIB Functions.  */
  75. text='Found RexxLib DLL already available.'
  76. If RxFuncQuery('rexxlibregister')=1 Then
  77.   Do
  78.     quercuslib=1
  79.     text='Loaded RexxLib DLL functions locally.'
  80.     If RxFuncAdd('rexxlibregister','rexxlib','rexxlibregister')=0 Then Call RexxLibRegister
  81.      Else
  82.       Do
  83.         Say 'HL_News Unable to register Quercus RexxLib DLL functions.'
  84.         Say
  85.         If rexxutils Then Call SysDropFuncs
  86.         Exit -2
  87.       End
  88.   End
  89.  
  90. Call SysCls
  91. Call CursorType ,,0  /* remove cursor from screen */
  92. Call ScrWrite 1,1,Center('Setting up . . . ',80),,,31
  93. Call ScrWrite 25,1,Center('Loading needed DLL functions . . . ',80),,,31
  94. Call ScrWrite  5,1,Center(junk,80),,,14
  95. Call ScrWrite  8,1,Center(text,80),,,14
  96.  
  97.  
  98. /*      Add Quercus Window Functions.  */
  99. text='Found RXWin30 DLL already available.'
  100. If RxFuncQuery('w_open')=1 Then
  101.   Do
  102.     quercuswin=1
  103.     text='Loaded RXWin30 DLL functions locally.'
  104.     If RxFuncAdd('w_register','rxwin30','rxwindow')=0 Then Call W_Register
  105.      Else
  106.       Do
  107.         Call ScrWrite 11,1,'Unable to register Quercus RXWin30 DLL functions.',,,12
  108.         Call ScrWrite 13,1,Center('(Press any key to exit.)',80),,,15
  109.         Call InKey
  110.         Call SysCls
  111.         If quercuslib Then Call RexxLibDeregister
  112.         If rexxutils Then Call SysDropFuncs
  113.         Exit -3
  114.       End
  115.   End
  116. Call ScrWrite 11,1,Center(text,80),,,14
  117. hello=W_Open(18,1,5,80,79)
  118. Call W_Border hello
  119. Call W_ScrWrite hello,3,2,Center('Remember!  The <F1> key brings help at any list-selection screen.',78)
  120.  
  121.  
  122. /*      Add RxSock DLL functions.  */
  123. text='Found RxSock DLL already available.'
  124. If RxFuncQuery('SockLoadFuncs')=1 Then
  125.   Do
  126.     rexxsock=1
  127.     text='Loaded RxSock DLL functions locally.'
  128.     If RxFuncAdd('SockLoadFuncs','RxSock','SockLoadFuncs')=0 Then Call SockLoadFuncs dummy
  129.      Else
  130.       Do
  131.         Call ScrWrite 14,1,'Unable to register IBM-EWS RxSock DLL functions.',,,12
  132.         Call ScrWrite 16,1,Center('(Press any key to exit.)',80),,,15
  133.         Call InKey
  134.         'cls'
  135.         If quercuswin Then Call W_Deregister
  136.         If quercuslib Then Call RexxLibDeregister
  137.         If rexxutils Then Call SysDropFuncs
  138.         Exit -4
  139.       End
  140.   End
  141. Call ScrWrite 14,1,Center(text,80),,,14
  142. Drop junk text
  143.  
  144.  
  145.  
  146. /*   Initializations:  */
  147.  
  148. Call ScrWrite 25,1,Center('Initializing values . . . ',80),,,31
  149.  
  150.  
  151. /*      Set essential (error-exit) "global" values.  */
  152. rexxutils=0
  153. quercuslib=0
  154. quercuswin=0
  155. rexxsock=0
  156. global='rexxutils quercuslib quercuswin rexxsock boops'
  157.  
  158.  
  159. /*      Set error reporting.  */
  160. Signal On SYNTAX
  161. Signal On HALT
  162.  
  163.  
  164. /*      Set universal values.  */
  165. homedir=Directory()
  166.  
  167.  
  168. /*      Set scan codes.  */
  169. pgup=D2C(73)
  170. pgdn=D2C(81)
  171. upkey=D2C(72)
  172. dnkey=D2C(80)
  173. leftkey=D2C(75)
  174. rightkey=D2C(77)
  175. ins=D2C(82)
  176. del=D2C(83)
  177. homekey=D2C(71)
  178. endkey=D2C(79)
  179. helpf1=D2C(59)
  180. alts=D2C(31)
  181. alti=D2C(23)
  182. scancodes='pgup pgdn upkey dnkey leftkey rightkey ins del homekey endkey helpf1 alti alts' 
  183.  
  184.  
  185. /*      User-settable values.  */
  186.  
  187. /*         Initialize values  */
  188. line_len=78
  189. h_mark=''
  190. hi_asc=0
  191. loadsdir=homedir'\LOADS\'
  192. savesdir=''
  193. boops=1
  194. artcolor=96        /*  black on brown   */
  195. hitpick=10         /*  GREEN on black   */
  196.  
  197. /*         Over-ride via CNF file  */
  198. Call FileRead 'NEWS.CNF','dummy.'
  199. Do line=1 to dummy.0
  200.   If Pos('boops=',dummy.line)>0 Then Interpret dummy.line
  201.   If Pos('loadsdir=',dummy.line)>0 Then Interpret dummy.line
  202.   If Pos('savesdir=',dummy.line)>0 Then Interpret dummy.line
  203.   If Pos('artcolor=',dummy.line)>0 Then Interpret dummy.line
  204.   If Pos('hitpick=',dummy.line)>0 Then Interpret dummy.line
  205.    If Pos('line_len=',dummy.line)>0 Then Interpret dummy.line
  206.   If Pos('hi_asc=',dummy.line)>0 Then Interpret dummy.line
  207.    If Pos('h_mark=',dummy.line)>0 Then Interpret dummy.line
  208.  
  209. End
  210. Drop line dummy.
  211. If boops<>0 and boops<>1 Then boops=1
  212. If crossmax>10 Then crossmax=10
  213.  
  214.  
  215. /*      Augment "global" variables list.  */
  216. cr=D2C(13)
  217. crlf=D2C(13)||D2C(10)
  218. escape=D2C(27)
  219. nul=''
  220. help=0
  221. alfabase=64  /* ascii of "A" minus 1 */
  222. global=global||' cr crlf escape nul help alfabase homedir loadsdir line_len h_mark hi_asc savesdir'
  223.  
  224. /*      Initialize pointers cv.  */
  225. pointers.0=5
  226. Do junk=1 To 5
  227.   pointers.junk=nul
  228. End
  229. Drop junk
  230. !nextup=1
  231. !oneback=2
  232. !hitlist=3
  233. !thread=4
  234. !author=5
  235. pointerstuff='pointers. !nextup !oneback !hitlist !thread !author'
  236.  
  237.  
  238. /*   Net SetUp:  */
  239.  
  240. Call ScrWrite 25,1,Center('Resolving addresses . . . ',80),,,31
  241.  
  242.  
  243. /*      Get queries-host dot address.  */
  244. queryserver=NewHost('www.iglou.com')
  245. If queryserver=nul Then Call ItQuits 'Unable to resolve query-server name--exiting.',-5
  246.  
  247.  
  248.  
  249. /*   Set other procedure-expose groups:  */
  250.  
  251. colors=' artcolor hitpick '
  252. poststuff='poster postserver username password email myname myorg editor groupname quoter intro crossmax'
  253. criteria='svcclass ageweight agesign showsort msgmax'
  254.  
  255.  
  256.  
  257. /*   Clean plate:  */
  258.  
  259. /*      Delete any old Load files.  */
  260. Call ScrWrite 25,1,Center('Cleaning up . . . ',80),,,31
  261. Call SysFileTree loadsdir'*.*','dummy.','FO'
  262. If (dummy.0)>0 Then Call KillAll '*.*'
  263.  
  264. /*      Close "hello" window.  */
  265. Call Delay 3
  266. Call W_Close hello
  267. Call CursorType ,,0
  268. drop dummy. hello
  269.  
  270.  
  271.  
  272.  
  273. /***MAIN ACTIVITY LOOP:*******************************************************/
  274.  
  275. IF BOOPS THEN CALL SOUND 500,.1
  276. /*CALL POPUP 'This is BETA 1 of Headline News',2,'X'*/
  277.  
  278. Do Forever  
  279.   /*  Select Clusters, Browse, Search, or Quit  */
  280.   If boops Then Call Sound 900,.1
  281.   Call ScrClear
  282.   Call ScrWrite  1,1,Center('Task-Selection Screen:',80),,,31
  283.   Call ScrWrite 25,1,Center('Select a task by indicator letter (<Esc> quits the program).',80),,,31
  284.   Call ScrWrite  7,10,'Attention you Must be ON LINE to use Headline News',,,8
  285.   Call ScrWrite 13,10,'B = Browse local list of news headlines',,,8
  286.   Call ScrWrite 19,10,'D = Download  a new list of headlines',,,8
  287.   ok=0
  288.   allowed='BD'||escape
  289.   help=8
  290.   Do Until ok
  291.     gothelp=0
  292.     pressed=Upper(InKey())
  293.     If Length(pressed)=2 Then
  294.       Do
  295.         scancode=Right(pressed,1)
  296.         If scancode=helpf1 Then
  297.           Do
  298.             gothelp=1
  299.             Call ShowHelp
  300.           End
  301.       End
  302.      Else ok=Verify(pressed,allowed,'M')
  303.     If gothelp=0 & ok=0 Then Call Sound 40,.3
  304.     If pressed=escape Then
  305.       Do
  306.         If PopUp('Do you really want to exit this program?',6)='N' Then ok=0
  307.          Else Call ItQuits 'Normal exit.',0
  308.       End
  309.   End
  310.   help=0
  311.   Call ScrClear
  312.   /*  Do Called-For Task  */
  313.   Select
  314.     /*When pressed='I' Then Call Interests*/
  315.     When pressed='B' Then do;bill=1; Call OffLine;end  /*Browse*/
  316.     When pressed='D' Then Call Search     /* search will be online mode*/
  317.   End
  318. End
  319.  
  320.  
  321.  
  322.  
  323. /******GET HEADLINES ACTIVITY LOOP:********************************************/
  324. Search:
  325.  
  326. /*  Actual activity loop.  */
  327. Do Forever
  328.   Call ScrWrite 1,1,Center('Power Search HeadLines:',80),,,31
  329.   queryY= "/DeckerAutomation/news.txt" 
  330.   query='GET 'queryy||crlf||' HTTP/1.0'
  331.   site="www.iglou.com"
  332.   port=80
  333.   artlist=MakeQuery(query,site,port,0,'S')
  334.   /*:::::::::::::::::::::::::::::::::::::::::::::::::::::::
  335.         query="/DeckerAutomation/news.txt"
  336.       queryserver=NewHost("www.iglou.com")
  337.       ok=MakeQuery(query,queryserver,'80','N')
  338.  
  339.   MakeQuery gets the server's response and saves it in a
  340.   file named SEARCH.HTM; it returns 0 for success or, for 
  341.   any failure, -1.
  342.   :::::::::::::::::::::::::::::::::::::::::::::::::::::::*/
  343.   If artlist<0 Then Call PopUp 'Search failed somehow!',4,'X'
  344.   If artlist<0 Then leave
  345.   bill=0
  346. OffLine:
  347.  
  348. if bill=1 then got=1
  349.   got=ParseSearch()
  350.   If got=0 Then Call PopUp 'There were NO Headlines returned.',3,'X'
  351.   If got=0 Then Iterate
  352.   artibase=0                               /*  Re-initialize articles-list placeholder */
  353.   Do Forever
  354.     toread=PickArticle(-1)                   /*  Select article from search results      */
  355.     If toread=nul Then Leave                 /*  User quits article selection            */
  356.     if toread>0 then do
  357.     toread=GetUrl(toread)
  358.     Do Forever
  359.       toread=ReadArticle(toread)               /*  User could select next article here     */
  360.       If toread=nul Then Leave                 /*  User quits internal article selection   */
  361.     End
  362.   End
  363. End
  364. Return
  365.  
  366.  
  367.  
  368. /*  Procedures Specific To This Task.  */
  369.  
  370.  
  371. ParseSearch:
  372. Procedure Expose (global)
  373. Call ScrWrite 1,1,Center('Reply complete; parsing list . . . ',80),,,31    
  374. Call ScrWrite 25,1,Center('Speed, shmeed: this is only Rexx!',80),,,31
  375. Call FileRead loadsdir'SEARCH.HTM','html.'
  376.  
  377. /*  Extract hits/hrefs from raw file.  */
  378. hits.0=0
  379. hrefs.0=0
  380. art=0
  381. line=0
  382. /*start*/
  383.  Do line=1 To html.0
  384.               if pos('www.futurecard.com',html.line)>0 then iterate
  385.               if pos('freewire.htm',html.line)>0 then iterate
  386.              art=art+1
  387.              start=pos('" ',html.line) 
  388.              Head_lines=strip(left(html.line,start),'B','"')
  389.                 hits.art=CONVERT_CODES(Head_lines)
  390.                 hrefs.art=strip(substr(html.line,start+9),'L','/')
  391.               End
  392.  
  393.           hits.0=art
  394.           hrefs.0=art
  395. /*end*/
  396. hits.0=art
  397. hrefs.0=art
  398. If art>0 Then
  399.   Do
  400.     Call FileWrite loadsdir'SEARCH.HIT','hits.','R'
  401.     Call FileWrite loadsdir'SEARCH.REF','hrefs.','R'
  402.   End
  403. Return art
  404.  
  405.  
  406.  
  407.  
  408. /***SHARED PROCEDURES, ROUTINES, ETC.:****************************************/
  409.  
  410. /*   Major Routines:  */
  411.  
  412. PickArticle:
  413. Procedure Expose (global) (scancodes) (colors) (pointerstuff) (poststuff)  artibase groupname queryserver
  414. Parse Arg groupnumber
  415.   /* search */
  416.   do
  417.       scheme1=hitpick
  418.       scheme2=hitpick
  419.       namespec='SEARCH'
  420.       serial=0
  421.       usename='News HeadLines'
  422.       mode='S'
  423.       end
  424. call fileread loadsdir'SEARCH.HIT','hits.'
  425. call fileread loadsdir'SEARCH.REF','hrefs'
  426. art=hits.0
  427. help=3
  428. picked=0
  429. nextblock=''
  430. Do Until picked
  431. Call ScrWrite 1,1,Center('Current "'usename'"',80),,,31
  432.   /*  Display 22-line window of list selections.  */
  433.   attr=scheme1
  434.   Do row=3 To 24    
  435.     inset=(row-2)+artibase  /* row 3 is "A" */
  436.     If inset<=art Then
  437.       Do
  438.         test=Strip(hits.inset,'L')
  439.         blanks=(Length(hits.inset))-Length(test)
  440.         If blanks=0 | Left(test,4)='Re: ' Then
  441.           Do
  442.             If attr=scheme1 Then attr=scheme2
  443.              Else attr=scheme1
  444.           End
  445.         leader=D2C(row-2+alfabase)': '
  446.         Call ScrWrite row,1,leader||Left(hits.inset,77),,,attr
  447.         top=row
  448.       End
  449.      Else Call ScrWrite row,1,' ',80,' ',2
  450.   End
  451.   Call ScrWrite 2,1,Center('Local list lines 'artibase+1' To 'artibase+top-2' (of 'hits.0')',80),,,15
  452.   /*  Get valid user choice.  */
  453.   top=D2C(top-2+alfabase)
  454.   allowed=XRange('A',top)
  455.   Call ScrWrite 25,1,Center('Pick an Article by corresponding letter key.',80),,,31
  456.   ok=0
  457.   Do Until ok
  458.     pressed=InKey()
  459.     If Length(pressed)=1 Then 
  460.       Do
  461.         scancode=nul
  462.         pressed=Upper(pressed)
  463.         If pressed=escape Then ok=1
  464.         If Verify(pressed,allowed,'Match') Then 
  465.           Do
  466.             index=artibase+C2D(pressed)-alfabase
  467.             If hrefs.index<>nul Then ok=1
  468.           End
  469.       End
  470.      Else 
  471.       Do
  472.         scancode=Right(pressed,1)
  473.         pressed=nul
  474.         If scancode=pgup | scancode=pgdn | scancode=homekey | scancode=endkey | scancode=helpf1 Then ok=1
  475.       End
  476.     If \ok Then Call Sound 40,.3
  477.   End  /* of UNTIL OK loop */
  478.   /*  Process choice as appropriate.  */
  479.   picked=0
  480.   If scancode<>nul Then
  481.     Do
  482.       Select
  483.         /*  Screen-change keys.  */
  484.         When scancode=pgup Then
  485.           Do
  486.             If artibase=0 Then 
  487.               Do
  488.                 If boops Then Call Sound 200,.1
  489.               End
  490.              Else artibase=artibase-22
  491.             If artibase<0 Then artibase=0
  492.           End
  493.         When scancode=pgdn Then
  494.           Do
  495.             If artibase<art-22 Then 
  496.               Do
  497.                 artibase=artibase+22
  498.                 If artibase>(art-22) Then artibase=art-22
  499.               End
  500.               /* +++++++++++?+++++++++*/
  501.              Else
  502.               Do
  503.                 If nextblock='' Then Call Sound 40,.3
  504.               End  /* of were-at-end */
  505.              
  506.           End  /* of PgDn */
  507.         When scancode=homekey Then 
  508.           Do
  509.             If artibase=0 Then 
  510.               Do
  511.                 If boops Then Call Sound 200,.1
  512.               End
  513.              Else artibase=0
  514.           End
  515.         When scancode=endkey Then 
  516.           Do
  517.             If artibase>=art-22 Then 
  518.               Do
  519.                 If boops Then Call Sound 1300,.1
  520.               End
  521.              Else artibase=art-22
  522.             If artibase<0 Then artibase=0
  523.           End
  524.         When scancode=helpf1 Then 
  525.           Do
  526.             Call ShowHelp
  527.           End
  528.       End  /* Select scancode */
  529.     End  /* nonascii key used */
  530.    Else
  531.     Do
  532.       picked=1
  533.       If pressed=escape Then toread=nul
  534.       Else toread=hrefs.index
  535.       /*
  536.        Else do; toread=hrefs.index;  /* calculated in appraising keypress validity */
  537.        /* get next and prev here Toread+1 -1 */
  538.          !index=index+1
  539.           index!=index-1
  540.           if index>2 then pointers.!oneback=GetUrl(hrefs.index!)
  541.           else pointers.!oneback=nul
  542.           if index=art then pointers.!nextup=nul
  543.           else pointers.!nextup=getUrl(hrefs.!index)
  544.        end /* do */
  545.         */
  546.  
  547.     End
  548. End  /* of Do-Until-Picked loop */
  549. help=0
  550. Return toread
  551.  
  552.  
  553. ReadArticle:
  554. Procedure Expose (global) (scancodes) (pointerstuff) (colors) (poststuff) /*queryserver*/
  555. Parse Arg toread
  556.  parse var toread query site port type
  557. ok=MakeQuery(query,site,port,0,type)
  558. /*If ok<0 Then Call PopUp 'Article NOT returned!',4,'X'*/
  559. If ok<0 Then Return nul
  560. /*call dosdel loadsdir'IMAGE.TXT'*/
  561. call dosdel loadsdir'IMG.REF'
  562. call dosdel loadsdir'IMG.HIT'
  563.  
  564.  if site='gopher.voa.gov' then do
  565.     Call FileRead loadsdir'ARTICLE.HTM','article.'
  566.     Call ScrWrite 1,1,Center('Converting 'article.0' HTML lines to straight text . . . ',80),,,31
  567.     Call ScrWrite 25,1,Center('Speed, shmeed: this is only Rexx!',80),,,31
  568.      If article.0>0 then call FileWrite loadsdir'ARTICLE.TXT','article.'
  569.  end /* do */
  570.  else do
  571. Call FileRead loadsdir'ARTICLE.HTM','text.'
  572. Call ScrWrite 1,1,Center('Converting 'text.0' HTML lines to straight text . . . ',80),,,31
  573. Call ScrWrite 25,1,Center('Speed, shmeed: this is only Rexx!',80),,,31
  574.  
  575. /*===How to read article====*/
  576. no_start_mess=''
  577.       select                                                                           
  578.          when site='dailynews.yahoo.com'  then do  /* checked */                              
  579.             read_by=1
  580.             start='TimeStamp:'
  581.             stop='<!-- TextEnd -->'        /* need -1 from endat */
  582.          end /* do dailynews.yahoo.com */
  583.          when site='gopher.voa.gov'  then do        /* checked */                             
  584.             read_by=2
  585.             beginat=1
  586.             endat=text.0 
  587.          end /* do gopher.voa.gov */
  588.          when site='www.vny.com'   then do         /**/                            
  589.              read_by=3 
  590.              start='<title>'
  591.              stop='</PRE>'        /* need-2 */
  592.            end /* do vny.com */
  593.          when site='www.latimes.com'   then do       /* checked */                           
  594.                         read_by=4
  595.             found.1=0
  596.             call arraysearch 'text.','found.','<div align=right>'
  597.             if found.1>0 then start='<div align=right>'
  598.              else do; call arraysearch 'text.','found.','<!--CONTENT SPACE-->'
  599.                   if found.1>0 then start='<!--CONTENT SPACE-->'
  600.              else start='<!--LEFT SIDE LINKS END-->'
  601.              end
  602.              found.1=0
  603.              call arraysearch 'text.','found.','<!--STORY ENDS-->'
  604.                 if found.1>0 then stop='<!--STORY ENDS-->'
  605.                 else stop='<!--BOTTOM NAV ROW-->'
  606.          end /* do LA Times */
  607.             
  608.          when site='7am.com'   then do                 /**/
  609.             read_by=5
  610.             call arraysearch 'text.','found.','A 7am News Special Feature'
  611.             if found.1>0 then start='<TITLE>'
  612.                 else   start='<FONT SIZE=5>'
  613.                 found.1=0
  614.               call arraysearch 'text.','found.','#0000c0'
  615.               if found.1>0 then stop='#0000c0'
  616.                else  stop='<B>Previous Stories</B>'
  617.          end /* do 7am.com */
  618.          when site='cnn.com'   then do                 /* checked */
  619.             read_by=6
  620.             start='Paste story between here'
  621.             stop='Relateds'
  622.             end /* do cnn.com */
  623.          when site='www.washingtonpost.com' then  do   /**/                         
  624.          call arraysearch 'text.','found.1','302 Moved'
  625.              if found.1>0 then do
  626.                  call Scrwrite  23,1,Center('Connection: closed Article Moved 'site,80),,,79
  627.                  return  nextart
  628.                    end
  629.          read_by=7
  630.          start='plsfield:headline'
  631.          stop='The Washington Post Company'
  632.           found.1=0
  633.            end /* do www.washingtonpost.com */
  634.          when site='news.bbc.co.uk'   then do          /**/                      
  635.             read_by=8
  636.             start='date" component *'
  637.             stop='Search/Back'
  638.          end /* do news.bbc.co.uk */
  639.          when site='www.wired.com'  then do                /**/                      
  640.             read_by=9
  641.             /* get headline out<!-- HEADLINE=The Sordid Saga of Sex.com -->*/
  642.             start='HEADLINE='
  643.             stop='- END_OF_BODY -'
  644.          end /* do www.wired  */ 
  645.          when site='cnnfn.com'   then do               /**/                         
  646.             read_by=10
  647.                                     found.0=0
  648.             call arraysearch 'text.','found.','-Start Header Block'
  649.             if found.0>0 then start='-Start Header Block'
  650.              else do; call arraysearch 'text.','found.','digitaljam'
  651.                   if found.1>0 then start='digitaljam'
  652.              else start='<title>'
  653.              end
  654.              found.1=0
  655.              call arraysearch 'text.','found.','-End Body-'
  656.                 if found.1>0 then stop='-End Body-'
  657.                 else stop='Copyright '
  658.          end /* do cnnfn.com */
  659.          when site='www.news.com.au'  then do             /**/                         
  660.             read_by=11
  661.             start='<!-- START: Columns Table -->'
  662.             stop='<!-- END: Columns Table -->'
  663.          end /* do */
  664.          when site='www.zdii.com'   then do            /**/                         
  665.             read_by=12
  666.             start='- content start center table -'
  667.             stop='-content stop-'
  668.          end /* do */
  669.          when site='www.futurecard'   then do          /**/                         
  670.             read_by=13
  671.              call Scrwrite  23,1,Center('Need Credit? Goto:'site,80),,,79           
  672.              return  nextart                                                           
  673.          end /* do */
  674.          when site='www.news.com'   then do            /**/                         
  675.             read_by=14
  676.             start='<blockquote>'
  677.             stop='</blockquote>'
  678.          end /* do */
  679.          when site='dynamic.webpoint.com' then  do           /*checked*/                 
  680.             read_by=15  
  681.              start='<!-- START TEXT -->'
  682.              stop='<!-- END TEXT -->'       /* some strange character */
  683.               end /* do */
  684.           when site='www.techweb.com'   then do       /**/      
  685.              read_by=16                                  
  686.              start='-HEADLINE-'
  687.              stop='-/BODY-'
  688.           end /* do */                                   
  689.  
  690.  
  691.                                                                                        
  692.       otherwise                                                                        
  693.       read_by=0                                                                        
  694.        call ArraySearch 'text.','found.','/applet','S'
  695.          if found.0>0 then beginat=found.1+1
  696.           else beginat=1
  697.           endat=text.0
  698.       end  /* select */                                                                
  699.  
  700.  
  701. if no_start_mess='' then no_start_mess='Cant find text start.'
  702.  
  703.   found.1=0                                                                           
  704.   call ArraySearch 'text.','found.',start,'S'                                         
  705.   if found.1>0 then  beginat=found.1                                                  
  706.   else do                                                                             
  707.        call Scrwrite  23,1,Center(no_start_mess' 'site,80),,,79                  
  708.        return  nextart                                                                
  709.          end                                                                          
  710.          found.1=0                                                                    
  711.   call ArraySearch 'text.','found.',stop,'S'                                          
  712.   if found.1>0 then  endat=found.1                                                    
  713.   else do                                                                             
  714.        call Scrwrite  24,1,Center('Cant find text end.'site,80),,,79                  
  715.        return  nextart                                                                
  716.          end                                                                          
  717.  
  718. /*-- add beginat endat ajustments here --*/
  719. /*if read_by=1 then endat=endat-1*/
  720.  
  721. article.0=0
  722. count=0
  723. in=0
  724. out=0
  725. pre_tx_on=0
  726. cut_on=0
  727. pre_tx_on=0
  728.  
  729. text=''
  730. do line=beginat to endat
  731.    if text.line=nul then iterate line
  732.    /*---------site specific -------------*/
  733.  
  734.      if read_by=4 then do           /* la times */
  735.      if pos('>ADVERTISEMENT<',text.line)>0 then iterate line
  736.   end /* do */
  737.  
  738.     if read_by=14 then do              /* www.news.com */
  739.        if pos('> Do you want to know more?<',text.line)>0 then iterate line
  740.        if pos('newsLinks">',text.line)>0 then iterate line
  741.        if pos('Message Boards</a',text.line)>0 then iterate line
  742.         in=pos('>QUOTE SNAPSHOT<',text.line)
  743.         
  744.         out=pos('20+ minutes<',text.line)
  745.  
  746.         if pos('News.com</a>',text.line)>0 then iterate line
  747.  
  748.     end /* do */
  749.         if read_by =9 then do
  750.        if pos('Related Wired Links:',text.line)>0 then leave
  751.     end /* do */
  752.  
  753.  
  754.    if pos('<PRE>',upper(text.line))>0 then pre_tx_on=1
  755.    if pos('</PRE',upper(text.line))>0 then pre_tx_on=0
  756.  
  757.   count=count+1
  758.       text_in=translate(text.line,' ','0da00009'X)
  759.         if in>0 then text_in=insert('[cut]',text_in,in)
  760.         if out>0 then text_in=insert('[/cut]',text_in,out+10)
  761.    if pre_tx_on=1 then text=text' 'text_in||' [pre]'
  762.   else text=text' 'text_in
  763.   end
  764.  
  765.     text=DeHtml(text)
  766.      
  767.     
  768.        call Wrapper text
  769.     end /* gopher not */
  770.  
  771.  count=article.0
  772. Call ScrWrite 1,1,Center('Article From: 'site,80),,,31
  773. nextart=nul
  774. baseline=0
  775. inset=0
  776. done=0
  777. temp=W_Open(2,1,23,80,artcolor)
  778. help=6
  779. Do Until done
  780.   /*  Clear FULL screen in case of side trips made  */
  781.   Call W_Clear temp,artcolor,' ',2,1,23,80
  782.   /*  Display 23-line window of article.  */
  783.   top=baseline+23
  784.   If top>count Then top=count
  785.   Call ScrWrite 25,1,Center('Lines 'baseline+1' to 'top' of article.',80),,,31
  786.   maxlength=0
  787.   Do row=1 To top
  788.     index=row+baseline
  789.     Call W_ScrWrite temp,row,1,SubStr(article.index,1+inset,80)
  790.     If Length(article.index)>maxlength Then maxlength=Length(article.index)
  791.   End
  792.   /*  Get a valid keypress.  */
  793.   ok=0
  794.   Do Until ok | done
  795.     pressed=InKey()
  796.     If Length(pressed)=1 Then 
  797.       Do
  798.         scancode=nul
  799.         If pressed=escape Then done=1
  800.          Else Call Sound 40,.3
  801.       End
  802.      Else 
  803.       Do
  804.         scancode=Right(pressed,1)
  805.         pressed=nul
  806.         Select
  807.           When scancode=pgup Then
  808.             Do
  809.               ok=1
  810.               If baseline=0 Then 
  811.                 Do
  812.                   If boops Then Call Sound 200,.1
  813.                 End
  814.                Else baseline=baseline-23
  815.             End
  816.           When scancode=pgdn Then
  817.             Do
  818.               ok=1
  819.               If baseline>=(count-23) Then 
  820.                 Do
  821.                   If boops Then Call Sound 1300,.1
  822.                 End
  823.                Else 
  824.                 Do
  825.                   baseline=baseline+23
  826.                   If (baseline+24)>count Then baseline=count-23
  827.                 End
  828.             End
  829.           When scancode=homekey Then 
  830.             Do
  831.               ok=1
  832.               If baseline=0 Then 
  833.                 Do
  834.                   If boops Then Call Sound 200,.1
  835.                 End
  836.                Else baseline=0
  837.             End
  838.           When scancode=endkey Then 
  839.             Do
  840.               ok=1
  841.               If baseline=count-23 Then 
  842.                 Do
  843.                   If boops Then Call Sound 1300,.1
  844.                 End
  845.                Else baseline=count-23
  846.             End
  847.           When scancode=leftkey Then
  848.             Do
  849.               ok=1
  850.               If inset=0 Then 
  851.                 Do
  852.                   If boops Then Call Sound 200,.1
  853.                 End
  854.                Else inset=inset-10
  855.             End
  856.           When scancode=rightkey Then
  857.             Do
  858.               ok=1
  859.               If inset>=(maxlength-80) Then 
  860.                 Do
  861.                   If boops Then Call Sound 1300,.1
  862.                 End
  863.                Else 
  864.                 Do
  865.                   inset=inset+10
  866.                   If (inset+80)>maxlength Then inset=maxlength-80
  867.                 End
  868.             End
  869.           When scancode=helpf1 Then 
  870.             Do
  871.               Call ShowHelp
  872.             End
  873. /*::::::::Special-call keys:::::::::::::::::::::::::::::::::::::::::::*/
  874.           When scancode=alts Then
  875.             Do
  876.               ok=1
  877.               Call SaveIt
  878.             End
  879.           When scancode=alti Then
  880.             Do
  881.               ok=1
  882.               Call ShowHeader
  883.             End
  884.           Otherwise Call Sound 40,.3
  885.         End  /* Select on scancode */
  886.       If baseline<0 Then baseline=0
  887.       If inset<0 Then inset=0
  888.       End  /* scankey pressed */
  889.   End  /* get & process keypress */
  890.   If \ok & \done Then Call Sound 40,.3
  891. End
  892. help=0
  893. Call W_Close temp
  894. Call CursorType ,,0
  895. Return nextart
  896.  
  897.  
  898. /*===============================================*/
  899.  
  900.  
  901. MakeQuery:
  902. Procedure Expose (global)
  903. Parse Arg query,site,port,serial,type
  904. /*Parse Arg query,serveraddr,port,serial,type*/
  905. serveraddr=NewHost(site)
  906. if port='' then port=80
  907. Select
  908.   When type='S' Then Call ScrWrite 1,1,Center('Getting requested HeadLines . . . ',80),,,31
  909.   When type='G' Then Call ScrWrite 1,1,Center('Getting requested Gopher Article. . . ',80),,,31
  910.   When type='A' Then Call ScrWrite 1,1,Center('Getting requested Article from: 'site,80),,,31
  911.   Otherwise Call ScrWrite 1,1,Center('Getting requested Article . . . ',80),,,31
  912. End
  913. /*  Connect to server for a socket.  */
  914. Call ScrWrite 25,1,Center('Connecting . . . ',80),,,31
  915. /*  Now log on.  */
  916. socket=SockSocket("AF_INET","SOCK_STREAM",0)
  917. If socket=-1 Then
  918.    Do
  919.      If boops Then Call Sound 300,.3
  920.      Call ScrWrite 25,1,Center('Error opening socket!  (Press any key to continue.)',80),,,79
  921.      Call InKey
  922.    End
  923. If socket=-1 Then Return -1
  924. /*  Log on to the socket.  */
  925. Call ScrWrite 25,1,Center('Logging on to socket 'socket' . . . ',80),,,31
  926. server.!family='AF_INET'  /* mandatory  */
  927. server.!port=port  /*  standard HTTP port  */
  928. server.!addr=serveraddr  /* as obtained earlier  */
  929. got=SockConnect(socket,'server.!')
  930. If got=-1 Then
  931.    Do
  932.      If boops Then Call Sound 300,.3
  933.      Call ScrWrite 25,1,Center('Error logging on to socket!  (Press any key to continue.)',80),,,79
  934.      Call InKey
  935.    End
  936. If got=-1 Then Return -1
  937. /*  Send actual service request.  */
  938. Call ScrClear 7,' ',2,1,23,80
  939. Call ScrWrite 25,1,Center('Sending request . . . ',80),,,31
  940. select
  941.    when type='G' then do
  942.       Call SendLine query,socket      /*Gopher*/
  943.    end /* do */
  944.    when type='S' then do
  945.       Call SendLine query,socket      /*Headlines*/
  946.    end /* do */
  947. otherwise
  948. Call SendLine 'GET 'query' HTTP/1.0',socket
  949. end  /* select */
  950. Call SendLine 'Accept: *'||'/'||'*; q=0.300',socket
  951. Call SendLine 'Accept: application/octet-stream; q=0.100',socket
  952. Call SendLine 'Accept: text/plain',socket
  953. Call SendLine 'Accept: text/html',socket
  954. Call SendLine 'User-Agent: IBM-RxSock-DLL/v1.1',socket
  955. Call SendLine nul,socket
  956. Call SendLine query,socket
  957. Call ScrWrite 25,1,Center('Request sent . . . ',80),,,31
  958. buffer=nul
  959. Call Time('R')
  960. Do Until buffer<>nul & data=nul
  961.   If Time('E')>120 Then Leave
  962.   rc=SockRecv(socket,'data',8000)
  963.   If buffer=nul Then Call ScrWrite 25,1,Center('Receiving reply . . . ',80),,,31
  964.   buffer=buffer||data
  965.   If data<>nul Then Call Time('R')
  966.   Call ScrWrite 13,1,Center(Length(buffer)' bytes received . . . ',80),,,14
  967. End
  968. /*  Close socket before proceeding.  */
  969. got=SockSoClose(socket)
  970. If got=-1 Then Call ItQuits 'Error closing socket.',-7
  971. /*  Process response, if any.  */
  972. If Pos('>Bad Request<',buffer)>0 Then Call PopUp 'Server Could Not Understand Query!',4,'X'
  973. If Pos('>Bad Request<',buffer)>0 Then Return -1
  974. If Pos('Moved Temporarily',buffer)>0 Then Call PopUp 'This Article has Been Moved!',4,'X'
  975. If Pos('Moved Temporarily',buffer)>0 Then Return -1
  976. If Pos('HTTP/1.0 404 Not found',buffer)>0 Then Call PopUp 'This Article Not Found on server!',4,'X'
  977. If Pos('HTTP/1.0 404 Not found',buffer)>0 Then Return -1
  978. If Pos('HTTP/1.0 302 Found',buffer)>0 Then Call PopUp 'This Article has Been Moved!',4,'X'
  979. If Pos('HTTP/1.0 302 Found',buffer)>0 Then Return -1
  980.  
  981. If buffer<>nul Then
  982.   Do      /* need select by QueryServer our type to set up the readArticle*/
  983.     If type='G' Then ok=1/*serial+1*/
  984.      Else ok=0
  985.     dummy.0=1
  986.     dummy.1=buffer
  987.     Call ScrWrite 25,1,Center('Reply received; saving . . . ',80),,,31
  988.     Select
  989.       When type='S' Then dropin='SEARCH'
  990.       Otherwise dropin='ARTICLE'
  991.     End
  992.     Call ScrWrite 13,1,Copies(' ',80)
  993.     Call FileWrite loadsdir||dropin||'.HTM','dummy.'
  994.   End
  995.  Else 
  996.    Do
  997.      ok=-1
  998.      Call PopUp 'Error receiving response!',4,'X'
  999.    End
  1000. Return ok
  1001.  
  1002.  
  1003.  
  1004. /*   Lesser Routines:  */
  1005.  
  1006.  
  1007. /*   Small Procedures (only globals Exposed):  */
  1008.  
  1009.  
  1010.  
  1011. NewHost:
  1012. Procedure Expose (global)
  1013. Parse Arg service
  1014. If SockGetHostByName(service,'host.!')=0 Then serveraddr=nul
  1015.  Else serveraddr=host.!addr
  1016. Return serveraddr
  1017.  
  1018.  
  1019.  
  1020. GetUrl:
  1021. procedure Expose (global)
  1022. parse arg url
  1023. /*  //gopher.voa.gov:70/00/newswire/mon/CONGO-HUMAN_RIGHTS 
  1024.     www.vny.com/cf/News/upidetail.cfm?QID=74278
  1025. */
  1026.  
  1027. if pos('gopher',url)>0 Then do
  1028.      
  1029.      j=pos(':',url)
  1030.   site=substr(url,1,j-1)
  1031.   com=substr(url,j+5)
  1032.            n=pos('%',com)
  1033.            if n >0 then 
  1034.            do until n=0
  1035.           parse var com '%' !test
  1036.           /* set query for gopher*/
  1037.           test='%'||substr(!test,1,2)
  1038.           old=substr(!test,3)
  1039.           new_com=left(com,n-1)
  1040.             select
  1041.             When test='%26' Then use='&'
  1042.             When test='%7C' Then use='|'
  1043.             When test='%21' Then use='!'
  1044.             When test='%5E' Then use='^'
  1045.             When test='%22' Then use='"'
  1046.             When test='%3F' Then use='?'
  1047.             When test='%29' Then use=')'
  1048.             When test='%7B' Then use='{'
  1049.             When test='%7D' Then use='}'
  1050.             When test='%23' Then use='#'
  1051.             When test='%28' Then use='('
  1052.             When test='%2C' Then use=','
  1053.             When test='%25' Then use='%'
  1054.             When test='%3A' Then use=':' 
  1055.             When test='%7E' Then use='~'
  1056.             Otherwise use='[bad]'
  1057.           End
  1058.           com=new_com||use||old
  1059.            n=pos('%',com)
  1060.          end
  1061.          query=com
  1062. /*queryserver=NewHost(site)*/
  1063. port=70
  1064. type='G'
  1065.    return query site port type
  1066.    end
  1067. else
  1068.     do
  1069.    j=pos('/',url)
  1070.    site_tag=substr(url,1,j-1)
  1071.    /*=====could select long or short here======*/
  1072.   if site_tag='www.latimes.com' then do
  1073.       la=lastpos('.1',url)
  1074.       if la>0 then  com_tag=substr(url,j,la-j)||substr(url,la+2)
  1075.       else com_tag=substr(url,j)
  1076.       comtag=url
  1077.       end
  1078.       else com_tag=substr(url,j)
  1079.  
  1080. query=com_tag
  1081. port=80
  1082. site=site_tag
  1083. return query site port
  1084. end
  1085.  
  1086.   /*MakeQuery(query,queryserver,0,'A')*/
  1087.  
  1088.  
  1089.  
  1090. Wrapper: procedure  expose article.
  1091. parse arg text
  1092. art_text.0=0
  1093. art=0
  1094. /*do line=1 to count*/
  1095.  sentence=''
  1096.    do forever
  1097.       if text='' then /* leave*/
  1098.       do 
  1099.          art=art+1
  1100.          /*say sentence*/
  1101.          art_text.art=sentence
  1102.          leave
  1103.       end /* do */
  1104.       len=pos('[pre]',text)
  1105.       if len>0 then line_len=400
  1106.       else line_len=76
  1107.      parse var text aword text
  1108.          /*
  1109.       bad=pos('>',aword)
  1110.       badlink=pos('HTTP:',upper(aword))
  1111.        if bad>0 then aword=' '
  1112.        if badlink>0 then aword=' '
  1113.        */
  1114.       if length(sentence)+length(aword)> line_len  then do    /*aword*/
  1115.          art=art+1
  1116.          art_text.art=sentence
  1117.        /* say  sentence /* or lineout it */*/
  1118.               if aword='[P]' then do; aword='';art=art+1;/*say ''*/ art_text.art='';end
  1119.         if aword='[BR]' then do; aword='';art=art+1;/*say ''*/ art_text.art='';end
  1120.            if aword='[pre]' then aword=''
  1121.             if aword='[/CENTER]' then aword=''
  1122.             if aword='[/TITLE]' then aword=''
  1123.             if aword='[CENTER]' then aword=''
  1124.             if aword='[TITLE]' then aword=''
  1125.  
  1126.          sentence=aword
  1127.          
  1128.     end
  1129.    else do
  1130.      sentence=sentence' 'aword
  1131.      if sentence='[BR]' then sentence=''
  1132.      if sentence='[P]' then sentence=''
  1133.                   /*
  1134.        tabl=Pos('[TABLE]',sentence)-1
  1135.        if tabl>0 then do
  1136.           sentence=left(sentence,tabl)
  1137.           art=art+1
  1138.           art_text.art=sentence||'[tabl'
  1139.            /*
  1140.            art=art+1
  1141.           art_text.art=''
  1142.           */
  1143.           sentence=''
  1144.        end /* do */
  1145.        
  1146.        end_tabl=pos('[/TABLE]',sentence)-1
  1147.        if end_tabl>0 then do
  1148.           sentence=left(sentence,end_tabl)||'[end'
  1149.            art=art+1
  1150.           art_text.art=center(sentence,78)
  1151.            art=art+1
  1152.           art_text.art=''
  1153.           sentence=''
  1154.  
  1155.        end /* do */
  1156.        */
  1157.  
  1158.  
  1159.      brk=pos('[BR]',sentence)-1
  1160.       if brk >0 then do
  1161.         /*sentence=sentence' 'aword*/
  1162.         sentence=left(sentence,brk)
  1163.         art=art+1
  1164.         art_text.art=sentence
  1165.        sentence=''
  1166.        art=art+1
  1167.        art_text.art=''
  1168.        /*say ''*/
  1169.        sentence=''
  1170.        end
  1171.  
  1172.      wrap=pos('[P]',sentence)-1
  1173.       if wrap >0 then do
  1174.         /*sentence=sentence' 'aword*/
  1175.         sentence=left(sentence,wrap)
  1176.         art=art+1
  1177.         art_text.art=sentence
  1178.       /* say sentence*/
  1179.        art=art+1
  1180.        art_text.art=''
  1181.        /*say ''*/
  1182.        sentence=''
  1183.        art=art+1
  1184.        art_text.art=''
  1185.        /*say ''*/
  1186.        sentence=''
  1187.  
  1188.        end
  1189.  
  1190.  
  1191.  
  1192.        title=pos('[TITLE]',sentence)-1
  1193.        if title>0 then do
  1194.           sentence=left(sentence,title)
  1195.           art=art+1
  1196.           art_text.art=sentence
  1197.            art=art+1
  1198.           art_text.art=''
  1199.           sentence='***'
  1200.        end /* do */
  1201.        end_title=pos('[/TITLE]',sentence)-1
  1202.        if end_title>0 then do
  1203.           sentence=left(sentence,end_title)||'***'
  1204.            art=art+1
  1205.           art_text.art=center(sentence,line_len-2)
  1206.            art=art+1
  1207.           art_text.art=''
  1208.           sentence=''
  1209.  
  1210.        end /* do */
  1211.               cent=pos('[CENTER]',sentence)-1
  1212.        if cent>0 then do
  1213.           sentence=left(sentence,cent)
  1214.           art=art+1
  1215.           art_text.art=sentence
  1216.           /*
  1217.            art=art+1
  1218.           art_text.art=''
  1219.           */
  1220.           sentence=''
  1221.        end /* do */
  1222.        end_cent=pos('[/CENTER]',sentence)-1
  1223.        if end_cent>0 then do
  1224.           sentence=left(sentence,end_cent)
  1225.            art=art+1
  1226.           art_text.art=center(sentence,line_len-2)
  1227.           /*
  1228.            art=art+1
  1229.           art_text.art=''
  1230.           */
  1231.           sentence=''
  1232.  
  1233.        end /* do */
  1234.  
  1235.        pre_tx=pos('[pre]',sentence)-1
  1236.        if pre_tx>0 then do
  1237.           sentence=substr(sentence,1,pre_tx)
  1238.           art=art+1
  1239.           art_text.art=sentence
  1240.           sentence=''
  1241.  
  1242.        end /* do */
  1243.     end  
  1244.     end  
  1245.  
  1246.   art_text.0=art
  1247.  if art>0 then do 
  1248.   /* call filewrite 'loads\ARTICLE.TXT','art_text.'*/
  1249.     call arraydelete article.,1, article.0
  1250.  call arrayinsert art_text.,article.,1,1, art_text.0
  1251. /* end*/
  1252.     return 
  1253.  end
  1254.  
  1255.  
  1256.  
  1257. /*---- New Html markdown---*/
  1258. DeHtml:
  1259. PROCEDURE expose (global)
  1260.  
  1261.  
  1262. parse arg body
  1263. thispara=''
  1264. capon=0
  1265. cut_on=pos('[cut]',body)-1
  1266. cut_off=pos('[/cut]',body)+6
  1267. if cut_on>0 then body=left(body,cut_on)||substr(body,cut_off)
  1268. ispre=0
  1269. ulineon=0
  1270. img_num=0
  1271. img_href.=0
  1272. img_alt.=0
  1273. do forever
  1274.  if body='' then leave
  1275.     
  1276.     parse var body t1 '<' t2a '>' body
  1277.        
  1278.     T1=CONVERT_CODES(T1,CAPON,ISPRE,ULINEON)
  1279. /* Ready to add more content ..... */
  1280.      thispara=thispara||t1      /* ADD T1 TO THISPARA FOR EVENTUAL OUTPUT */
  1281. /* now prepare to process this <element> (T2 is first word, T2A is all words */
  1282.     t2=strip(translate(word(t2a,1)))             /* get rid of element modifiers */
  1283.     if left(t2,1)='/'  then
  1284.         t2end=substr(t2,2)
  1285.     else
  1286.         t2end=''
  1287.  
  1288.        /*do some stuff here*/
  1289.     select
  1290.     when t2='P' then do
  1291.        thispara=thispara||' ['t2'] '
  1292.     end /* do */
  1293.       when t2='PRE' then do;ispre=1;end
  1294.        when t2='/PRE' then do;ispre=0;end
  1295.         when t2='B' then capon=1
  1296.        when t2='/B' then capon=0
  1297.        when t2='IMG' then do
  1298.           img_num=img_num+1
  1299.           parse var t2a . imgname 
  1300.           here=Pos('SRC',upper(imgname))
  1301.           start=Pos('"',imgname,here)+1
  1302.            cut=pos('"',imgname,start+1)
  1303.             link=substr(imgname,start,cut-start)
  1304.           here=Pos('ALT',upper(imgname))
  1305.           if here>0 then do
  1306.           start=pos('"',imgname,here)
  1307.            cut=pos('"',imgname,start+1)-1
  1308.           link_nam=substr(imgname,start+1,cut-start)
  1309.           end
  1310.           else link_nam='What no alt tag?'
  1311.            img_href.img_num=link
  1312.            img_alt.img_num=link_nam
  1313.  
  1314.             /*
  1315.           say'herf: 'link
  1316.           say'link: 'link_nam
  1317.               */
  1318.                 /*  if cut-start=2 then  imgname=substr(imgname,start+1,1)*/
  1319.                 if length(link_nam)=1 then alt_let=link_nam
  1320.         else alt_let=''
  1321.           thispara=thispara||' 'alt_let
  1322.           
  1323.           end
  1324.         when t2='TITLE' then do
  1325.        thispara=thispara||' ['t2'] '
  1326.     end /* do */
  1327.     when t2='/TITLE' then do
  1328.        thispara=thispara||' ['t2'] '
  1329.        end
  1330.          when t2='CENTER' then do
  1331.        thispara=thispara||' ['t2'] '
  1332.     end /* do */
  1333.     when t2='/CENTER' then do
  1334.        thispara=thispara||' ['t2'] '
  1335.        end
  1336.  
  1337.      when wordpos(t2,'H1 H2 H3 H4 H5 H6 H7')>0 then do
  1338.         if h_mark='' then h_mark='0000'X||strip(t2,'L','H')||')'
  1339.  
  1340.          thispara=thispara||h_mark
  1341.            end
  1342.               when wordpos(t2,'/H1 /H2 /H3 /H4 /H5 /H6 /H7')>0 then do
  1343.          thispara=thispara||' [BR] '
  1344.            end
  1345.  
  1346.         when t2='BR' then do
  1347.        thispara=thispara||' [BR] '
  1348.     end /* do */
  1349.  otherwise nop
  1350.    end
  1351.  end
  1352.  if img_num>0 then do
  1353.     img_href.0=img_num
  1354.     img_alt.0=img_num
  1355.     call filewrite loadsdir'IMG.REF','img_href.'
  1356.     call filewrite loadsdir'IMG.HIT','img_alt.'
  1357.  end /* do */
  1358. return thispara
  1359.  
  1360.  
  1361.  
  1362. /* CONVERT &ENCODING */
  1363. CONVERT_CODES:PROCEDURE expose (global)
  1364. PARSE ARG T1,CAPON,ISPRE,ULINEON,ISTH
  1365.  
  1366. IF T1='' then RETURN T1
  1367.  
  1368.       if capon>0 | ISTH='TH' then t1=translate(t1)
  1369.       if ispre=0 then t1=translate(T1,' ','0d0a0009'x)
  1370.       if ulineon=1 then do
  1371.            if ispre=0 then
  1372.               t1= translate(space(t1,1),'_',' ')
  1373.            else
  1374.               t1=translate(t1,'_',' ')
  1375.       end /* do */
  1376.  
  1377.       tt1=t1 ;t1=''
  1378.       do forever
  1379.         if tt1='' then leave
  1380.         parse var tt1 v1 '&' v2a tt1
  1381.  
  1382.         t1=t1||v1
  1383.         goo=pos(';',v2a)
  1384.  
  1385.         if goo>0 then do
  1386.             v2=left(v2a,goo-1)
  1387.             v3a=substr(v2a,goo+1)
  1388.             tt1=v3a' 'tt1
  1389.         end /* do */
  1390.         else do
  1391.            v2=v2a
  1392.         end /* do */
  1393.  
  1394.         v2=strip(v2)
  1395.  
  1396.         if v2<>"" then do
  1397.             v2=strip(translate(v2))
  1398.             v2=strip(v2,,'#')
  1399.             select
  1400.                when v2='AMP' then t1=t1||'&'
  1401.                when v2='LT' then t1=t1||'<'
  1402.                when v2='GT' then t1=t1||'>'
  1403.                when v2='QUOT' then t1=t1||'"'
  1404.                when v2='NBSP' then t1=t1||'01'x
  1405.                when datatype(v2)='NUM' then do 
  1406.                   if hi_asc=0 then t1=t1||' '
  1407.                   else t1=t1||d2c(v2)
  1408.                end /* do */
  1409.                otherwise t1=t1||' 'translate(v2)' '
  1410.             end  /* select */
  1411.         end /* v2<>"" */
  1412.       end /* FOREVER  */
  1413. RETURN T1
  1414.  
  1415. /*-------------------------------------*/
  1416.         /* end text markup*/
  1417.  
  1418.  
  1419. GetPointer:
  1420. Procedure Expose (global)
  1421. Parse Arg item
  1422. test=Upper(item)
  1423. start=Pos('HREF=',test)
  1424. If start=0 Then Return nul
  1425. start=start+12
  1426. If Pos('HREF="',test)>0 Then 
  1427.   Do
  1428.     start=start+1
  1429.     cut=Pos('">',item,start)
  1430.   End
  1431.  Else cut=Pos('>',item,start)
  1432. If cut>0 Then 
  1433.   Do
  1434.     ref=SubStr(item,start,cut-start)
  1435.     If ref<>nul Then
  1436.       Do
  1437.         start=Pos('/',ref)
  1438.         If start>0 Then query=SubStr(ref,start)
  1439.          Else query=ref
  1440.       End
  1441.   End
  1442.  Else query=nul
  1443. Return query
  1444.  
  1445.  
  1446. GetAuthor:           /* cuold be used t get a url ?*/
  1447. Procedure Expose (global)
  1448. Parse Arg item
  1449. start=Pos('/profile.xp',item)
  1450. If start=0 Then Return nul
  1451. cut=Pos('">',item,start)
  1452. If cut=0 Then cut=Pos('>',item,start)
  1453. If cut>0 Then query=SubStr(item,start,cut-start)
  1454.  Else query=nul
  1455. Return query
  1456.  
  1457.  
  1458. PopUp:
  1459. Procedure Expose (global)
  1460. Parse Arg text,color,mode
  1461. If mode=nul Then second='Press Y for Yes or any other key for No.'
  1462.  Else second='Press any key to continue.'
  1463. width=6+Length(text)
  1464. If width<46 Then width=46
  1465. column=1+((80-width)%2)
  1466. If boops Then Call Sound 600,.2
  1467. handle=W_Open(10,column,7,width,(color+8)*16)
  1468. Call W_Border handle,1,1,1,1
  1469. Call W_ScrWrite handle,3,4,Center(text,width-6)
  1470. Call W_ScrWrite handle,5,4,Center(second,width-6)
  1471. pressed=Upper(InKey())
  1472. Call W_Close handle
  1473. Call CursorType ,,0
  1474. If pressed<>'Y' Then pressed='N'
  1475. Return pressed
  1476.  
  1477.  
  1478.  
  1479.  
  1480.  
  1481.  
  1482. KillAll:
  1483. Procedure Expose (global)
  1484. Parse Arg spec
  1485. Call SysFileTree loadsdir||spec,'dummy.','FO'
  1486. Do i=1 To dummy.0
  1487.    if dummy.i=loadsdir||'SEARCH.HTM' then iterate
  1488.   Call DosDel dummy.i
  1489. End
  1490. Return
  1491.  
  1492.  
  1493. SendLine:
  1494. Procedure Expose (global)
  1495. Parse Arg tosend,socket
  1496. data=tosend||crlf
  1497. Do Forever
  1498.   If SockSend(socket,data)=Length(data) Then Leave
  1499.    Else
  1500.     Do
  1501.       pressed=PopUp('Failure sending command line.  Retry?',1,nul)
  1502.       If pressed='N' Then Call ItQuits 'Fatal error trying to send to server.',-8
  1503.     End
  1504. End
  1505. Return
  1506.  
  1507.  
  1508. ShowHeader:
  1509. Procedure Expose (global)
  1510. Call FileRead loadsdir'IMG.REF','dummy.'
  1511. head.0=0
  1512. j=0
  1513. done=0
  1514. Do i=1 To dummy.0
  1515.   j=j+1
  1516.   If j>18 Then
  1517.     Do
  1518.       done=1
  1519.       j=18
  1520.       dummy.j=Center('[Image text overflowed allowed space--not all shown]',80)
  1521.     End
  1522.   If done Then Leave
  1523.   If Length(dummy.i)<=80 Then head.j=dummy.i
  1524.    Else
  1525.     Do
  1526.       head.j=Left(dummy.i,80)
  1527.       inset=1+Pos(':',dummy.i)
  1528.       balance=SubStr(dummy.i,81)
  1529.       allowed=79-inset
  1530.       Do While balance<>nul
  1531.         j=j+1
  1532.         head.j=Copies(' ',inset)||Left(balance,allowed)
  1533.         balance=SubStr(balance,1+allowed)
  1534.       End
  1535.     End  
  1536. End
  1537. head.0=j
  1538. max=5+head.0
  1539. temp=W_Open(2,1,max,80,112)
  1540. Call W_ScrWrite temp,max-2,1,Center('(Press any key to dismiss image text.)',80)
  1541. Call W_ScrWrite temp,max,1,Copies(':',80)
  1542. row=1
  1543. Do line=1 To head.0
  1544.   row=row+1
  1545.   Call W_ScrWrite temp,row,1,head.line
  1546. End
  1547. Call InKey
  1548. Call W_Close temp
  1549. Call CursorType ,,0
  1550. Return
  1551.  
  1552.  
  1553. SaveIt:
  1554. Procedure Expose (global)
  1555. Parse Arg serial
  1556. temp=W_Open(10,1,7,80,95)
  1557. Call W_Border temp
  1558. Call W_ScrWrite temp,3,2,Center('Enter the save-file name (or press <Esc> to abort):',78)
  1559. saveas=W_Get(temp,5,2,78,savesdir,15)
  1560. Call W_Close temp
  1561. Call CursorType ,,0
  1562. If saveas<>nul Then
  1563.   Do
  1564.     If ValidName(saveas) Then
  1565.       Do
  1566.         testdir=FileSpec('Drive',saveas)||Strip(FileSpec('Path',saveas),'T','\')
  1567.         If DosIsDir(testdir) Then 
  1568.           Do
  1569.             If DosIsFile(saveas) Then 
  1570.               Do
  1571.                 If PopUp('File exists; append?',6)='Y' Then howto='A'
  1572.                  Else howto='R'
  1573.               End
  1574.              Else howto='R'
  1575.             /*ec=DosCopy(loadsdir'IMAGE.TXT',saveas,howto)*/
  1576.              ec=DosCopy(loadsdir'ARTICLE.TXT',saveas,howto)
  1577.             If ec<>0 Then Call PopUp 'Save failed! (rc='ec')',4,'X'
  1578.              Else 
  1579.                Do
  1580.                  If boops Then Call Sound 1200,.1
  1581.                End
  1582.           End
  1583.          Else Call PopUp 'That directory does not exist!  (Not saved.)',3,'X'
  1584.       End
  1585.      Else Call PopUp 'That is not a valid filespec! (Not saved.)',3,'X'
  1586.   End
  1587. Call CursorType ,,0
  1588. Return
  1589.  
  1590.  
  1591.  
  1592.  
  1593. GetALine:
  1594. Procedure Expose (global)
  1595. Parse Arg socket
  1596. buffer=nul
  1597. Do While Pos(crlf,buffer)=0
  1598.   rc=SockRecv(socket,'data',8000)
  1599.   If rc<>-1 Then buffer=buffer||data
  1600. End
  1601. cut=Pos(crlf,buffer)
  1602. If cut>0 Then 
  1603.   Do
  1604.     got=SubStr(buffer,1,cut-1)
  1605.     buffer=SubStr(buffer,cut+2)  /*  keep any excess for later  */
  1606.   End
  1607.  Else got='### BAD RECEIVE ###'
  1608. Return got
  1609.  
  1610.  
  1611. LineValue:
  1612. Procedure Expose (global)
  1613. Parse Arg linevalue
  1614. start=Pos(':',linevalue)
  1615. linevalue=Strip(SubStr(linevalue,start+1))
  1616. Return linevalue
  1617.  
  1618.  
  1619. LongMessage:
  1620. Procedure Expose (global)
  1621. Parse Arg meaning
  1622. temp=W_Open(12,1,3,80,79)
  1623. Call W_ScrWrite temp,2,1,meaning
  1624. Call InKey
  1625. Call W_Close temp
  1626. Call CursorType ,,0
  1627. Return
  1628.  
  1629.  
  1630. GoodBye:
  1631. Procedure Expose (global)
  1632. Parse Arg socket
  1633. Call SendLine 'QUIT',socket
  1634. Call ScrWrite 25,1,Center('Logging off 'poster'.',80),,,31
  1635. got=GetALine(socket)
  1636. got=SockSoClose(socket)
  1637. If got=-1 Then Call PopUp 'Error closing socket!',4,'X'
  1638. Return got
  1639.  
  1640.  
  1641.  
  1642. /*   Help Screens:  */
  1643.  
  1644. ShowHelp:
  1645. Procedure Expose (global)
  1646. temp=W_Open(2,1,24,80,31)
  1647. Call W_Border temp
  1648. Call W_ScrWrite temp,24,2,Center('(Press any key to dismiss this help screen.)',78,'═')
  1649. /*                                      ----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8  */
  1650. Select
  1651.   /*  Pick an Article:  */
  1652.   When help=3 Then
  1653.     Do
  1654.       Call W_ScrWrite temp, 5,2,Center('You can use the <PgDn>, <PgUp>, <Home>, and <End> keys',78)
  1655.       Call W_ScrWrite temp, 7,2,Center('to display more choices (if there are more).',78)
  1656.       Call W_ScrWrite temp,10,2,Center('Press any letter shown to see that specific article.',78)
  1657.       Call W_ScrWrite temp,16,2,Center('Press the <Esc> key to select another group in this interest cluster.',78)
  1658.     End
  1659.   /*  View an Article:  */
  1660.   When help=6 Then
  1661.     Do
  1662.       Call W_ScrWrite temp, 5,2,Center('You can use the <PgDn>, <PgUp>, <Home>, and <End> keys',78)
  1663.       Call W_ScrWrite temp, 6,2,Center('to see more text (if there is more).',78)
  1664.       Call W_ScrWrite temp, 10,2,Center('You can use the LeftArrow and RightArrow cursor keys.',78)
  1665.       Call W_ScrWrite temp, 14,2,Center('to shift the display sideways if text is off-screen.',78)
  1666.       Call W_ScrWrite temp,16,2,Center('Press Alt-S to save this article to a specific file.',78)
  1667.       Call W_ScrWrite temp,18,2,Center('Press Alt-I to see image text: a list of any images',78)
  1668.       Call W_ScrWrite temp,22,2,Center('Press the <Esc> key to return to selecting articles.',78)
  1669.     End
  1670.   /*  Select a Task:  */
  1671.   When help=8 Then
  1672.     Do
  1673.       Call W_ScrWrite temp, 8,2,Center('You must be online to use this Program to view any articles ',78)
  1674.       Call W_ScrWrite temp, 10,2,Center('B allows you to browse all available news headlines from local file',78)
  1675.       Call W_ScrWrite temp,12,2,Center('D allows a search of all news headlines by loading a new list of articles',78)
  1676.       Call W_ScrWrite temp,16,2,Center('Press the <Esc> key to completely exit the Reader.',78)
  1677.     End
  1678.   Otherwise
  1679.     Do
  1680.       Call W_ScrWrite temp,12,2,Center('No context-sensitive help is available for this screen.',78)
  1681.     End
  1682. End
  1683. Call InKey
  1684. Call W_Close temp
  1685. Call CursorType ,,0
  1686. Return
  1687.  
  1688.  
  1689.  
  1690. /*   Exit Routines:  */
  1691.  
  1692. SYNTAX:
  1693. which=rc
  1694. where=sigl
  1695. Do 3
  1696.   Call Sound 500,.2
  1697.   Call Sound 200,.1
  1698. End
  1699. Call ScrClear
  1700. Call ScrWrite  1,1,Center('A SYNTAX Trap has occurred!',80),,,79
  1701. Call ScrWrite  6,1,Center('The error was in Line #'where', which reads:',80),,,63
  1702. Call ScrWrite 14,1,Center('The short error description for Rexx Error #'which' is:',80),,,63
  1703. Call ScrWrite 15,1,Center(ErrorText(which),80)
  1704. Call ScrWrite 25,1,Center('Operation cannot continue--press any key to exit.',80),,,79
  1705. Call ScrWrite  7,1,ShowLine(where)
  1706. Call Inkey
  1707. Call ItQuits 'Syntax Error 'which' on Line 'where'.',-9
  1708.  
  1709.  
  1710. HALT:
  1711. where=sigl
  1712. Do 3
  1713.   Call Sound 500,.2
  1714.   Call Sound 200,.1
  1715. End
  1716. Call ScrClear
  1717. Call ScrWrite  1,1,Center('A HALT has occurred!',80),,,79
  1718. Call ScrWrite 10,1,Left('The Halt occurred while in Line #'where', which reads:',80),,,63
  1719. Call ScrWrite 11,1,ShowLine(where)
  1720. Call ScrWrite 25,1,Center('Operation cannot continue--press any key to exit.',80),,,79
  1721. Call Inkey
  1722. Call ItQuits 'HALT initiated while on Line 'where'.',-10
  1723.  
  1724.  
  1725. ItQuits:
  1726. Procedure Expose (global)
  1727. Parse Arg message,ec
  1728. Call CursorType ,,1
  1729. If rexxsock Then Call SockDropFuncs
  1730. If quercuswin Then Call W_Deregister
  1731. If quercuslib Then Call RexxLibDeregister
  1732. If rexxutils Then Call SysDropFuncs
  1733. If boops Then 
  1734.   Do
  1735.     Call Beep 400,200
  1736.     Call Beep 200,100
  1737.   End
  1738. 'cls'
  1739. Say
  1740. Say '   'message
  1741. Say
  1742. Say
  1743. Exit ec
  1744.  
  1745.  
  1746. ShowLine:
  1747. Procedure Expose (global)
  1748. Parse Arg line
  1749. Call FileRead homedir'HL_News.CMD','reader.'
  1750. text=reader.line
  1751. Return text
  1752.  
  1753.  
  1754. /* [end] */
  1755.