copy "cblproto.cpy". $set sourceformat(variable) program-id. hexview. * File viewer - window onto a file, displaying in hex * Parameter 1 (optional) - file name * * If not supplied, request a file name * If character 1 is "<", take the rest of the command line as * the file name as pipe may have embedded spaces * * Note that STDIN: should not be used as an input file name as * this then makes the terminal unreachable to accept keypresses. * In order to pipe into fileview, the calling script should cat * stdin to a temporary file, then redirect input to /dev/tty and * call fileview using the temporary file as input. * Parameter 2 (optional) - record length * * Used for files with fixed length records which might not have * record terminators. Useful when records might contain x'0a' as * part of the data. Note that if there is a terminator, it will * be shown. * Use bytestream handling to read file as it can have embedded * tab characters in it and this allows them to be read raw without * messing with file handler configurations. *author. Mike Fleming. special-names. crt status is ws-key-status console is crt cursor is ws-cursor. working-storage section. copy "cbltypes.cpy". * Type definitions of C data types for use calling C programs 77 char pic s9(2) comp-5 is typedef. 77 uns-char pic 9(2) comp-5 is typedef. 77 short pic s9(4) comp-5 is typedef. 77 uns-short pic 9(4) comp-5 is typedef. 77 int pic s9(9) comp-5 is typedef. 77 uns-int pic 9(9) comp-5 is typedef. $IF P64 set 77 long pic s9(18) comp-5 is typedef. 77 uns-long pic 9(18) comp-5 is typedef. 77 size-t pic 9(18) comp-5 is typedef. 77 wchar-t pic 9(9) comp-5 is typedef. $ELSE 77 long pic s9(9) comp-5 is typedef. 77 uns-long pic 9(9) comp-5 is typedef. 77 size-t pic 9(9) comp-5 is typedef. 77 wchar-t pic 9(4) comp-5 is typedef. $END 77 l-long pic s9(18) comp-5 is typedef. 77 uns-l-long pic 9(18) comp-5 is typedef. 77 d-l-float comp-2 is typedef. 77 d-float comp-2 is typedef. 77 float comp-1 is typedef. 77 proc-pointer procedure-pointer is typedef. 77 data-pointer pointer is typedef. 77 void pic 9(2) comp-5 is typedef. 78 default-convention-val value 0. 78 cdecl-convention-val value 0. 78 pascal-convention-val value 11. 78 fast-convention-val value 2. 78 std-convention-val value 74. 78 sys-convention-val value 16. 78 opt-convention-val value 0. 78 pasc16-convention-val value 35. 78 cdec16-convention-val value 32. * End of type definitions * External variables to allow communication with filemanager 01 extfilename pic x(200) external. 01 extlineno pic 9(9) comp external. 01 extline pic x(5000) external. 01 ws-cobdata pic x(1000). 01 ws-shell pic x(250). 01 ws-command-line pic x(250). 01 ws-file-name pic x(250). 01 ws-disp-file-name pic x(60). 01 ws-last-file pic x(250). 01 ws-err-line-1 pic x(70). 01 ws-err-line-2 pic x(70). 01 ws-error-code pic s9(4) comp. 01 ws-fixed-rec-len pic 9(4) comp. 88 fixed-length values 1 through 9999. * Fields for COBOL bytestream file routines 01 ws-file-handle cblt-bytestream-handle. 01 ws-access-mode cblt-x1-compx value 1. 01 ws-deny-mode cblt-x1-compx value 1. 01 ws-device cblt-x1-compx value zero. 78 c-buff-len value 8192. 78 c-read-len value 128. 78 c-normal-read value zero. 01 ws-file-buff pic x(c-buff-len). 01 ws-file-offset cblt-x8-compx. 01 ws-byte-count cblt-x4-compx. 01 ws-flags cblt-x1-compx. 01 ws-buff-ptr pic 9(4) comp. 01 ws-rec-start pic 9(4) comp. 78 c-rec-len value 5000. 01 ws-rec pic x(c-rec-len). 01 ws-file-len cblt-x8-compx. * Associated fields for file errors 01 ws-verb pic x(10). 01 ws-file-status pic xx comp-x. 01 filler redefines ws-file-status. 88 valid-io value "00" "02". 88 end-of-file value "10". 88 dupl-key value "22". 88 no-rec value "23". 88 no-file value "35" x'390d'. *> 9/013 88 file-locked value "9A". *> 9/065 88 rec-locked value "9D". *> 9/068 03 ws-file-status-1 pic x. 03 ws-file-status-2. 05 ws-file-status-2-num pic x comp-x. 01 ws-file-status-2-disp pic 9(3). * Screen handling 78 c-scr-lines value 12. 78 c-scrline-len value 40. 01 ws-scr-start. 03 ws-scr-start-line pic 9(2) value 02. *> Adjust as required 03 ws-scr-start-col pic 9(2) value 01. 01 ws-scr-tbl. 03 ws-scr-line occurs c-scr-lines times. 05 ws-scr-char pic x occurs c-scrline-len times. 01 ws-scr-len-tbl. 03 ws-scr-line-len-x occurs c-scr-lines times. 05 ws-scr-line-len pic 9(4) comp. 01 ws-view-tbl. 03 ws-view-lines occurs c-scr-lines times. 05 ws-view-hex-line. 07 ws-view-hex-char occurs c-scrline-len times. 09 ws-view-hex-char-1 pic x. 09 ws-view-hex-char-2 pic x. 05 ws-view-printable-line. 07 ws-view-printable-chars occurs c-scrline-len times. 09 ws-view-printable-char pic x. 09 filler pic x. 01 ws-disp-char. 03 ws-disp-char-9 pic x comp-x. 01 ws-hex-mostsig pic 9(2) comp. 01 ws-hex-leastsig pic 9(2) comp. 01 ws-disp-hex-tbl value "0123456789abcdef". 03 ws-disp-hex pic x occurs 16 times. 01 ws-saved-line pic x(80). 01 ws-action pic x. 01 ws-keypress pic x. 01 ws-cursor. 03 ws-cursor-line pic 9(2). 03 ws-cursor-col pic 9(2). 01 ws-linecol. 03 ws-line pic 9(2). 03 ws-col pic 9(2). 01 ws-char-linecol. 03 ws-char-line pic 9(2). 03 ws-char-col pic 9(2). 01 ws-scr-linecol-tbl. 03 ws-scr-linecol pic 9(4) occurs 5 times. 01 ws-scr-end-key-tbl. 03 ws-scr-end-key-active pic x occurs 5 times. * Indicators 01 ws-indicators. 03 ws-ext-call-ind pic x. 88 ext-call value "Y" false "N". 03 ws-last-block-ind pic x. 88 last-block value "Y" false "N". 03 ws-allow-no-file-ind pic x. 88 allow-no-file value "Y" false "N". 03 ws-command-line-name-ind pic x. 88 command-line-name value "Y" false "N". 03 ws-cursor-wrap-ind pic x(4). 88 cursor-wrap value "WRAP" false spaces. 03 ws-string-found-ind pic x. 88 string-found value "Y" false "N". 03 ws-case-sensitive-ind pic x. 88 case-sensitive value "Y" false "N". 03 ws-end-key-active-ind pic x. 88 end-key-active value "Y" false "N". * Fields for searches 01 ws-search pic x(80). 01 ws-search-regexp pic x(81). 01 ws-uc-search pic x(80). 01 ws-search-type-ind pic x. 88 grep-search value "G". 88 string-search value "S". 01 ws-delim pic x(80). 01 ws-check-line pic x(c-rec-len). 01 ws-grep-line pic x(c-rec-len). 01 ws-dummy pic x(c-rec-len). 01 ws-search-msg pic x(80). 01 ws-system-text pic x(81). 01 ws-to-line-x pic x(7). * Counts and pointers 01 ws-counts-and-pointers. 03 ws-cobdata-len pic 9(4) comp. 03 ws-scr-range occurs 5 times. 05 ws-line-from pic s9(6) comp. 05 ws-line-to pic s9(6) comp. 05 ws-char-from pic 9(4) comp. 03 ws-scr pic 9 comp. 03 ws-max-len pic 9(4) comp. 03 ws-rec-len-x. 05 ws-rec-len pic 9(4) comp. 03 ws-line-len pic 9(4) comp. 03 ws-posn pic 9(4) comp. 03 ws-line-cnt pic s9(6) comp. 03 ws-last-line pic s9(6) comp. 03 ws-start-line pic s9(6) comp. 03 ws-last-top-line pic s9(6) comp. 03 ws-last-scr-char pic s9(6) comp. 03 ws-last-scr-line pic s9(4) comp. 03 ws-last-col pic 9(4) comp. 03 ws-offset pic s9(9) comp. 03 ws-offset-inc pic 9(4) comp. 03 ws-ptr pic s9(6) comp. 03 ws-disp-ptr pic s9(6) comp. 03 ws-scr-ptr pic 9(2) comp. 03 ws-tab-ptr pic 9(2) comp. 03 ws-l pic 9(2) comp. 03 ws-scr-chars pic 9(4) comp. 03 ws-last-char pic 9(4) comp. 03 ws-last-scrchar pic 9(4) comp. 03 ws-str-len pic 9(4) comp. 03 ws-to-line pic s9(6) comp. 03 ws-to-line-z pic z(5)9. 03 ws-delim-ptr pic 9(4) comp. 03 ws-search-msg-start pic 9(2) comp. 03 ws-text-ptr pic 9(2) comp. 03 ws-scrline pic 9(9) comp. 03 ws-scrcol pic 9(4) comp. 03 ws-vi-start pic 9(9). 03 ws-saved-col pic 9(2). 03 ws-line-start pic 9(9) comp. 03 ws-line-end pic 9(9) comp. 03 ws-line-posn pic 9(9) comp. * Screen handling - returned key values 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 km 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 which should 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. * ADIS functions 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. * Fields for regular expression search operation 01 ws-c-flags int. 01 ws-e-flags int. 01 ws-return int. 01 ws-error pic x(200). 01 ws-err-len size-t. 01 ws-regerror-len size-t. 01 ws-nmatch size-t. 01 ws-pmatch-tbl. 03 ws-pmatch occurs 10 times. 05 ws-pmatch-start long. 05 ws-pmatch-end long. 01 ws-regex-t. 03 re-nsub uns-long. 03 re-comp pointer. 03 re-cflags int. 03 re-erroff uns-long. 03 re-len uns-long. 03 re-min-col-val wchar-t. 03 re-max-col-val wchar-t. 03 re-cols occurs 10 times. 05 re-lsub pointer. 05 re-esub pointer. 03 re-map pic x(256). 03 re-maxsub int. 01 ws-safety-buffer pic x(2000). *> In case of overflow 78 reg-extended value 1. 78 reg-icase value 2. 78 reg-nosub value 4. 78 reg-newline value 8. 78 reg-notbol value x'100'. 78 reg-noteol value x'200'. * Fields for memory allocation 01 ws-view-mem-base cblt-pointer. 01 ws-line-mem-base cblt-pointer. 01 ws-mem-size cblt-os-size. 01 ws-mem-flags cblt-os-flags. 01 ws-call-status pic x(2) comp-5. 01 ws-mem-alloc-ind pic x. 88 mem-alloc value "Y" false "N". * End of memory allocation fields * Fields for virtual file 01 ws-vfile-id cblt-vfile-handle. 01 ws-vfile-status cblt-vfile-status. 01 ws-vfile-buff-len cblt-x4-comp5. 01 ws-vfile-offset cblt-x4-comp5. 01 ws-vfile-len cblt-x4-comp5. 01 ws-vfile-status-disp pic 9(6). * End of virtual file fields * Fields for full filename 01 ws-full-file-spec. 03 ws-full-file-name-len cblt-x2-compx. 03 ws-full-file-name pic x(70). 01 ws-mode cblt-x1-compx. 01 ws-exist-flag cblt-x1-compx. 01 ws-path-flag cblt-x1-compx. 01 ws-curr-dir-flags cblt-os-flags. 01 ws-dir-name-len cblt-os-size. 01 ws-dir-name pic x(70). * Save and redisplay char and attribute 01 ws-screen-position cblt-screen-position. 01 ws-saved-scr-char pic x. 01 ws-saved-scr-attr pic x. 01 ws-saved-scr-len cblt-x2-compx value 1. * Micellaneous constants 78 c-max-lines value 200000. 78 c-max-bytes value 2000000. 78 c-reclen-len value length ws-rec-len-x. 78 c-nmatch value length ws-pmatch-tbl / length ws-pmatch. 78 black value zero. 78 black-x value "0". 78 blue value 1. 78 blue-x value "1". 78 green value 2. 78 green-x value "2". 78 cyan value 3. 78 cyan-x value "3". 78 red value 4. 78 red-x value "4". 78 magenta value 5. 78 magenta-x value "5". 78 yellow value 6. 78 yellow-x value "6". 78 white value 7. 78 white-x value "7". 78 grey value 8. 78 grey-x value "8". linkage section. 01 ls-line-tbl. 03 ls-line-entry occurs c-max-lines depending on ws-line-cnt. 05 ls-line-offset pic 9(9) comp. 05 ls-line-len pic 9(4) comp. 01 ls-view-tbl. 03 ls-view-char pic x occurs c-max-bytes depending on ws-mem-size. screen section. 01 ss-file background-colour black foreground-colour white. 03 blank screen. 03 line 5 col 10 value "File:". 03 col + 2 pic x(40) using ws-file-name. * A note on the display - as we only display every other character * on the plain text line of the pair, we don't display at 2580 so * we can make full use of the screen (cf. fileview). 01 ss-main background-colour black foreground-colour white. 03 blank screen. 03 ss-mail-top-lines foreground-colour yellow. 05 line 1. 05 col 2 pic x(30) from ws-disp-file-name. 05 col + 2 pic z(4)9 from ws-line-from(ws-scr). 05 col + 1 value "-". 05 col + 1 pic z(4)9 from ws-line-to(ws-scr). 05 col + 1 value " of ". 05 col + 1 pic z(4)9 from ws-last-line. 05 col + 3 value "Screen". 05 col + 2 pic 9 from ws-scr. 05 scr-linecol. 07 col + 2 pic z(4)9 from ws-scrline. 07 col + 2 pic z(3)9 from ws-scrcol. 03 scr-view-area. 05 scr-view-entry occurs c-scr-lines times. 07 line + 1. 07 col 1 pic x(80) from ws-view-hex-line. 07 line + 1. 07 col 1 pic x(80) from ws-view-printable-line. 01 ss-help background-colour black foreground-colour yellow. 03 blank screen. 03 line 2. 03 col 2 value "Escape". 03 col 14 value "End". 03 line + 1. 03 col 2 value "F1". 03 col 14 value "Show this screen". 03 line + 1. 03 col 2 value "F2 to F5". 03 col 14 value "Toggle between screens". 03 line + 1. 03 col 14 value "You can have up to five windows on the file, called screens 1-5.". 03 line + 1. 03 col 14 value "These are selected by pressing keys F2-F5 for screens 2-5. If". 03 line + 1. 03 col 14 value "a key F2-F5 is pressed when on the corresponding screen, the view". 03 line + 1. 03 col 14 value "will toggle to screen 1. For example, if you're on screen 2 and". 03 line + 1. 03 col 14 value "press F4, you'll be taken to screen 4 - if you then press F4". 03 line + 1. 03 col 14 value "again, you'll be toggled into screen 1.". 03 line + 1. 03 col 2 value "F10". 03 col 14 value "Reload file and go back to start.". 03 line + 1. 03 col 2 value "F11". 03 col 14 value "Load another file.". 03 line + 2. 03 col 2 value "F, /". 03 col 14 value "Search - can be either a simple search or a regular expression". 03 line + 1. 03 col 2 value "G". 03 col 14 value "Go to line number". 03 line + 1. 03 col 2 value "R, >, L, <". 03 col 14 value "Page right or left". 03 line + 1. 03 col 2 value "], [". 03 col 14 value "Word right or left". 03 line + 1. 03 col 2 value "Home, End". 03 col 14 value "Go to start or end of line". 03 line + 1. 03 col 2 value "V". 03 col 14 value "Execute vi on the file, then reload it". 03 line + 1. 03 col 2 value "!". 03 col 14 value "Execute a shell command". 03 line + 1. 03 col 2 value ":". 03 col 14 value "Enter a shell session (^D to exit)". 03 line + 1. 03 col 2 value "?". 03 col 14 value "Show file name and current directory". 03 line 25. 03 col 60 value "Press any key". 01 ss-search background-colour black foreground-colour yellow. 03 blank screen. 03 line 5. 03 col 10 value "Search string:". 03 line + 1. 03 col 1 pic x(80) using ws-search. 03 line + 2. 03 col 10 value "For regular expression, start and end with one of /, ?, or =". 03 line + 1. 03 col 10 value "For case sensitive search, append c to the regular expression". 03 line + 2. 03 col 1 pic x(80) from ws-search-msg. 01 ss-go-to background-colour black foreground-colour yellow. 03 blank screen. 03 line 5. 03 col 10 value "Go to line:". 03 col + 2 using ws-to-line-x. 03 col + 2 value "(absolute or relative)". 03 line + 2. 03 col 20 value "- = start of file, + = end of file". 01 ss-system-call background-colour black foreground-colour yellow. 03 blank screen. 03 line 5. 03 col 1 value "Command to execute:". 03 line + 1. 03 col 1 pic x(80) using ws-system-text. procedure division. a-control section. perform b1-start perform b5-main until User-func and Escape-key perform b9-end goback . b1-start section. * 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 1 to ws-last-line move spaces to ws-last-file set allow-no-file to false move spaces to ws-file-name move zero to ws-fixed-rec-len * Because we're using the CBL_ file routines, COBDATA needs to * include current directory in its path display "COBDATA" upon environment-name accept ws-cobdata from environment-value if ws-cobdata = spaces move zero to ws-cobdata-len else perform varying ws-cobdata-len from length ws-cobdata by -1 until ws-cobdata(ws-cobdata-len:1) not = space end-perform end-if if ws-cobdata(1:1) not = ":" move spaces to ws-dummy string ":" ws-cobdata(1:ws-cobdata-len) delimited by size into ws-dummy display ws-dummy(1:ws-cobdata-len + 1) upon environment-value end-if if extfilename not = spaces and not = low-values move extfilename to ws-command-line set ext-call to true else accept ws-command-line from command-line set ext-call to false end-if unstring ws-command-line delimited by all spaces into ws-file-name ws-fixed-rec-len move low-values to ws-key-status move spaces to ws-err-line-1 ws-err-line-2 perform c1-open-file . b5-main section. * ws-l is the line of the screen array * ws-scrline is the line in the file that we're on * ws-scrcol is the column in the record that we're on * ws-last-top-line is the line in the file that would show * one screen of records to the end of the file * ws-line-len is the length of this line * ws-saved-col enables us to either move up and down at the end of * the line or constrain us to the length of the line but allow * us to go back to where we were. Say we're at column 50 on one * line and go down to a line which is 40 long, and then again to * a line >= 50 long - we go from column 50 to column 40 and then * back to column 50 again. * ws-last-scrchar is the last character of the line that would be * shown in the screen window * end-key-active is set if the End key is pressed and remains true * until the cursor is moved left or right compute ws-l = ((ws-line - (ws-scr-start-line - 1)) + 1) / 2 move ws-scr-line-len(ws-l) to ws-line-len move ws-saved-col to ws-col * If the End key has been pressed but the column we're on isn't * on the page, bring it onto the page - if the line is longer * than 80 chars, put the end at the right-hand side, otherwise * align the start of the record with the left-hand side if end-key-active evaluate ws-line-len when < ws-char-from(ws-scr) if ws-line-len < c-scrline-len move 1 to ws-char-from(ws-scr) else compute ws-char-from(ws-scr) = ws-line-len - (c-scrline-len - 1) end-if compute ws-last-scrchar = (ws-line-len - ws-char-from(ws-scr)) + 1 perform s1-display-screen when > (ws-char-from(ws-scr) + (c-scrline-len - 1)) compute ws-char-from(ws-scr) = ws-line-len - (c-scrline-len - 1) move c-scrline-len to ws-last-scrchar perform s1-display-screen when other compute ws-last-scrchar = (ws-line-len - ws-char-from(ws-scr)) + 1 end-evaluate if ws-last-scrchar = zero move 1 to ws-last-scrchar end-if else if ws-line-len not < ws-char-from(ws-scr) compute ws-last-scrchar = (ws-line-len - ws-char-from(ws-scr)) + 1 if ws-last-scrchar > c-scrline-len move c-scrline-len to ws-last-scrchar end-if else move 1 to ws-last-scrchar end-if end-if compute ws-last-col = (ws-last-scrchar * 2) - 1 * Would we be positioned past the end of the line? If so, move to the * end but don't update ws-saved-col if end-key-active or ws-last-col < ws-col move ws-last-col to ws-col end-if * ws-scrline and ws-scrcol are the actual line and column in the file * corresponding to where the cursor is now (with the proviso that the * cursor could be pointing past the end of the line if the line is * zero length or the window has moved further to the right than the * record is long). compute ws-scrline = ws-line-from(ws-scr) + (ws-l - 1) compute ws-scrcol = ws-char-from(ws-scr) + (((ws-col + 1) / 2) - 1) if ws-last-line > c-scr-lines compute ws-last-top-line = (ws-last-line - c-scr-lines) + 1 else move 1 to ws-last-top-line end-if display scr-linecol * Accept a keypress and redisplay the character that got * overwritten accept ws-keypress at ws-linecol auto move function upper-case(ws-keypress) to ws-keypress display ws-view-hex-line(ws-l)(ws-col:1) at ws-linecol * Evaluate the keypress evaluate true also true when Accept-terminated also Ctrl-key evaluate ws-keypress when "G" perform c3-go-to when "/" when "F" perform c5-search when "!" perform c7-system-call when "?" perform c9-file-details when "V" perform c11-edit-file when "L" when "<" evaluate true when ws-char-from(ws-scr) > c-scrline-len subtract c-scrline-len from ws-char-from(ws-scr) when ws-char-from(ws-scr) > 1 move 1 to ws-char-from(ws-scr) move 2 to ws-col end-evaluate perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when "R" when ">" * How far along the line are we? evaluate true when ws-char-from(ws-scr) + c-scrline-len > ws-line-len continue *> we don't want to go any further when ws-scrcol + c-scrline-len > ws-line-len compute ws-char-from(ws-scr) = ws-line-len - (c-scrline-len - 1) move 1 to ws-col when other add c-scrline-len to ws-char-from(ws-scr) end-evaluate perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when "[" if ws-col > 2 or ws-char-from(ws-scr) > 1 compute ws-line-start = ls-line-offset(ws-scrline) compute ws-line-posn = ws-line-start + (ws-scrcol - 1) subtract 1 from ws-line-posn perform with test after varying ws-line-posn from ws-line-posn by -1 until ws-line-posn = ws-line-start or (ls-view-char(ws-line-posn) not = space and ls-view-char(ws-line-posn - 1) = space) end-perform compute ws-line-posn = (ws-line-posn - ws-line-start) + 1 if ws-line-posn < ws-char-from(ws-scr) move ws-line-posn to ws-char-from(ws-scr) move 2 to ws-col else compute ws-col = (ws-line-posn - (ws-char-from(ws-scr) - 1)) * 2 end-if end-if perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when "]" * How far along the line are we? if ws-scrcol < ws-line-len compute ws-line-start = ls-line-offset(ws-scrline) compute ws-line-end = ws-line-start + (ls-line-len(ws-scrline) - 1) compute ws-line-posn = ws-line-start + (ws-scrcol - 1) add 1 to ws-line-posn perform with test after varying ws-line-posn from ws-line-posn by 1 until ws-line-posn = ws-line-end or (ls-view-char(ws-line-posn) not = space and ls-view-char(ws-line-posn - 1) = space) end-perform compute ws-line-posn = (ws-line-posn - ws-line-start) + 1 if ws-line-posn > (ws-char-from(ws-scr) + (c-scrline-len - 1)) move ws-line-posn to ws-char-from(ws-scr) move 2 to ws-col else compute ws-col = (ws-line-posn - (ws-char-from(ws-scr) - 1)) * 2 end-if end-if perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when ":" perform c15-shell-session perform s1-display-screen end-evaluate when Accept-terminated also Enter-key when ADIS-key also Enter-key-ADIS if ws-l < c-scr-lines add 1 to ws-line move 1 to ws-col else add 1 to ws-line-from(ws-scr) perform s1-display-screen end-if when User-func also Escape-key exit section when User-func also F1 perform c13-show-help when User-func also F2 when User-func also F3 when User-func also F4 when User-func also F5 move ws-saved-col to ws-col move ws-linecol to ws-scr-linecol(ws-scr) move ws-end-key-active-ind to ws-scr-end-key-active(ws-scr) if ws-scr = ws-key-code-1 move 1 to ws-scr else move ws-key-code-1 to ws-scr end-if perform s1-display-screen move ws-scr-linecol(ws-scr) to ws-linecol move ws-scr-end-key-active(ws-scr) to ws-end-key-active-ind move ws-col to ws-saved-col when User-func also F6 when User-func also F7 when User-func also F8 when User-func also F9 continue when User-func also F10 perform s3-open-file perform d7-load-table when User-func also F11 move ws-file-name to ws-last-file move spaces to ws-file-name perform c1-open-file when User-func also F12 continue *> Some to think about when User-func also Page-Up nonstd when User-func also Page-Up-nonstd evaluate ws-line-from(ws-scr) when > c-scr-lines subtract c-scr-lines from ws-line-from(ws-scr) when other move 1 to ws-line-from(ws-scr) move ws-scr-start-line to ws-line end-evaluate perform s1-display-screen when User-func also Page-Down nonstd when User-func also Page-Down-nonstd evaluate true when ws-line-to(ws-scr) < ws-last-line add c-scr-lines to ws-line-from(ws-scr) if ws-line-from(ws-scr) > ws-last-top-line move ws-last-top-line to ws-line-from(ws-scr) end-if when other compute ws-line = ws-scr-start-line + ((ws-line-to(ws-scr) - ws-line-from(ws-scr)) * 2) end-evaluate perform s1-display-screen when ADIS-key also Home-key nonstd when User-func also Home-key-nonstd * Move position and cursor to start of line move 1 to ws-char-from(ws-scr) ws-col ws-saved-col set end-key-active to false perform s1-display-screen when ADIS-key also End-key nonstd when User-func also End-key-nonstd if ws-line-len > c-scrline-len * Move position so we're showing last part of line * and move cursor to end of line compute ws-char-from(ws-scr) = ws-line-len - (c-scrline-len - 1) move 79 to ws-col else * Move cursor to end of line, make sure we're showing * all of the line move 1 to ws-char-from(ws-scr) compute ws-col = (ws-line-len * 2) - 1 end-if set end-key-active to true perform s1-display-screen when ADIS-key also cursor-left evaluate true when ws-col > 2 * If we're not at the leftmost column, move cursor left subtract 2 from ws-col move ws-col to ws-saved-col set end-key-active to false when ws-char-from(ws-scr) > 1 * If we're at the leftmost column, move record view * back by 1 character subtract 1 from ws-char-from(ws-scr) perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false end-evaluate when ADIS-key also cursor-right * How far along the line are we? compute ws-posn = ws-char-from(ws-scr) + (((ws-col + 1) / 2) - 1) evaluate true when ws-posn not < ws-line-len continue *> we don't want to go any further when ws-col < 79 * If we're not at the rightmost column, move cursor right add 2 to ws-col move ws-col to ws-saved-col set end-key-active to false when other * If we're at the rightmost column, move record view * along by 1 character add 1 to ws-char-from(ws-scr) perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false end-evaluate when ADIS-key also cursor-up evaluate true when ws-l > 1 subtract 2 from ws-line when ws-line-from(ws-scr) > 1 subtract 1 from ws-line-from(ws-scr) perform s1-display-screen end-evaluate when ADIS-key also cursor-down * How far down the screen and the file are we? * If we're above the last line on the screen, move the * cursor down. * If we've reached the last screen line but there's more * lines on the file, move down a line in the file evaluate true when ws-l < c-scr-lines if ws-scrline < ws-last-line add 2 to ws-line end-if when ws-line-from(ws-scr) < ws-last-top-line add 1 to ws-line-from(ws-scr) perform s1-display-screen end-evaluate end-evaluate . b9-end section. display "COBDATA" upon environment-name display ws-cobdata upon environment-value * Free allocated memory - might not be necessary but it makes sure * there's no memory leakage if mem-alloc call "CBL_FREE_MEM" using by value ws-view-mem-base returning ws-call-status call "CBL_FREE_MEM" using by value ws-line-mem-base returning ws-call-status set mem-alloc to false end-if . c1-open-file section. if ws-file-name = spaces set command-line-name to false else set command-line-name to true end-if * If file name was supplied on command line, expect it to be right * If it's being put in through ss-file screen, allow them to try * again if it's wrong perform d1-find-file with test after until valid-io or command-line-name or (User-func and Escape-key) if User-func and Escape-key exit section end-if if not valid-io and command-line-name goback end-if * Now get the file basename perform varying ws-ptr from length ws-file-name by -1 until ws-ptr < 1 or ws-file-name(ws-ptr:1) = "/" end-perform if ws-ptr not < 1 move ws-file-name(ws-ptr + 1:) to ws-disp-file-name end-if set cursor-wrap to false set mem-alloc to false set string-search to true perform d7-load-table . c3-go-to section. * Go to a specified line move ws-line-from(ws-scr) to ws-to-line-z perform varying ws-ptr from 1 by 1 until ws-ptr > length ws-to-line-z or ws-to-line-z(ws-ptr:1) not = space end-perform move ws-to-line-z(ws-ptr:) to ws-to-line-x display ss-go-to accept ss-go-to if (User-func and Escape-key) set Accept-terminated Escape-key to true perform s1-display-screen exit section end-if if ws-to-line-x(1:1) = "+" or "-" if ws-to-line-x(2:) = spaces if ws-to-line-x(1:1) = "+" compute ws-to-line = ws-last-line + 1 else move 1 to ws-to-line end-if else compute ws-to-line = ws-line-from(ws-scr) + function numval(ws-to-line-x) end-if else move function numval(ws-to-line-x) to ws-to-line end-if evaluate ws-to-line when < 1 move 1 to ws-to-line when > ws-last-line if ws-last-line > c-scr-lines compute ws-to-line = (ws-last-line - c-scr-lines) + 1 else move 1 to ws-to-line end-if end-evaluate move ws-to-line to ws-line-from(ws-scr) move ws-scr-start to ws-linecol move ws-col to ws-saved-col perform s1-display-screen . c5-search section. * Determine whether it's a regex search or a straight string search * by whether the search string starts and ends with particular * characters. Regex can be followed by "c" to make it case sensitive, * eg. /abc/ would be case-insensitive, /Abc/c would be case sensitive. move ws-linecol to ws-scr-linecol(ws-scr) perform x3-pass-cursor-keys move 0101 to ws-cursor display ss-search accept ss-search set string-found to false perform until string-found or ws-search = spaces or (User-func and Escape-key) evaluate ws-cursor-col when 1 continue *> Repeat last search when 2 set string-search to true when other if (ws-search(1:1) = ws-search(ws-cursor-col - 1:1) or (ws-search(1:1) = ws-search(ws-cursor-col - 2:1) and (ws-search(ws-cursor-col - 1:1) = "c" or "C"))) and (ws-search(1:1) = "/" or "?" or "=") set grep-search to true if ws-search(ws-cursor-col - 1:1) = "c" or "C" set case-sensitive to true else set case-sensitive to false end-if else set string-search to true set case-sensitive to false end-if end-evaluate if string-search perform d3-string-search else perform d5-grep-search end-if if not string-found display ss-search accept ss-search move spaces to ws-search-msg end-if end-perform * Have we found a string? if string-found move ws-scr-start to ws-linecol if ws-char-from(ws-scr) < c-scrline-len compute ws-col = (ws-char-from(ws-scr) * 2) - 1 move ws-col to ws-saved-col move 1 to ws-char-from(ws-scr) end-if else move ws-scr-linecol(ws-scr) to ws-linecol end-if perform x1-intercept-cursor-keys if User-func and Escape-key set Accept-terminated to true *> Don't end if Esc pressed end-if perform s1-display-screen . c7-system-call section. display ss-system-call accept ss-system-call if (User-func and Escape-key) or ws-system-text = spaces set Accept-terminated Escape-key to true perform s1-display-screen exit section end-if perform varying ws-text-ptr from length ws-system-text by -1 until ws-system-text(ws-text-ptr:1) not = space end-perform move x'00' to ws-system-text(ws-text-ptr + 1:1) call "SYSTEM" using ws-system-text perform s1-display-screen . c9-file-details section. move zero to ws-mode call "CBL_LOCATE_FILE" using by reference ws-file-name ws-mode ws-full-file-spec ws-exist-flag ws-path-flag returning ws-call-status move length ws-dir-name to ws-dir-name-len move zero to ws-curr-dir-flags call "CBL_GET_CURRENT_DIR" using by value ws-curr-dir-flags ws-dir-name-len by reference ws-dir-name returning ws-call-status display space at 0101 foreground-colour yellow with blank screen display "File:" at 0502 if ws-full-file-name(1:1) = "/" display "File: " at 0502 ws-full-file-name else perform varying ws-dir-name-len from ws-dir-name-len by -1 until ws-dir-name-len < 1 or ws-dir-name(ws-dir-name-len:1) not = space end-perform display "File: " at 0502 ws-dir-name(1:ws-dir-name-len) "/" ws-full-file-name end-if display "Current directory: " at 0702 ws-dir-name(1:ws-dir-name-len) accept ws-keypress at 2580 set Accept-terminated to true *> Don't end if Esc pressed move ws-scr-linecol(ws-scr) to ws-linecol perform s1-display-screen . c11-edit-file section. move spaces to ws-shell move ws-scrline to ws-vi-start string "vi +" ws-vi-start " " ws-file-name delimited by size into ws-shell perform varying ws-text-ptr from length ws-shell by -1 until ws-shell(ws-text-ptr:1) not = space end-perform move x'00' to ws-shell(ws-text-ptr + 1:1) call "SYSTEM" using ws-shell perform s3-open-file perform d7-load-table . c13-show-help section. move ws-linecol to ws-scr-linecol(ws-scr) display ss-help accept ws-keypress at 2580 set Accept-terminated to true *> Don't end if Esc pressed move ws-scr-linecol(ws-scr) to ws-linecol perform s1-display-screen . c15-shell-session section. * The environment variable SHELL contains the shell invocation move z"$SHELL" to ws-shell if not ext-call and ws-cobdata(1:1) not = ":" display "COBDATA" upon environment-name display ws-cobdata(1:ws-cobdata-len) upon environment-value end-if * Clear the screen down so command will display properly * NB. If running in Animator in a single session, things may * appear wonky display " " at 0101 with erase eos call "SYSTEM" using ws-shell if not ext-call and ws-cobdata(1:1) not = ":" display "COBDATA" upon environment-name move spaces to ws-dummy string ":" ws-cobdata(1:ws-cobdata-len) delimited by size into ws-dummy display ws-dummy(1:ws-cobdata-len + 1) upon environment-value end-if . d1-find-file section. if ws-file-name = spaces display ss-file perform with test after until (User-func and Escape-key) or ws-file-name not = spaces accept ss-file end-perform if User-func and Escape-key exit section end-if end-if move ws-file-name to ws-disp-file-name set allow-no-file to true perform s3-open-file set allow-no-file to false * If we didn't find it, try explicitly looking in the current * directory if no-file and ws-file-name(1:2) not = "./" move "./" to ws-file-name move ws-disp-file-name to ws-file-name(3:) set allow-no-file to true perform s3-open-file set allow-no-file to false end-if * If there's still no joy, and this is a load of a new file rather * than the initial load, try looking where the last one came from if no-file and ws-last-file not = spaces perform varying ws-ptr from length ws-last-file by -1 until ws-ptr < 1 or ws-last-file(ws-ptr:1) = "/" end-perform if ws-ptr not < 1 move spaces to ws-file-name string ws-last-file(1:ws-ptr) ws-file-name delimited by size into ws-file-name set allow-no-file to true perform s3-open-file set allow-no-file to false end-if end-if if not valid-io display "File fails to open - " at 0405 ws-disp-file-name if ws-file-status-1 = "9" display "Error 9/" at 0605 ws-file-status-2-num else display "Error " at 0605 ws-file-status end-if if not command-line-name accept ws-keypress at 2580 move spaces to ws-file-name end-if end-if . d3-string-search section. * Go down array, checking each line for the search string * Make search case-insensitive * Might be better to have a flag for this move function upper-case(ws-search) to ws-uc-search evaluate true when ws-cursor-col > 1 compute ws-str-len = ws-cursor-col - 1 when ws-str-len > zero continue when other perform varying ws-str-len from length ws-uc-search by -1 until ws-uc-search(ws-str-len:1) not = spaces end-perform end-evaluate * Take into account the cursor position when deciding where to * start search from compute ws-start-line = (ws-line-from(ws-scr) + ws-l) - 1 perform varying ws-ptr from ws-start-line by 1 until ws-ptr > ws-last-line or string-found if ls-line-len(ws-ptr) = zero exit perform cycle end-if move ls-line-offset(ws-ptr) to ws-offset move ls-line-len(ws-ptr) to ws-rec-len move function upper-case(ls-view-tbl(ws-offset:ws-rec-len)) to ws-check-line move spaces to ws-delim if ws-ptr = ws-start-line unstring ws-check-line(ws-col + 1:ws-rec-len) delimited by ws-uc-search(1:ws-str-len) into ws-dummy delimiter ws-delim count in ws-delim-ptr else unstring ws-check-line(1:ws-rec-len) delimited by ws-uc-search(1:ws-str-len) into ws-dummy delimiter ws-delim count in ws-delim-ptr end-if if ws-delim not = spaces move ws-ptr to ws-line-from(ws-scr) if ws-ptr = ws-start-line compute ws-char-from(ws-scr) = ws-delim-ptr + ws-col + 1 else compute ws-char-from(ws-scr) = ws-delim-ptr + 1 end-if set string-found to true end-if end-perform if not string-found compute ws-search-msg-start = (80 - length "Not found") / 2 move "Not found" to ws-search-msg(ws-search-msg-start:) end-if . d5-grep-search section. * Go down array, using regcomp and regexec on each line to * check for the search string * Search pattern in a null-terminated string * Lose the first and last characters of the search string (and the * c if it's case-sensitive) if ws-cursor-col > 1 if case-sensitive compute ws-str-len = ws-cursor-col - 4 else compute ws-str-len = ws-cursor-col - 3 end-if move ws-search(2:ws-str-len) to ws-search-regexp add 1 to ws-str-len move x'00' to ws-search-regexp(ws-str-len:1) end-if * Case sensitive search - should I put in a flag to give * case-insensitive search as an option? If so, either add reg-icase * to ws-c-flags or leave it out. * Compile regular expression move zero to ws-c-flags if not case-sensitive add reg-icase to ws-c-flags end-if call "regcomp" using by reference ws-regex-t ws-search-regexp (1:ws-str-len) by value ws-c-flags returning ws-return if ws-return not zero move spaces to ws-error move length ws-error to ws-err-len call "regerror" using by value ws-return by reference ws-regex-t ws-error by value ws-err-len returning ws-regerror-len subtract 1 from ws-regerror-len compute ws-search-msg-start = (80 - (ws-regerror-len + length "Invalid search regex: ")) / 2 string "Invalid search regex: " ws-error(1:ws-regerror-len) delimited by size into ws-search-msg(ws-search-msg-start:) exit section end-if * Take into account the cursor position when deciding where to * start search from compute ws-ptr = ws-line-from(ws-scr) + ws-l * Null-terminate each line, then use regexec to look for the * compiled regular expression move c-nmatch to ws-nmatch perform varying ws-ptr from ws-ptr by 1 until ws-ptr > ws-last-line or string-found if ls-line-len(ws-ptr) = zero exit perform cycle end-if move spaces to ws-grep-line move ls-line-offset(ws-ptr) to ws-offset move ls-line-len(ws-ptr) to ws-rec-len string ls-view-tbl(ws-offset:ws-rec-len) x'00' delimited by size into ws-grep-line compute ws-e-flags = reg-extended call "regexec" using by reference ws-regex-t ws-grep-line ws-nmatch ws-pmatch-tbl by value ws-e-flags returning ws-return if ws-return zero move ws-ptr to ws-line-from(ws-scr) compute ws-char-from(ws-scr) = ws-pmatch-start(1) + 1 set string-found to true end-if end-perform if not string-found compute ws-search-msg-start = (80 - length "Not found") / 2 move "Not found" to ws-search-msg(ws-search-msg-start:) end-if . d7-load-table section. * Find out how many lines we're loading and the max length * We start out with the file open. Read it and put it into a * virtual file so we don't have to read it again (or execute * it again if it's a command). move zero to ws-line-cnt ws-max-len ws-vfile-offset call "CBL_OPEN_VFILE" using by reference ws-vfile-id ws-vfile-status returning ws-call-status if ws-vfile-status(1:1) not = "0" move "Virtual file error" to ws-err-line-1 move ws-vfile-status to ws-vfile-status-disp string "Error " ws-vfile-status-disp delimited by size into ws-err-line-2 move 2 to ws-error-code perform z1-stop-error end-if perform until end-of-file or ws-line-cnt > c-max-lines or ws-vfile-offset > c-max-bytes perform s5-return-record if end-of-file exit perform end-if add 1 to ws-line-cnt * Only get the length if we know it's longer than current max if ws-rec-len > ws-max-len move ws-rec-len to ws-max-len end-if * Now write the record to the virtual file move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-vfile-id ws-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-vfile-id ws-vfile-offset ws-vfile-buff-len by reference ws-rec add ws-rec-len to ws-vfile-offset end-perform if ws-line-cnt > c-max-lines move "Too many lines in file for viewer" to ws-err-line-1 if ext-call move "Using od to show file" to ws-err-line-2 end-if move 1 to ws-error-code perform z1-stop-error end-if if ws-vfile-offset > c-max-bytes move "File is too large for viewer" to ws-err-line-1 if ext-call move "Using od to show file" to ws-err-line-2 end-if perform z1-stop-error end-if move ws-vfile-offset to ws-vfile-len perform s7-close-file if ws-line-cnt = zero move "Empty file" to ws-err-line-1 perform z1-stop-error end-if * Now allocate memory for the linkage section table * Free allocated memory - might not be necessary but it makes sure * there's no memory leakage if mem-alloc call "CBL_FREE_MEM" using by value ws-view-mem-base returning ws-call-status call "CBL_FREE_MEM" using by value ws-line-mem-base returning ws-call-status set mem-alloc to false end-if * Calculate size needed for file table compute ws-mem-size = ws-vfile-len - (ws-line-cnt * c-reclen-len) * Allocate the memory move 4 to ws-mem-flags call "CBL_ALLOC_MEM" using by reference ws-view-mem-base by value ws-mem-size ws-mem-flags returning ws-call-status if ws-call-status not = zero move "Error allocating memory" to ws-err-line-1 perform z1-stop-error end-if * Point the base of the table at the memory we've just allocated set address of ls-view-tbl to ws-view-mem-base set mem-alloc to true move ws-line-cnt to ws-last-line * Calculate size needed for line table compute ws-mem-size = ws-line-cnt * length ls-line-entry * Allocate the memory move 4 to ws-mem-flags call "CBL_ALLOC_MEM" using by reference ws-line-mem-base by value ws-mem-size ws-mem-flags returning ws-call-status if ws-call-status not = zero move "Error allocating memory" to ws-err-line-1 perform z1-stop-error end-if * Point the base of the table at the memory we've just allocated set address of ls-line-tbl to ws-line-mem-base set mem-alloc to true * Now just load the virtual file into the array move zero to ws-vfile-offset move 1 to ws-offset * Read virtual file records directly into the table at the * correct offset perform varying ws-ptr from 1 by 1 until ws-ptr > ws-line-cnt move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-vfile-id ws-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-rec call "CBL_READ_VFILE" using by value ws-vfile-id ws-vfile-offset ws-vfile-buff-len by reference ws-rec add ws-vfile-buff-len to ws-vfile-offset move ws-rec-len to ls-line-len(ws-ptr) move ws-offset to ls-line-offset(ws-ptr) move ws-rec to ls-view-tbl(ws-offset:ws-rec-len) add ws-rec-len to ws-offset end-perform call "CBL_CLOSE_VFILE" using by value ws-vfile-id perform varying ws-scr from 1 by 1 until ws-scr > 5 move 1 to ws-line-from(ws-scr) ws-char-from(ws-scr) move ws-scr-start to ws-scr-linecol(ws-scr) move "N" to ws-scr-end-key-active(ws-scr) end-perform move 1 to ws-scr set end-key-active to false perform s1-display-screen move ws-scr-start to ws-linecol move ws-col to ws-saved-col . s1-display-screen section. * For the viewable part of each record, put the hex representation * of the character on one line and, if the character is printable, * the character itself on the next line move spaces to ws-scr-tbl ws-view-tbl * What's the last line and character we'll display? compute ws-line-to(ws-scr) = (ws-line-from(ws-scr) + c-scr-lines) - 1 if ws-line-to(ws-scr) > ws-last-line move ws-last-line to ws-line-to(ws-scr) end-if compute ws-scr-chars = (ws-max-len - ws-char-from(ws-scr)) + 1 if ws-scr-chars > c-scrline-len move c-scrline-len to ws-scr-chars end-if * Populate the screen table move zero to ws-scr-ptr perform varying ws-ptr from ws-line-from(ws-scr) by 1 until ws-ptr > ws-line-to(ws-scr) add 1 to ws-scr-ptr move ls-line-len(ws-ptr) to ws-scr-line-len(ws-scr-ptr) if ws-scr-line-len(ws-scr-ptr) < ws-char-from(ws-scr) move spaces to ws-scr-line(ws-scr-ptr) exit perform cycle end-if compute ws-line-len = (ws-scr-line-len(ws-scr-ptr) - ws-char-from(ws-scr)) + 1 compute ws-offset = ls-line-offset(ws-ptr) + (ws-char-from(ws-scr) - 1) move ls-view-tbl(ws-offset:ws-line-len) to ws-scr-line(ws-scr-ptr) end-perform move ws-scr-ptr to ws-last-scr-line * Now convert the contents of ws-scr-tbl to the viewable content * We only want to convert up to the last character of each line, * so determine how many characters to do first * Note: for some reason, the character x9a, if displayed in the raw, * somehow transmits an escape character to the input buffer, so * we trap this explicitly as an unprintable character. I think that * x90 creates a superscript character on the line above but I'll * leave that for now. * After more research, I'm ditching the entire range x80 to x9f as * there seem issues around most or all of the characters in that * range. perform varying ws-scr-ptr from 1 by 1 until ws-scr-ptr > ws-last-scr-line if ws-scr-line-len(ws-scr-ptr) < ws-char-from(ws-scr) move zero to ws-scr-chars else compute ws-scr-chars = (ws-scr-line-len(ws-scr-ptr) - ws-char-from(ws-scr)) + 1 if ws-scr-chars > c-scrline-len move c-scrline-len to ws-scr-chars end-if end-if perform varying ws-ptr from 1 by 1 until ws-ptr > ws-scr-chars move ws-scr-line(ws-scr-ptr)(ws-ptr:1) to ws-disp-char divide ws-disp-char-9 by 16 giving ws-hex-mostsig remainder ws-hex-leastsig add 1 to ws-hex-mostsig ws-hex-leastsig move ws-disp-hex(ws-hex-mostsig) to ws-view-hex-char-1(ws-scr-ptr ws-ptr) move ws-disp-hex(ws-hex-leastsig) to ws-view-hex-char-2(ws-scr-ptr ws-ptr) if ws-disp-char-9 > 31 and ws-disp-hex(ws-hex-mostsig) not = "8" and not = "9" move ws-disp-char to ws-view-printable-char (ws-scr-ptr ws-ptr) end-if end-perform end-perform display ss-main * Now go back over the screen, and put a coloured character everywhere * that there's an unprintable character in the original. If we put * a substitute character into the display line before displaying * ss-main, we couldn't colour it, hence the second pass. perform varying ws-scr-ptr from 1 by 1 until ws-scr-ptr > ws-last-scr-line if ws-scr-line-len(ws-scr-ptr) < ws-char-from(ws-scr) move zero to ws-scr-chars else compute ws-scr-chars = (ws-scr-line-len(ws-scr-ptr) - ws-char-from(ws-scr)) + 1 if ws-scr-chars > c-scrline-len move c-scrline-len to ws-scr-chars end-if end-if perform varying ws-ptr from 1 by 1 until ws-ptr > ws-scr-chars move ws-scr-line(ws-scr-ptr)(ws-ptr:1) to ws-disp-char if ws-disp-char-9 not > 31 or ws-view-hex-char-1(ws-scr-ptr ws-ptr) = "8" or "9" compute ws-char-line = (ws-scr-start-line - 1) + (ws-scr-ptr * 2) compute ws-char-col = (ws-ptr * 2) - 1 display "_" at ws-char-linecol foreground-colour blue end-if end-perform end-perform . s3-open-file section. * Use bytestream routine to open file call "CBL_OPEN_FILE" using by reference ws-file-name ws-access-mode ws-deny-mode ws-device ws-file-handle move "open" to ws-verb perform x5-return-code-check if not valid-io exit section end-if * Get the length of the file into ws-file-offset move zero to ws-file-offset move c-buff-len to ws-byte-count move c-read-len to ws-flags call "CBL_READ_FILE" using by reference ws-file-handle ws-file-offset ws-byte-count ws-flags ws-file-buff move "read" to ws-verb perform x5-return-code-check move ws-file-offset to ws-file-len move zero to ws-file-offset move c-normal-read to ws-flags set last-block to false if ws-file-len zero set end-of-file to true exit section end-if perform u1-read-block . s5-return-record section. * Return a record from a bytestream buffer, refreshing the * buffer with the next block when necessary move spaces to ws-rec move zero to ws-rec-len * If we've read the last block and the pointer's off the end of * it, it's time to call it a day if last-block and ws-buff-ptr > ws-byte-count set end-of-file to true exit section end-if * Add another byte to the record until either we've hit the length * of the fixed length record or we've got a record delimiter. * Check that we don't overflow the defined length of the record. perform until (last-block and ws-buff-ptr > ws-byte-count) or (fixed-length and ws-rec-len = ws-fixed-rec-len) or (not fixed-length and ws-file-buff(ws-buff-ptr:1) = x'0a') or ws-rec-len >= c-rec-len perform t1-add-byte-to-rec end-perform if fixed-length or (last-block and ws-buff-ptr > ws-byte-count) exit section end-if * Delimited record - add the delimiter character(s). Assume that if * we encounter x'0a0d' (CR/LF), that's a Microsoft delimiter. if ws-file-buff(ws-buff-ptr:1) = x'0a' perform t1-add-byte-to-rec if last-block and ws-buff-ptr > ws-byte-count exit section end-if if ws-file-buff(ws-buff-ptr:1) = x'0d' perform t1-add-byte-to-rec end-if end-if . s7-close-file section. * Close file using bytestream routine call "CBL_CLOSE_FILE" using by reference ws-file-handle move "close" to ws-verb perform x5-return-code-check . t1-add-byte-to-rec section. * Add a byte to the record from the file buffer. If we hit the * end of the file buffer, read another block in. add 1 to ws-rec-len move ws-file-buff(ws-buff-ptr:1) to ws-rec(ws-rec-len:1) add 1 to ws-buff-ptr if ws-buff-ptr > ws-byte-count and not last-block perform u1-read-block end-if . u1-read-block section. * Use bytestream routine to read a block from a file * If we're coming up to the end of the file, only read the bytes * to the end, otherwise we'll get a 9/018 error (partial record) if ws-file-offset + ws-byte-count >= ws-file-len compute ws-byte-count = ws-file-len - ws-file-offset set last-block to true end-if call "CBL_READ_FILE" using by reference ws-file-handle ws-file-offset ws-byte-count ws-flags ws-file-buff move "read" to ws-verb perform x5-return-code-check * Set the pointer to the start of the buffer and increment the * offset to read from move 1 to ws-buff-ptr add ws-byte-count to ws-file-offset . 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-return-code-check section. * Check the return code from the bytestream routines move return-code to ws-file-status if return-code zero set valid-io to true exit section end-if if no-file and allow-no-file exit section end-if string "Error Action - " delimited by size ws-verb delimited by space " on File " ws-file-name delimited by size into ws-err-line-1 if ws-file-status-1 = "9" move ws-file-status-2-num to ws-file-status-2-disp string "Error 9/" ws-file-status-2-disp delimited by size into ws-err-line-2 else string "Error " ws-file-status-1 ws-file-status-2 delimited by size into ws-err-line-2 end-if perform z1-stop-error . z1-stop-error section. display space at 0101 erase eos display ws-err-line-1 at 0405 display ws-err-line-2 at 0605 accept ws-keypress at 2580 auto goback returning ws-error-code . end program hexview.