$set sourceformat(variable) program-id. fileindex. * Use a config file to index a number of other files * Config file format: * Variable length records, semi-colon delimited * Fields: * 1) Line type * Values +,-,{,},.,# * + = expandable - all following "-" records are members * - = subsidiary to + record * { = nested expandable record * } = end nested record set (no other fields in record) * . = title/name pair (top level) * # = comment line * 2) Title to be displayed * 3) File type (can be omitted for + and { lines) * Values D/F/B * D = directory (view with filemanager) * F = text file (view with fileview) * B = binary file (view with hexview) * 4) File name (can be omitted for + and { lines) * Absolute name of target - can be environment variable * * The display isn't very sophisticated which makes things simpler *author. Mike Fleming. special-names. console is crt crt status is ws-key-status. file-control. select config-file assign config-file-name organization line sequential file status ws-file-status. file section. fd config-file. 01 config-rec pic x(200). working-storage section. * External variables to allow communication with viewers 01 extdirname pic x(200) external. 01 extfilename pic x(200) external. 01 extlineno pic 9(9) comp external. 01 extline pic x(5000) external. 01 ws-command-line pic x(200). 01 ws-line-tbl. 03 ws-line-entry occurs 5000 times. 05 ws-line-type pic x. 05 ws-line-title pic x(40). 05 ws-line-ftype pic x. 05 ws-line-fname pic x(150). 05 ws-line-level pic 9. 05 ws-line-visible pic x. 88 line-visible value "Y" false "N". 05 ws-line-expanded pic x. 88 line-expanded value "Y" false "N". 01 ws-line-cnt pic 9(4) comp. 01 ws-line-ptr pic 9(4) comp. 01 ws-line-num pic 9(4). 01 ws-visible-line-tbl. 03 ws-visible-line pic 9(4) comp occurs 5000 times. 01 ws-visible-line-cnt pic 9(4) comp. 01 ws-scr-tbl. 03 ws-scr-line occurs 25 times. 05 ws-scr-type pic x. *> Only shows "+" 05 ws-scr-title. 07 filler pic x(2). 07 ws-scr-subsid-title pic x(40). 01 ws-scr-ptr pic 9(4) comp. * linked-type is necessary in the following table as we want to * know the type of each line on the screen but we're only making * "+" visible 01 ws-linked-tbl. 03 ws-linked-entry occurs 25 times. 05 ws-linked-ptr pic 9(4) comp. 05 ws-linked-type pic x. 01 ws-from pic 9(4) comp. 01 ws-last-scr-line pic 9(2) comp. 01 ws-scr-line-no pic 9(2). 01 ws-last-line-on-scr-ind pic x. 88 last-line-on-scr value "Y" false "N". 01 ws-valid-config-ind pic x. 88 valid-config value "Y" false "N". 01 ws-highlight-line-ind pic x. 88 highlight-line value "Y" false "N". 01 ws-exp-levels pic x(10). 01 ws-l pic 9(4) comp. 01 ws-name-len pic 9(4) comp. 01 ws-ptr pic 9(4) comp. 01 ws-level pic 9. 01 ws-scr-offset pic 9(2). * Cursor positioning 01 ws-linecol. 03 ws-line pic 9(2). 03 ws-col pic 9(2) value 1. 01 ws-exp-linecol. 03 ws-exp-line pic 9(2). 03 ws-exp-col pic 9(2) value 1. 01 ws-keypress pic x. 01 ws-line-ctrl. 03 filler value "foreground-colour ". 03 ws-line-fg pic x. * Status fields 01 ws-file-status. 88 valid-io values "00" "02". 88 end-of-file value "10". 03 ws-file-status-1 pic x. 03 ws-file-status-2 pic x comp-5. 01 ws-file-status-disp pic 9(3). 01 ws-key-status. 03 ws-key-type pic x. 88 Accept-terminated value "0". 88 User-func value "1". 88 ADIS-key value "2". 88 Data-key value "3". 03 ws-key-code-1 pic 9(2) comp-x. 88 Escape-key value zero. *> With key type 1 88 F-key values 1 through 12. 88 F1 value 1. *> With key type 1 88 F2 value 2. *> With key type 1 88 F3 value 3. *> With key type 1 88 F4 value 4. *> With key type 1 88 F5 value 5. *> With key type 1 88 F6 value 6. *> With key type 1 88 F7 value 7. *> With key type 1 88 F8 value 8. *> With key type 1 88 F9 value 9. *> With key type 1 88 F10 value 10. *> With key type 1 88 F11 value 11. *> With key type 1 88 F12 value 12. *> With key type 1 * For some reason, Company2 has non-standard mappings 66 and 67 for * paging keys which should theoretically be Alt-B and Alt-C 88 Page-Up value 53. *> With key type 1 nonstd 88 Page-Up-nonstd value 66. *> With key type 1 ** 88 Page-Down value 54. *> With key type 1 nonstd 88 Page-Down-nonstd value 67. *> With key type 1 ** 88 Ctrl-Page-Up value 55. *> With key type 1 88 Ctrl-Page-Down value 56. *> With key type 1 88 Enter-key value 48. *> With key type 0 88 Enter-key-ADIS value zero 2. *> With key type 2 88 cursor-left value 3. *> With key type 2 88 cursor-right value 4. *> With key type 2 88 cursor-up value 5. *> With key type 2 88 cursor-down value 6. *> With key type 2 * For some reason, Company2 has non-standard mappings 69 and 72 for * Home/End keys which should theoretically be Alt-E and Alt-H, and * 71 for Delete key which should theoretically be Alt-G 88 Home-key value 7. *> With key type 2 nonstd 88 Home-key-nonstd value 69. *> With key type 1 ** 88 Tab-key value 8 11. *> With key type 2 88 Backtab-key value 9 12. *> With key type 2 88 End-key value 10. *> With key type 2 nonstd 88 End-key-nonstd value 72. *> With key type 1 ** 88 Insert-key value 16. *> With key type 2 88 Delete-key value 17. *> With key type 2 nonstd 88 Delete-key-nonstd value 71. *> With key type 1 ** 88 Ctrl-E value 22. *> With key type 2 88 Ctrl-F value 13. *> With key type 2 88 Ctrl-key value 49. *> With key type 0 03 ws-key-code-2 pic x comp-x. * With key type 0, key-code-1 49 88 Ctrl-B value 2. 88 Ctrl-G value 7. 01 get-single-char-func pic 9(2) comp-x value 26. 01 ws-adis-panel-function pic 9(2) comp-x. 01 ws-adis-panel-dummy-param pic x. 01 ws-set-bit-pairs pic 9(2) comp-x value 1. 01 ws-key-control. 03 ws-key-setting pic 9(2) comp-x. 03 ws-key-control-type pic x value "1". 03 ws-first-key. 05 ws-first-key-num pic 9(2) comp-x. 03 ws-num-of-keys pic 9(2) comp-x. 01 ws-shell pic x(1000). 78 c-scr-lines value length ws-scr-tbl / length ws-scr-line. 78 c-max-lines value length ws-line-tbl / length ws-line-entry. 78 black value zero. 78 blue value 1. 78 green value 2. 78 cyan value 3. 78 red value 4. 78 magenta value 5. 78 yellow value 6. 78 white value 7. 78 black-x value "0". 78 blue-x value "1". 78 green-x value "2". 78 cyan-x value "3". 78 red-x value "4". 78 magenta-x value "5". 78 yellow-x value "6". 78 white-x value "7". screen section. 01 ss-main background-colour black foreground-colour white. 03 blank screen. 03 line 1. 03 scr-view-area. 05 scr-view-entry occurs 25 times. 07 col 1 pic x(80) from ws-scr-line. 07 line + 1. 01 ss-help background-colour black foreground-colour yellow. 03 blank screen. 03 line 2. 03 col 4 value "Escape". 03 col 20 value "End". 03 line + 1. 03 col 4 value "F1". 03 col 20 value "Show this screen". 03 line + 2. 03 col 4 value "Enter". 03 col 20 value "Expandable lines with '+' by them - expand". 03 line + 1. 03 col 20 value "Expandable lines with '-' by them - collapse". 03 line + 1. 03 col 20 value "Other lines - view directory or file". 03 line + 2. 03 col 4 value "+". 03 col 20 value "Expand expandable line". 03 line + 2. 03 col 4 value "-". 03 col 20 value "Collapse expandable lines". 03 line + 2. 03 col 4 value "Cursor right". 03 col 20 value "Expandable lines - if file or directory is defined". 03 line + 1. 03 col 20 value "for them, view directory or file". 03 line + 2. 03 col 4 value "Cursor left". 03 col 20 value "Go to the parent, collapsing the current item if it". 03 line + 1. 03 col 20 value "is expanded". procedure division. a-control section. perform b1-start perform b5-main until (User-func and Escape-key) perform b9-end goback . b1-start section. accept config-file-name from command-line if config-file-name = spaces display "Please supply config file name" goback end-if open input config-file if not valid-io display "Error opening config file " config-file-name if ws-file-status-1 = "9" move ws-file-status-2 to ws-file-status-disp display "File status 9/" ws-file-status-disp else display "File status " ws-file-status end-if goback end-if * Set F1-F10 and Escape to be intercepted by the program move "1" to ws-key-control-type move 1 to ws-key-setting move zero to ws-first-key-num move 13 to ws-num-of-keys call x"AF" using ws-set-bit-pairs ws-key-control perform x1-intercept-cursor-keys move zero to ws-line-cnt ws-line-num read config-file at end continue end-read move 1 to ws-level set valid-config to true perform until end-of-file or ws-line-cnt >= c-max-lines add 1 to ws-line-num evaluate true when config-rec = spaces when config-rec(1:1) = "#" continue when config-rec(1:1) = "}" if ws-level > 1 subtract 1 from ws-level else display "Line " ws-line-num display "Too many '}'s" set valid-config to false end-if when other add 1 to ws-line-cnt unstring config-rec delimited by ";" into ws-line-type(ws-line-cnt) ws-line-title(ws-line-cnt) ws-line-ftype(ws-line-cnt) ws-line-fname(ws-line-cnt) move function upper-case(ws-line-ftype(ws-line-cnt)) to ws-line-ftype(ws-line-cnt) evaluate ws-line-type(ws-line-cnt) when "{" move ws-level to ws-line-level(ws-line-cnt) add 1 to ws-level set line-visible(ws-line-cnt) to false when "+" when "." if ws-level > 2 display "Line " ws-line-num at 1205 display config-rec at 1305 display "Subdirectory prior to this not terminated" at 1405 set valid-config to false else move 1 to ws-line-level(ws-line-cnt) move 2 to ws-level set line-visible(ws-line-cnt) to true end-if when other move ws-level to ws-line-level(ws-line-cnt) set line-visible(ws-line-cnt) to false end-evaluate set line-expanded(ws-line-cnt) to false end-evaluate read config-file at end continue end-read end-perform close config-file if ws-line-cnt not < c-max-lines display "Config file more than " c-max-lines " long" set valid-config to false end-if if not valid-config display "Press any key" accept ws-keypress at 2580 auto goback end-if move 1 to ws-from ws-line perform x7-scan-visible-lines perform s1-display-screen . b5-main section. * ws-l is the line in the main array corresponding to the * current screen line move ws-linked-ptr(ws-line) to ws-l * Get the keypress and redisplay whatever was in that position move ws-scr-line(ws-line)(ws-col:1) to ws-keypress accept ws-keypress at ws-linecol auto display ws-scr-line(ws-line)(ws-col:1) at ws-linecol control ws-line-fg move function upper-case(ws-keypress) to ws-keypress * Check which key has been pressed and action accordingly * It's a big evaluate statement but not complex so I've left it * as is rather than splitting it up evaluate true also true when User-func also F1 perform c1-show-help when Accept-terminated also Ctrl-key evaluate ws-keypress when "+" if ws-linked-type(ws-line) = "+" or "{" perform c3-expand-subsids perform x7-scan-visible-lines perform s1-display-screen end-if when "-" if ws-linked-type(ws-line) = "+" or "-" or "{" perform c5-collapse-subsids perform x7-scan-visible-lines perform s1-display-screen end-if when "T" if ws-line-ftype(ws-l) = "F" move spaces to ws-shell string "/usr/bin/clear;/usr/bin/tail -f " delimited by size ws-line-fname(ws-l) delimited by space x'00' delimited by size into ws-shell call "SYSTEM" using ws-shell perform s1-display-screen end-if end-evaluate when User-func also Page-Up *> Go one page back nonstd when User-func also Page-Up-nonstd if ws-from > 1 evaluate ws-from when > c-scr-lines subtract c-scr-lines from ws-from when other move 1 to ws-from end-evaluate move 1 to ws-line perform s1-display-screen end-if when User-func also Page-Down *> Go down a page nonstd when User-func also Page-Down-nonstd evaluate true when ws-visible-line-cnt < c-scr-lines move 1 to ws-from move ws-visible-line-cnt to ws-line when ws-from + c-scr-lines > ws-visible-line-cnt compute ws-from = (ws-visible-line-cnt - c-scr-lines) + 1 move c-scr-lines to ws-line when other add c-scr-lines to ws-from move 1 to ws-line end-evaluate perform s1-display-screen when ADIS-key also cursor-up * Go up a line evaluate true when ws-line > 1 * not at start of screen, move highlight up set highlight-line to false perform x5-display-line subtract 1 from ws-line set highlight-line to true perform x5-display-line when ws-from > 1 * at start of screen, move screen window up subtract 1 from ws-from perform s1-display-screen end-evaluate when ADIS-key also cursor-down * Go down a line evaluate true when (ws-from + ws-line) > ws-visible-line-cnt * at end continue when ws-line < ws-last-scr-line * not at end of screen, move highlight down set highlight-line to false perform x5-display-line add 1 to ws-line set highlight-line to true perform x5-display-line when last-line-on-scr continue when ws-from < ws-line-cnt * at end of screen, move screen window down add 1 to ws-from perform s1-display-screen end-evaluate when ADIS-key also Home-key nonstd when User-func also Home-key-nonstd move 1 to ws-from ws-line perform s1-display-screen when ADIS-key also End-key nonstd when User-func also End-key-nonstd move 1 to ws-line set highlight-line to false perform x5-display-line if ws-visible-line-cnt > c-scr-lines compute ws-from = (ws-visible-line-cnt - c-scr-lines) + 1 move c-scr-lines to ws-line else move 1 to ws-from move ws-visible-line-cnt to ws-line end-if set highlight-line to true perform x5-display-line when ADIS-key also cursor-right evaluate true when ws-line-fname(ws-l) = spaces when ws-line-ftype(ws-l) = spaces continue when ws-line-ftype(ws-l) = "F" move ws-line-fname(ws-l) to extfilename call "fileview" when ws-line-ftype(ws-l) = "B" move ws-line-fname(ws-l) to extfilename call "hexview" when ws-line-ftype(ws-l) = "D" move ws-line-fname(ws-l) to extdirname call "filemanager" end-evaluate perform s1-display-screen when ADIS-key also cursor-left if ws-line-level(ws-l) > 1 move ws-line-level(ws-l) to ws-level perform varying ws-l from ws-l by -1 until ws-line-level(ws-l) < ws-level end-perform if ws-linked-ptr(1) > ws-l move ws-l to ws-from move 1 to ws-line else perform varying ws-line from 1 by 1 until ws-linked-ptr(ws-line) = ws-l end-perform end-if perform s1-display-screen end-if when Accept-terminated also Enter-key when ADIS-key also Enter-key-ADIS evaluate true when ws-linked-type(ws-line) = "+" when ws-linked-type(ws-line) = "{" if line-expanded(ws-l) perform c5-collapse-subsids else perform c3-expand-subsids end-if perform x7-scan-visible-lines when ws-line-fname(ws-l) = spaces continue when ws-line-ftype(ws-l) = "F" move ws-line-fname(ws-l) to extfilename call "fileview" when ws-line-ftype(ws-l) = "B" move ws-line-fname(ws-l) to extfilename call "hexview" when ws-line-ftype(ws-l) = "D" move ws-line-fname(ws-l) to extdirname call "filemanager" end-evaluate perform s1-display-screen end-evaluate . b9-end section. * Nothing to see here. Move along. . c1-show-help section. display ss-help accept ws-keypress at 2580 auto set Accept-terminated to true *> Don't end if Esc pressed perform s1-display-screen . c3-expand-subsids section. * Set the parent to "line expanded" * Set all children (not lower levels) to "line visible" move ws-linked-ptr(ws-line) to ws-ptr set line-expanded(ws-ptr) to true compute ws-level = ws-line-level(ws-ptr) + 1 add 1 to ws-ptr * As well as making the level immediately below visible, if any * members of the level below are type "{" and already expanded, * we want to make their lower level visible too. If ws-exp-levels * contains a contiguous stream of "Y"s from the owning level to * the level of the item, all levels above are expanded so item * should be visible. move spaces to ws-exp-levels perform varying ws-ptr from ws-ptr by 1 until ws-ptr > ws-line-cnt or (ws-line-type(ws-ptr) = "+" or ".") or (ws-line-type(ws-ptr) = "{" and ws-line-level(ws-ptr) < ws-level) if ws-line-level(ws-ptr) = ws-level or (ws-line-level(ws-ptr) > ws-level and ws-exp-levels(ws-level: ws-line-level(ws-ptr) - ws-level) = all "Y") set line-visible(ws-ptr) to true end-if if ws-line-type(ws-ptr) = "{" if line-expanded(ws-ptr) move "Y" to ws-exp-levels( ws-line-level(ws-ptr):1) else move space to ws-exp-levels( ws-line-level(ws-ptr):1) end-if end-if end-perform . c5-collapse-subsids section. * Set the parent to "line not expanded" * Set all children to "line not visible" move ws-linked-ptr(ws-line) to ws-ptr if ws-line-type(ws-ptr) = "-" or (ws-line-type(ws-ptr) = "{" and not line-expanded(ws-ptr)) move ws-line-level(ws-ptr) to ws-level if ws-ptr > 1 subtract 1 from ws-ptr end-if perform varying ws-ptr from ws-ptr by -1 until ws-ptr = 1 or ws-line-type(ws-ptr) = "+" or (ws-line-type(ws-ptr) = "{" and ws-line-level(ws-ptr) not > ws-level) end-perform if ws-from < ws-ptr compute ws-line = ws-line - (ws-linked-ptr(ws-line) - ws-ptr) else move ws-ptr to ws-from move 1 to ws-line end-if end-if set line-expanded(ws-ptr) to false compute ws-level = ws-line-level(ws-ptr) + 1 * Hide everything below this level until we get to something which * is higher level add 1 to ws-ptr perform varying ws-ptr from ws-ptr by 1 until ws-ptr > ws-line-cnt or ws-line-type(ws-ptr) = "+" or "." or ws-line-level(ws-ptr) < ws-level set line-visible(ws-ptr) to false end-perform . s1-display-screen section. * Nothing terribly complex, just work out the range of lines * to display and put them into the scr-line array * Note that there is something of a profusion of "type" fields * to show expandable or title/name pair. This is because we're * only making "+" visible, so to make things easy, we have a linked * type field which shows the type for each line on the screen. move spaces to ws-scr-tbl ws-linked-tbl move zero to ws-scr-ptr if ws-ptr < 1 display "No lines to display" goback end-if perform varying ws-ptr from ws-from by 1 until ws-ptr > ws-visible-line-cnt or ws-scr-ptr >= c-scr-lines add 1 to ws-scr-ptr move ws-visible-line(ws-ptr) to ws-line-ptr move spaces to ws-scr-line(ws-scr-ptr) evaluate ws-line-type(ws-line-ptr) when "." move ws-line-title(ws-line-ptr) to ws-scr-line(ws-scr-ptr)(2:) when "+" if line-expanded(ws-line-ptr) move "-" to ws-scr-line(ws-scr-ptr)(1:1) else move "+" to ws-scr-line(ws-scr-ptr)(1:1) end-if move ws-line-title(ws-line-ptr) to ws-scr-line(ws-scr-ptr)(2:) when "{" compute ws-scr-offset = (ws-line-level(ws-line-ptr) * 2) - 1 if line-expanded(ws-line-ptr) move "-" to ws-scr-line(ws-scr-ptr) (ws-scr-offset:1) else move "+" to ws-scr-line(ws-scr-ptr) (ws-scr-offset:1) end-if add 1 to ws-scr-offset move ws-line-title(ws-line-ptr) to ws-scr-line(ws-scr-ptr) (ws-scr-offset:) when "-" compute ws-scr-offset = ws-line-level(ws-line-ptr) * 2 move ws-line-title(ws-line-ptr) to ws-scr-line(ws-scr-ptr) (ws-scr-offset:) end-evaluate move ws-line-ptr to ws-linked-ptr(ws-scr-ptr) move ws-line-type(ws-line-ptr) to ws-linked-type(ws-scr-ptr) end-perform move ws-scr-ptr to ws-last-scr-line if ws-ptr > ws-visible-line-cnt set last-line-on-scr to true else set last-line-on-scr to false end-if * Now display the main screen and highlight the current line display ss-main perform varying ws-ptr from 1 by 1 until ws-ptr > c-scr-lines if ws-linked-type(ws-ptr) = "+" or "-" or "{" move ws-ptr to ws-exp-line display ws-scr-line(ws-ptr) at ws-exp-linecol mode block foreground-colour yellow end-if end-perform set highlight-line to true perform x5-display-line . x1-intercept-cursor-keys section. * Set the cursor-moving ADIS keys to be intercepted by the program move "2" to ws-key-control-type move 1 to ws-key-setting move 3 to ws-first-key-num move 10 to ws-num-of-keys call x"AF" using ws-set-bit-pairs ws-key-control . x3-pass-cursor-keys section. * Set the cursor-moving ADIS keys to normal behaviour move "2" to ws-key-control-type move 2 to ws-key-setting move 3 to ws-first-key-num move 10 to ws-num-of-keys call x"AF" using ws-set-bit-pairs ws-key-control . x5-display-line section. if highlight-line if ws-linked-type(ws-line) = "." move cyan-x to ws-line-fg else move magenta-x to ws-line-fg end-if else if ws-linked-type(ws-line) = "." move white-x to ws-line-fg else move yellow-x to ws-line-fg end-if end-if display ws-scr-line(ws-line) at ws-linecol mode block control ws-line-ctrl . x7-scan-visible-lines section. move zero to ws-visible-line-cnt perform varying ws-ptr from 1 by 1 until ws-ptr > ws-line-cnt if (ws-line-type(ws-ptr) = "-" or "{") and not line-visible(ws-ptr) exit perform cycle end-if add 1 to ws-visible-line-cnt move ws-ptr to ws-visible-line(ws-visible-line-cnt) end-perform . end program fileindex.