home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Rice_CMS / gopher24 / gopclimb.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-01-24  |  16.1 KB  |  505 lines
  1. /*
  2.  *        Name: GOPCLIMB REXX
  3.  *              VM TCP/IP Network GOPHER Client menu browser
  4.  *      Author: Rick Troth, Rice University, Information Systems
  5.  *        Date: 1992-Dec-23
  6.  *
  7.  *       Input: one or more gopher menu lines
  8.  *      Output: zero or more information or error messages
  9.  */
  10.  
  11. /*
  12.  *      Copyright 1992 Richard M. Troth.   This software was developed
  13.  *      with resources provided by Rice University and is intended
  14.  *      to serve Rice's user community.   Rice has benefitted greatly
  15.  *      from the free distribution of software,  therefore distribution
  16.  *      of unmodified copies of this material is not restricted.
  17.  *      You may change your own copy as needed.   Neither Rice
  18.  *      University nor any of its employees or students shall be held
  19.  *      liable for damages resulting from the use of this software.
  20.  */
  21.  
  22. Trace "OFF"
  23.  
  24. Parse Arg args '(' . ')' .
  25.  
  26. /*  verify availability of input  */
  27. 'PEEKTO'
  28. If rc ^= 0 & rc ^= 12 Then Exit rc
  29. If rc = 12 Then Do  /*  empty menu  */
  30.     'CALLPIPE COMMAND XMITMSG 60 (APPLID GOP CALLER CLI ERRMSG | *:'
  31.     Exit
  32.     End  /*  If  ..  Do  */
  33.  
  34. Address "COMMAND" 'GLOBALV SELECT GOPHER GET' ,
  35.         'GOPHER PROGID VIEWER ITEM'
  36. quit = 0
  37.  
  38. Parse Var item name '05'x path '05'x host '05'x port '05'x xtra
  39. Parse Var name 1 . 2 name       /*  discard type indicator byte  */
  40. Parse Var path 1 . 2 path       /*  discard type indicator byte  */
  41. If name = "" Then name = args
  42. booklist = (item = "")
  43.  
  44. /*  fetch fs. stem variable from GlobalVs  */
  45. 'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,
  46.         '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
  47. If ^Datatype(fs.tube,'X') Then fs.tube = ""
  48.  
  49. 'CALLPIPE *: | STEM MENU.'
  50.  
  51. /* is it a server error? */
  52. If menu.0 = 1 & Left(menu.1,1) = '-' Then Do
  53.     Parse Var menu.1 . '-' errmsg '05'x .
  54.     'OUTPUT' errmsg
  55.     Exit
  56.     End  /*  If  ..  Do  */
  57.  
  58. /*  display the menu and process user's response  */
  59. row = 0;        col = 0         /*  reset later  */
  60. ki = menu.0;    kl = fs.scrrows - 5;    ko = 1
  61. needle = ""     /*  may be re-used within this context  */
  62. message.0 = 0
  63. command = ""
  64.  
  65. If booklist Then 'CALLPIPE COMMAND XMITMSG 615' ,
  66.         '(APPLID GOP CALLER CLI NOCOMP | SPEC WORD 2-* 1 | STEM HELP.'
  67.             Else 'CALLPIPE COMMAND XMITMSG 613' ,
  68.         '(APPLID GOP CALLER CLI NOCOMP | SPEC WORD 2-* 1 | STEM HELP.'
  69.  
  70. 'CALLPIPE COMMAND XMITMSG 5 (APPLID GOP NOHEADER | VAR MORE'
  71.  
  72. Do Forever
  73.  
  74.     /*  write the program title line  */
  75.     wscreen = sba(0,-1) || field("BLUE","PROT") || sba(0,0) || progid ,
  76.                         || sba(0,fs.scrcols-Length(host)-1) || host
  77.  
  78.     /*  no SBA for status because it follows host immediately  */
  79.     If message.0 < 1 Then Do
  80.     wscreen = wscreen   || field("PROT") || Left(ko || '/' || ki, 11)
  81.     If ko + kl <= ki Then
  82.     wscreen = wscreen   || field("WHITE","HIGH","PROT") || more
  83.         End  /*  If  ..  Do  */
  84.  
  85.     /*  don't write status or name if they'll be overlaid  */
  86.     If message.0 < 2 Then
  87.     wscreen = wscreen   || sba(2,(fs.scrcols-Length(name))/2) ,
  88.                         || field("WHITE","PROT") || name
  89.  
  90.     /*  write as many message lines as needed  */
  91.     If message.0 > 0 Then Do
  92.         Do i = 1 to message.0
  93.             wscreen = wscreen || sba(i,-1) ,
  94.                 || field("RED","HIGH","PROT") || message.i
  95.             End  /*  Do  For  */
  96.         message.0 = 0
  97.         End  /*  If  ..  Do  */
  98.     /*  we should probably limit that count  */
  99.  
  100.     /*  write those PFkey settings  */
  101.     wscreen = wscreen   || sba(fs.scrrows-2,-1) ,
  102.                         || field("BLUE","PROT") ,
  103.                         || help.1 ,
  104.                         || sba(fs.scrrows-1,-1) ,
  105.                         || field("BLUE","PROT") ,
  106.                         || help.2
  107.  
  108.     i = 1; j = ko
  109.     Do While i <= kl & j <= ki
  110.  
  111.         Parse Var menu.j _name '05'x .
  112.         Parse Var _name 1 _type 2 _name
  113.         'CALLPIPE VAR _NAME | XLATE OUTPUT' ,
  114.             '| XLATE *-* 00-3F 40 FF 40 | VAR _NAME'
  115.  
  116.         wscreen = wscreen || sba(i+2,-1) ,
  117.                           || field("BLUE","PROT","HIGH")
  118.         If _type = 'i' Then
  119.         wscreen = wscreen || Left(_name,fs.scrcols-1)
  120.                       Else Do
  121.         wscreen = wscreen || Left(gtag(_type),11) ,
  122.                           || field("GREEN") ,
  123.                           || Left(_name,fs.scrcols-13)
  124.             If row = 0 Then Do
  125.                 row = i + 2;    col = 12
  126.                 End  /*  If  ..  Do  */
  127.             End  /*  Else  Do  */
  128.  
  129.         i = i + 1;  j = j + 1
  130.  
  131.         End  /*  Do  While  */
  132.  
  133.     rscreen = write_read(wscreen || sba(row,col) || '13'x)
  134.     Parse Var rscreen 1 aid 2 offset . '11'x rscreen
  135.     offset = fix(offset)
  136.     row = offset % fs.scrcols; col = offset // fs.scrcols
  137.  
  138.     /*  keep the row/col values within bounds  */
  139.     If  row      <   3       Then row = 3
  140.     If  row      >   kl + 3  Then row = kl + 3
  141.     If  row + ko >   ki + 3  Then row = ki + 3 - ko
  142.     col = 12    /*  just reset it  */
  143.  
  144.     i = row + ko - 3
  145.  
  146.     Select /* aid */
  147.         When  aid = '7D'x   /* enter */ | ,
  148.               aid = 'F2'x   /*  PF2  */ | ,
  149.               aid = 'C2'x   /*  PF14 */ | ,
  150.               aid = '7B'x   /*  PF11 */ | ,
  151.               aid = '4B'x   /*  PF23 */ Then  Call  OPEN
  152.         When  aid = 'F3'x   /*  PF3  */ | ,
  153.               aid = 'C3'x   /*  PF15 */ Then  Leave
  154.         When  aid = 'F4'x   /*  PF4  */ | ,
  155.               aid = 'C4'x   /*  PF16 */ Then  Call  PRINT
  156.         When  aid = 'F5'x   /*  PF5  */ | ,
  157.               aid = 'C5'x   /*  PF17 */ Then  Call  KEEP
  158.         When  aid = 'F6'x   /*  PF6  */ | ,
  159.               aid = 'C6'x   /*  PF18 */ Then  Call  FIND
  160.         When  aid = 'F7'x   /*  PF7  */ | ,
  161.               aid = 'C7'x   /*  PF19 */ Then Do
  162.             ko = Max(ko-kl+1,1)
  163.             row = 3
  164.             End  /*  When  ..  Do  */
  165.         When  aid = 'F8'x   /*  PF8  */ | ,
  166.               aid = 'C8'x   /*  PF20 */ Then Do
  167.             ko = Min(ko+kl-1,ki)
  168.             row = 3
  169.             End  /*  When  ..  Do  */
  170.         When  aid = 'F9'x   /*  PF9  */ | ,
  171.               aid = 'C9'x   /*  PF21 */ Then  Call  MARK
  172.         When  aid = '7A'x   /*  PF10 */ | ,
  173.               aid = '4A'x   /*  PF22 */ Then  Call  BOOKLIST
  174.         When  aid = '6D'x   /* clear */ | ,
  175.               aid = '6E'x   /*  PA2  */ Then Do
  176.             row = 3;    col = 12;   ko = 1
  177.             End  /*  When ..  Do  */
  178.         When  aid = '7C'x   /*  PF12 */ | ,
  179.               aid = '4C'x   /*  PF24 */ | ,
  180.               aid = 'F0'x   /* sysrq */ | ,
  181.               aid = '6C'x   /*  PA1  */ Then  quit = 1
  182.         When  aid = 'F1'x   /*  PF1  */ | ,
  183.               aid = 'C1'x   /*  PF13 */ Then  Call  HELP
  184.         When  aid = '00'x               Then Do
  185.             /*  I/O error on screen  */
  186.             'CALLPIPE COMMAND XMITMSG 925 (APPLID GOP' ,
  187.                     'CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
  188.             Leave
  189.             End
  190.         Otherwise  Do   /*  Undefined PFkey/PAkey  */
  191.             'CALLPIPE COMMAND XMITMSG 657 "' || c2x(aid) || '"' ,
  192.                 '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
  193.             End  /*  Otherwise  Do  */
  194.         End  /*  Select  aid  */
  195.  
  196.     Address "COMMAND" 'GLOBALV SELECT GOPHER GET COMMAND'
  197.     Parse Upper Var command cmdverb .
  198.     quit = (quit | Abbrev("QUIT",cmdverb,1))
  199.  
  200.     If quit Then Leave
  201.  
  202.     End  /*  Do  Forever  */
  203.  
  204. If quit Then command = "QUIT"
  205.  
  206. 'CALLPIPE STEM MESSAGE. | *:'
  207.  
  208. Parse Upper Var command cmdverb .
  209. Address "COMMAND" 'GLOBALV SELECT GOPHER PUT' ,
  210.         'COMMAND CMDVERB'
  211.  
  212. Exit
  213.  
  214.  
  215.  
  216. /* ---------------------------------------------------------------- OPEN
  217.  */
  218. OPEN:
  219.  
  220. 'CALLPIPE VAR MENU.' || i '| GOPCLITM OPEN | STEM MESSAGE. APPEND'
  221.  
  222. Return
  223.  
  224.  
  225.  
  226. /* --------------------------------------------------------------- PRINT
  227.  * Print the current "menu" on the user's virtual printer.
  228.  */
  229. PRINT:
  230.  
  231. If fs.tube ^= "" Then Do
  232.     /*  "Can't PRINT from this terminal."  */
  233.     'CALLPIPE COMMAND XMITMSG 507 (APPLID GOP CALLER CLI ERRMSG' ,
  234.             '| STEM MESSAGE. APPEND'
  235.     Return
  236.     End /* If .. Do */
  237.  
  238. 'CALLPIPE STEM MENU. | XLATE *-* 05 7A' ,
  239.         '| PRINT (TITLE' name '| STEM MESSAGE. APPEND'
  240.  
  241. Return
  242.  
  243.  
  244.  
  245. /* ---------------------------------------------------------------- KEEP
  246.  */
  247. KEEP:
  248.  
  249. 'CALLPIPE VAR MENU.' || i '| GOPCLITM KEEP | STEM MESSAGE. APPEND'
  250.  
  251. Return
  252.  
  253.  
  254.  
  255. /* ---------------------------------------------------------------- FIND
  256.  *  Find a particular string within the menu being viewed.
  257.  *  Call GOPCLIUI for user input with prompt.
  258.  */
  259. FIND:
  260.  
  261. 'CALLPIPE COMMAND XMITMSG 602 "' || needle || '" (APPLID GOP' ,
  262.         'CALLER CLI NOHEADER | GOPCLIUI | VAR NEEDLE'
  263. needle = Translate(Strip(needle))
  264. If needle = "" Then Return
  265.  
  266. Do i = ko + 1 to ki
  267.     If Index(Translate(menu.i),needle) > 0 Then Do
  268.         ko = i
  269.         Return
  270.         End  /*  If  ..  Do  */
  271.     End  /*  Do  For  */
  272.  
  273. /*  'CALLPIPE COMMAND XMITMSG 546 (ERRMSG'  CALLER DMS is OK  */
  274. /*  "Target not found"  */
  275. 'CALLPIPE COMMAND XMITMSG 546 (APPLID GOP CALLER CLI ERRMSG' ,
  276.         '| STEM MESSAGE. APPEND'
  277.  
  278. Return
  279.  
  280.  
  281.  
  282. /* ---------------------------------------------------------------- MARK
  283.  *  Save a bookmark referencing this menu,
  284.  *  or  (if in "booklist" mode)  delete the bookmark at the cursor.
  285.  */
  286. MARK:
  287.  
  288. If fs.tube ^= "" Then Do
  289.     /*  "Can't set bookmarks from this screen."  */
  290.     'CALLPIPE COMMAND XMITMSG 43 (APPLID GOP CALLER CLI ERRMSG' ,
  291.             '| STEM MESSAGE. APPEND'
  292.     Return
  293.     End /* If .. Do */
  294.  
  295. If booklist Then Do
  296.     'CALLPIPE COMMAND XMITMSG 42 I (APPLID GOP NOHEADER' ,
  297.         '| SPEC /i            / 1 1-* NEXT | VAR BOOKMARK.' || i
  298.     If rc = 0 Then
  299.     Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
  300.     If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 42 I' ,
  301.         '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
  302.         /*  "Bookmark" i "deleted."  */
  303.     Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,
  304.         '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
  305.     Return
  306.     End /* If .. Do */
  307.  
  308. Address "COMMAND" 'GLOBALV SELECT GOPHER GET BOOKMARK.0'
  309. If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0
  310. i = bookmark.0 + 1
  311. bookmark.i = item
  312. Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
  313. bookmark.0 = i
  314. Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'
  315.  
  316. If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 41 I' ,
  317.     '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
  318.     /*  "Bookmark" i "saved."  */
  319.           Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,
  320.         '(APPLID GOP CALLER CLI ERRMSG | STEM MESSAGE. APPEND'
  321.  
  322. Return
  323.  
  324.  
  325.  
  326. /* ------------------------------------------------------------ BOOKLIST
  327.  *  Call GOPCLI to show the lit of bookmarks.
  328.  */
  329. BOOKLIST:
  330.  
  331. Address "CMS" 'GOPCLI (BOOKLIST'
  332.  
  333. Return
  334.  
  335.  
  336.  
  337. /* ----------------------------------------------------------------- FIX
  338.  * Takes an inbound 3270 DS screen address (two bytes)
  339.  * and returns the equivalent byte offset in decimal.
  340.  */
  341. FIX:
  342. Parse Arg o,.
  343. Parse Var o 1 o1 2 o2 3 .
  344. o1 = c2d(o1)
  345. o2 = c2d(o2)
  346. If o1 < 64 Then Return o1 * 256 + o2
  347.            Else Return (o1 // 64) * 64 + (o2 // 64)
  348.  
  349.  
  350.  
  351. /* ---------------------------------------------------------- WRITE_READ
  352.  * Display what we have, then wait for user input and return it.
  353.  */
  354. WRITE_READ: Procedure Expose fs.
  355. Parse Arg ws,wcc,wrt,.
  356. If wcc = "" Then wcc = 'C3'x
  357. /*  If wrt = "" Then wrt = 'C0'x  */
  358. If wrt = "" Then wrt = fs.write
  359. ws = wrt || wcc || ws
  360. 'CALLPIPE VAR WS | FULLSCR' fs.tube '| VAR RS'
  361. If rc ^= 0 Then rs = '000000'x
  362. Return rs
  363.  
  364.  
  365.  
  366. /* ----------------------------------------------------------------- SBA
  367.  * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
  368.  * Construct Set Buffer Address order from row and column.
  369.  */
  370.  
  371. SBA:      Procedure Expose fs.
  372.  
  373. arg row , col, .
  374. row = Trunc(row)
  375. col = Trunc(col)
  376.  
  377. /*-----------------------------------------------------------------*/
  378. /* Calculate binary address.                                       */
  379. /*-----------------------------------------------------------------*/
  380.  
  381. offset = row * fs.scrcols + col
  382. Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End
  383.  
  384. if fs.14bit then return '11'x || d2c(offset,2)
  385.  
  386. /*-----------------------------------------------------------------*/
  387. /* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
  388. /*-----------------------------------------------------------------*/
  389.  
  390. 'CALLPIPE var offset'               ,   /* Start with char number.    */
  391.     '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
  392.     '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
  393.     '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
  394.            '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
  395.     '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
  396.     '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
  397.                 '01-09 C1-C9'       ,   /*   buffer address.          */
  398.                 '11-19 D1-D9'       ,   /*                            */
  399.                 '22-29 E2-E9'       ,   /*                            */
  400.                 '30-39 F0-F9'       ,   /*                            */
  401.     '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
  402.     '| var offset'                      /* Put back in variable.      */
  403.  
  404. Return offset
  405.  
  406.  
  407.  
  408. /* --------------------------------------------------------------- FIELD
  409.  * Generate the 3270 DS sequence for extended field attributes
  410.  * (if available).
  411.  */
  412. FIELD:    Procedure Expose fs.
  413. a = '00'x
  414. b = '00'x
  415. c = 'F1'x
  416. i = 1
  417. Do While Arg(i) ^= ""
  418.     Select  /*  at  */
  419.         When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)
  420.         When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)
  421.         When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)
  422.         When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)
  423.         When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)
  424.         When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)
  425.         When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)
  426.         When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x
  427.         When Abbrev("RED",Arg(i),3)         Then c = 'F2'x
  428.         When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x
  429.         When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x
  430.         When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x
  431.         When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x
  432.         When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x
  433.         Otherwise nop
  434.         End  /*  Select  at  */
  435.     i = i + 1
  436.     End  /*  Do  While  */
  437.  
  438. If  ^fs.color   | ,
  439.     ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)
  440.                 Else    Return '2902'x || ,
  441.                                'C0'x   || bitor(a,'40'x) || ,
  442.                                '42'x   || bitor(c,'40'x)
  443.  
  444.  
  445.  
  446. /* ---------------------------------------------------------------- GTAG
  447.  *  Match the gopher data type to a national language  "tag"  string.
  448.  */
  449. GTAG:     Procedure
  450.  
  451. Parse Arg type
  452.  
  453.     Select  /*  type  */
  454.  
  455.         When type = '0' Then _tag = 700
  456.         When type = '1' Then _tag = 701
  457.         When type = '2' Then _tag = 702
  458.         When type = '3' Then _tag = 703
  459.         When type = '4' Then _tag = 704
  460.         When type = '5' Then _tag = 705
  461.         When type = '6' Then _tag = 706
  462.         When type = '7' Then _tag = 707
  463.         When type = '8' Then _tag = 708
  464.         When type = '9' Then _tag = 709
  465.         When type = 's' Then _tag = 767
  466.         When type = 'r' Then _tag = 766
  467.         When type = 'v' Then _tag = 770
  468.         When type = 'i' Then _tag = 757
  469.         When type = 'I' Then _tag = 725
  470.         When type = 'g' Then _tag = 755
  471.         When type = 'M' Then _tag = 729
  472.         When type = 'T' Then _tag = 736
  473.  
  474.         When type = ':' Then _tag = 710
  475.         When type = ';' Then _tag = 711
  476.         When type = '<' Then _tag = 712
  477.  
  478.         Otherwise            _tag = 908
  479.  
  480.         End  /*  Select  type  */
  481.  
  482. 'CALLPIPE COMMAND XMITMSG' _tag 'TYPE (APPLID GOP NOHEADER | VAR TAG'
  483.  
  484. Return tag
  485.  
  486.  
  487.  
  488. /* ---------------------------------------------------------------- HELP
  489.  *  Invoke CMS HELP for GOPHER BROWSER (the menu browser).
  490.  */
  491. HELP:     Procedure Expose fs. message.
  492.  
  493. If fs.tube ^= "" Then
  494.     'CALLPIPE COMMAND HELP GOPHER BROWSER (ALL NOSCREEN' ,
  495.         '| GOPCLIFV BROWSER HELP' ,
  496.             '| STEM MESSAGE. APPEND'
  497.  
  498. Else Do
  499.     Address "COMMAND" 'HELP GOPHER BROWSER'
  500.     Address "COMMAND" 'VMFCLEAR'
  501.     End  /*  Else  Do  */
  502.  
  503. Return
  504.  
  505.