copy "cblproto.cpy". $set sourceformat(variable) program-id. fileview. * File viewer - window onto a file * If parameters are preceded by a "-s " flag, pressing the enter * key returns the number of the line in the file that they're on * and exits * 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) - file type * * If not supplied, try to deduce it from file extension *author. Mike Fleming. special-names. console is crt cursor is ws-cursor crt status is ws-key-status. file-control. select view-file assign view-file-name organization is line sequential file status is ws-file-status. file section. fd view-file record varying from 0 to 5000 depending on ws-rec-len. 01 view-rec. 03 view-char pic x occurs 5000 times. 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 78 c-scr-lines value 23. 78 c-scrline-len value 80. 78 c-extra-len value c-scrline-len + 1. * 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. 03 filler pic x occurs 1000 times. 01 ws-command-line pic x(2000). 01 ws-temp pic x(2000). 01 ws-file-name pic x(60). 01 ws-last-file pic x(60). 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-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". 88 file-locked value "9A". 88 rec-locked value "9D". 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). 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-uc-scr-tbl. 03 ws-uc-scr-line occurs c-scr-lines times. 05 filler pic x occurs c-scrline-len times. 01 ws-scr-colour-maps. 03 ws-scr-fg-colour-map occurs 5 times. 05 ws-scr-fg-colour-line occurs c-scr-lines times. 07 ws-scr-fg-colour-char pic x occurs c-scrline-len times. 03 ws-scr-bg-colour-map occurs 5 times. 05 ws-scr-bg-colour-line occurs c-scr-lines times. 07 ws-scr-bg-colour-char pic x occurs c-scrline-len times. 01 ws-ctrl. 03 filler value "foreground-colour ". 03 ws-ctrl-fg-colour pic x. 03 filler value " background-colour ". 03 ws-ctrl-bg-colour pic x. 01 ws-saved-line. 03 filler pic x occurs c-scrline-len times. 01 ws-verb pic x(20). 88 std-cobol-divn values "IDENTIFICATION" "ENVIRONMENT" "DATA" "PROCEDURE". 88 std-cobol-section values "CONFIGURATION" "INPUT-OUTPUT" "FILE" "WORKING-STORAGE" "LINKAGE" "SCREEN" "THREAD-LOCAL-STORAGE" "OBJECT-STORAGE" "LOCAL-STORAGE". 88 std-cobol-para values "PROGRAM-ID" "DATE-COMPILED" "CLASS-ID" "FACTORY" "OBJECT" "METHOD-ID" "INTERFACE-ID" "FUNCTION-ID" "DELEGATE-ID" "ENUM-ID" "ITERATOR-ID" "OPERATOR-ID" "VALUETYPE-ID" "SOURCE-COMPUTER" "OBJECT-COMPUTER" "SPECIAL-NAMES" "REPOSITORY" "CONSTRAINTS" "CLASS-ATTRIBUTES" "ASSEMBLY-ATTRIBUTES" "FILE-CONTROL" "I-O-CONTROL" "FD". 88 flow-cobol-verb values "PERFORM" "END-PERFORM" "GO" "CALL" "EXIT" "CONTINUE" "STOP" "GOBACK". 88 condition-cobol-verb values "IF" "ELSE" "END-IF" "EVALUATE" "WHEN" "END-EVALUATE" "AND" "OR". 88 set-value-cobol-verb values "MOVE" "STRING" "UNSTRING" "ACCEPT" "SET" "ADD" "SUBTRACT" "DIVIDE" "MULTIPLY" "COMPUTE" "INITIALIZE" "INITIALISE". 88 flow-sh-verb values "for" "while" "until" "do" "done" "exit" "return" "continue". 88 condition-sh-verb values "if" "then" "else" "elif" "fi" "case" "esac". 88 misc-sh-verb values "echo" "cd" "cat" "grep" "rm" "mail" "cp" "rsh" "rcp" "test". 88 flow-c-verb values "for" "while" "until" "do" "done" "exit" "return" "continue". 88 condition-c-verb values "if" "else" "fi" "case" "esac". 88 misc-c-verb values "#include" "int" "char" "bool" "long" "struct" "printf" "getch" "sprintf" "malloc" "strlen" "fgets" "wmove" "wattron" "wattroff" "wprintw" "mvwprintw" "refresh" "endwin". 01 ws-syn-colour pic 9. 01 ws-indicators. 03 ws-ext-call-ind pic x. 88 ext-call value "Y" false "N". 03 ws-return-line-ind pic x. 88 return-line 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-quoted-ind pic x. 88 quoted value "Y" false "N". 03 ws-doublequoted-ind pic x. 88 doublequoted value "Y" false "N". 03 ws-bracketed-ind pic x. 88 bracketed value "Y" false "N". 03 ws-cmd-start-ind pic x. 88 cmd-start value "Y" false "N". 03 ws-expr-start-ind pic x. 88 expr-start value "Y" false "N". 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-syntax-on-ind pic x. 88 syntax-on value "Y" false "N". 03 ws-colour-comments-ind pic x. 88 colour-comments value "Y" false "N". 03 ws-colour-literals-ind pic x. 88 colour-literals value "Y" false "N". 03 ws-end-key-active-ind pic x. 88 end-key-active value "Y" false "N". 03 ws-wrap-search-ind pic x. 88 wrap-search value "Y" false "N". 03 ws-search-wrapped-ind pic x. 88 search-wrapped value "Y" false "N". 01 ws-saved-inds. 03 ws-saved-syntax-on-ind pic x. 03 ws-saved-colour-comments-ind pic x. 03 ws-saved-colour-literals-ind pic x. 01 ws-action pic x. 01 ws-keypress pic x. 01 ws-search. 03 filler pic x occurs c-scrline-len times. 01 ws-search-regexp. 03 filler pic x occurs c-extra-len times. 01 ws-uc-search. 03 filler pic x occurs c-scrline-len times. 01 ws-search-type-ind pic x. 88 grep-search value "G". 88 string-search value "S". 01 ws-delim. 03 filler pic x occurs c-scrline-len times. 01 ws-check-line pic x(5000). 01 ws-uc-check-line pic x(5000). 01 ws-grep-line pic x(5001). 01 ws-dummy pic x(5000). 01 ws-search-msg. 03 filler pic x occurs c-scrline-len times. 01 ws-system-text. 03 filler pic x occurs c-scrline-len times. 01 ws-extension pic x(10). 88 cobol-extension value "COB" "CBL" "CPY" *> Standard nonstd "88" "99" *> Company2 nonstd "SEL" "FD" "FS" "DEC" *> Company2 nonstd "LIB" "LNK" "WS". *> Company2 88 sh-extension value "SH" "KSH" *> Standard nonstd "S". *> Company2 88 c-extension value "C" "H". 88 html-extension value "HTM" "HTML" "SHTML". 88 php-extension value "PHP". 01 ws-syntax-language pic x(10). 88 valid-language value "cobol" "sh" "c". 01 ws-saved-syntax-language pic x(10). 01 ws-to-line-x pic x(7). 01 ws-stored-sign 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-syn-linecol. 03 ws-syn-line pic 9(2). 03 ws-syn-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. 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-ptr pic s9(6) comp. 03 ws-disp-ptr pic s9(6) comp. 03 ws-scr-ptr pic 9(2) comp. 03 ws-col-ptr pic 9(4) comp. 03 ws-tab-ptr pic 9(2) comp. 03 ws-l pic 9(2) comp. 03 ws-scr-lines pic 9(2) comp. 03 ws-scr-chars pic 9(4) comp. 03 ws-last-char pic 9(4) comp. 03 ws-syn-ptr pic 9(4) comp. 03 ws-quote-start pic 9(4) comp. 03 ws-quote-len pic 9(4) comp. 03 ws-verb-start pic 9(4) comp. 03 ws-verb-len pic 9(4) comp. 03 ws-saved-verb-start pic 9(4) comp. 03 ws-saved-verb-len 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-tally pic 9(9) comp. 03 ws-search-line pic 9(2). 03 ws-search-len pic 9(4) comp. 03 ws-line-start pic 9(9) comp. 03 ws-line-end pic 9(9) comp. 03 ws-line-posn pic 9(9) comp. 03 ws-stored-numeric pic 9(9) comp. 03 ws-part-start pic 9(4) comp. 03 ws-part-len pic 9(4) comp. 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 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. * 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'. * End of search fields * 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(250). 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). * End of full filename fields * 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. * End of save and redisplay fields 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(60) using view-file-name. 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(40) from ws-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. 03 scr-view-area. 05 scr-view-entry occurs c-scr-lines times. 07 line + 1. 07 col 1 pic x(c-scrline-len) from ws-scr-line. * We can't display at 2580 so use bottom line for line/column 03 ss-main-bottom-line foreground-colour yellow. 05 line + 1. 05 col 1 pic x(26) value all "=". 05 col 27 value "[". 05 ss-linecol. 07 col 29 value "Line". 07 col 34 pic z(4)9 from ws-scrline. 07 col 41 value "Column". 07 col 48 pic z(3)9 from ws-scrcol. 07 col 53 value "]". 07 col 54 pic x(26) value all "=". 01 ss-help-1 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 "F6". 03 col 14 value "Options for syntax highlighting.". 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 "/". 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 (number can be put in before G)". 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 "E". 03 col 14 value "Edit the file with vi, then reload it". 03 line + 1. 03 col 2 value "M". 03 col 14 value "View the file with more, 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-help-2 background-colour black foreground-colour yellow. 03 blank screen. 03 line 2. 03 col 2 value "F". 03 col 14 value "Enter filemanager using current line as directory name". 03 line + 1. 03 col 2 value "V". 03 col 14 value "Enter fileview using current line as file name". 03 line + 1. 03 col 2 value "H". 03 col 14 value "Enter hexview using current line as file name". 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 ss-search-string col 1 pic x(c-scrline-len) 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 5 value "Wrap search? ". 03 ss-search-wrap col + 1 using ws-wrap-search-ind. 03 line + 2. 03 col 1 pic x(c-scrline-len) 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-syntax background-colour black foreground-colour yellow. 03 blank screen. 03 line 5. 03 col 10 value "Language to syntax check:". 03 col + 2 using ws-syntax-language. 03 line + 2. 03 col 10 value "(COBOL, SH, C)". 03 line + 2. 03 col 10 value "Highlight comments:". 03 col + 2 using ws-colour-comments-ind auto. 03 col + 4 value "(Y/N)". 03 line + 2. 03 col 10 value "Highlight literals:". 03 col + 2 using ws-colour-literals-ind auto. 03 col + 4 value "(Y/N)". 03 line + 2. 03 col 10 value "Syntax highlights: ". 03 col + 2 using ws-syntax-on-ind auto. 03 col + 4 value "(Y/N)". 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(c-scrline-len) 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 * Have we been passed a filename to look at? if extfilename not = spaces and not = low-values move extfilename to ws-command-line move zero to extlineno move spaces to extline set ext-call to true else accept ws-command-line from command-line display "COBDATA" upon environment-name accept ws-cobdata from environment-value display "COBDATA" upon environment-name display space upon 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 set ext-call to false end-if * Get rid of leading spaces in filename if ws-command-line not = spaces and ws-command-line(1:1) = space perform varying ws-ptr from 1 by 1 until ws-command-line(ws-ptr:1) not = space end-perform move ws-command-line(ws-ptr:) to ws-temp move ws-temp to ws-command-line end-if * -s flag means we should pass a line number (subscript to the array) * and the contents of the line itself back out if Enter is pressed if ws-command-line(1:3) = "-s " and ws-command-line(4:) not = spaces *> In case -s is a filename set return-line to true perform varying ws-ptr from 4 by 1 until ws-command-line(ws-ptr:1) not = space end-perform move ws-command-line(ws-ptr:) to ws-temp move ws-temp to ws-command-line else set return-line to false end-if * Is the input file a pipe? If so, keep the command intact. move spaces to view-file-name ws-syntax-language if ws-command-line(1:1) = "<" move ws-command-line to view-file-name else unstring ws-command-line delimited by all spaces into view-file-name ws-syntax-language end-if move function lower-case(ws-syntax-language) to ws-syntax-language move low-values to ws-key-status move spaces to ws-err-line-1 ws-err-line-2 move spaces to ws-search move zero to ws-stored-numeric move space to ws-stored-sign 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. * end-key-active is set if the End key is pressed and remains true * until the cursor is moved left or right or the Home key pressed compute ws-l = ws-line - (ws-scr-start-line - 1) 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-col = (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-col perform s1-display-screen when other compute ws-last-col = (ws-line-len - ws-char-from(ws-scr)) + 1 end-evaluate if ws-last-col = zero move 1 to ws-last-col end-if else if ws-line-len not < ws-char-from(ws-scr) compute ws-last-col = (ws-line-len - ws-char-from(ws-scr)) + 1 if ws-last-col > c-scrline-len move c-scrline-len to ws-last-col end-if else move 1 to ws-last-col end-if end-if * 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) 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 ss-linecol * Accept a keypress and redisplay the character that got * overwritten, including its colour. Because display doesn't * allow the use of identifiers in foreground-colour clause, * we use the control clause and put "foreground-colour n" into * the control field. accept ws-keypress at ws-linecol auto move function upper-case(ws-keypress) to ws-keypress move ws-scr-fg-colour-char(ws-scr ws-l ws-col) to ws-ctrl-fg-colour move ws-scr-bg-colour-char(ws-scr ws-l ws-col) to ws-ctrl-bg-colour display ws-scr-line(ws-l)(ws-col:1) at ws-linecol control ws-ctrl * Evaluate the keypress * Capture numerics in case of doing a G after putting in a line number if (Accept-terminated and Ctrl-key) evaluate ws-keypress when "G" continue when "0" through "9" compute ws-stored-numeric = (ws-stored-numeric * 10) + function numval(ws-keypress) when "+" when "-" move zero to ws-stored-numeric move ws-keypress to ws-stored-sign when other move zero to ws-stored-numeric end-evaluate end-if evaluate true also true when Accept-terminated also Ctrl-key evaluate ws-keypress when "G" *> Go to a line perform c3-go-to when "/" *> Find a string or regexp perform c5-search when "!" *> Execute a shell command perform c7-system-call when "?" *> Show details of the file perform c9-file-details when "E" *> Edit file using vi when "M" *> View file using more perform c11-edit-file when "F" *> Use current line as file/dir name when "V" *> and invoke file manager, file viewer when "H" *> hex viewer perform c13-file-action when "L" *> Page left when "<" * How far along the line are we? 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) ws-col end-evaluate perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when "R" *> Page right 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 c-scrline-len 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 "[" *> Go left one word if ws-col > 1 or ws-char-from(ws-scr) > 1 * get the line start and the current char position * in the linkage section table compute ws-line-start = ls-line-offset(ws-scrline) compute ws-line-posn = ws-line-start + (ws-scrcol - 1) * start from one char to the left and look for the * start of a word or start of line 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 * calculate column position in line 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 1 to ws-col else compute ws-col = ws-line-posn - (ws-char-from(ws-scr) - 1) end-if end-if perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when "]" *> Go right one word * How far along the line are we? if ws-scrcol < ws-line-len * get the line start and end and the current char * position in the linkage section table 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) * start from one char to the right and look for the * start of a word or end of line 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 * calculate column position in line 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 1 to ws-col else compute ws-col = ws-line-posn - (ws-char-from(ws-scr) - 1) end-if end-if perform s1-display-screen move ws-col to ws-saved-col set end-key-active to false when " " *> Page down if ws-line-to(ws-scr) < ws-last-line and ws-last-line > c-scr-lines 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 perform s1-display-screen end-if when ":" *> Start a shell session perform c19-shell-session perform s1-display-screen end-evaluate when Accept-terminated also Enter-key when ADIS-key also Enter-key-ADIS * if enter is pressed and we want a line number returned, * exit program and return the line and line number if return-line compute ws-ptr = (ws-line-from(ws-scr) + ws-l) - 1 move ws-ptr to extlineno move ls-view-tbl(ls-line-offset(ws-ptr):ls-line-len(ws-ptr)) to extline goback end-if * go to next line * * 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 1 to ws-line move 1 to ws-char-from(ws-scr) ws-col ws-saved-col set end-key-active to false end-if when ws-line-from(ws-scr) < ws-last-top-line add 1 to ws-line-from(ws-scr) move 1 to ws-char-from(ws-scr) ws-col ws-saved-col set end-key-active to false perform s1-display-screen end-evaluate when User-func also Escape-key * escape key - exit program exit section when User-func also F1 *> Show help screen perform c15-show-help when User-func also F2 *> Toggle between windows 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 *> Syntax checking perform c17-syntax perform s1-display-screen when User-func also F7 *> Not allocated continue when User-func also F8 *> Not allocated continue when User-func also F9 *> Not allocated continue when User-func also F10 *> Refresh file open input view-file perform d9-load-table when User-func also F11 *> Load a different file move view-file-name to ws-last-file move spaces to view-file-name ws-syntax-language perform c1-open-file when User-func also F12 *> Not allocated continue when User-func also Page-Up *> 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 *> 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)) end-evaluate perform s1-display-screen when ADIS-key also Home-key *> Start of line 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 *> End of line 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 c-scrline-len 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) move ws-line-len to ws-col end-if set end-key-active to true perform s1-display-screen when ADIS-key also cursor-left evaluate true when ws-col > 1 * If we're not at the leftmost column, move cursor left subtract 1 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) evaluate true when ws-posn not < ws-line-len continue *> we don't want to go any further when ws-col < c-scrline-len * If we're not at the rightmost column, move cursor right add 1 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 1 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 1 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. * 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 end-if . c1-open-file section. * Open file for input if view-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 * Get the extension - note that we don't want to pick up a hidden * file name (first character .) as an extension * Syntax language could be specified on command line if not command-line-name or ws-syntax-language = spaces or not valid-language perform varying ws-ptr from length ws-file-name by -1 until ws-ptr < 2 or ws-file-name(ws-ptr:1) = "." end-perform if ws-ptr > 1 and ws-file-name(ws-ptr - 1:1) not = "/" move function upper-case(ws-file-name(ws-ptr + 1:)) to ws-extension else move spaces to ws-extension end-if evaluate true when cobol-extension move "cobol" to ws-syntax-language when sh-extension move "sh" to ws-syntax-language when c-extension move "c" to ws-syntax-language when html-extension move "html" to ws-syntax-language when php-extension move "php" to ws-syntax-language end-evaluate end-if * Now get the file basename if view-file-name(1:1) = "<" if view-file-name(2:) = spaces move spaces to ws-file-name else perform varying ws-ptr from 2 by 1 until view-file-name(ws-ptr:1) not = spaces end-perform move view-file-name(ws-ptr:) to ws-file-name end-if else perform varying ws-ptr from length view-file-name by -1 until ws-ptr < 1 or view-file-name(ws-ptr:1) = "/" end-perform add 1 to ws-ptr move view-file-name(ws-ptr:) to ws-file-name end-if * What sort of file have we got? evaluate ws-syntax-language when "cobol" set syntax-on to true set colour-comments to true set colour-literals to true when "sh" set syntax-on to true set colour-comments to true set colour-literals to true when "c" set syntax-on to true set colour-comments to true set colour-literals to true when "html" when "php" set syntax-on to false set colour-comments to false set colour-literals to false when other set syntax-on to false set colour-comments to false set colour-literals to false end-evaluate set cursor-wrap to false set mem-alloc to false set string-search to true perform d9-load-table . c3-go-to section. * Go to a specified line * If a numeric value has been input before "G", put that into * the screen field, otherwise put the current line number into * the screen field if ws-stored-numeric not zero or ws-stored-sign not = space move ws-stored-numeric to ws-to-line-z else move ws-line-from(ws-scr) to ws-to-line-z end-if 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 if ws-stored-sign not = space move ws-stored-sign to ws-to-line-x if ws-stored-numeric not = zero move ws-to-line-z(ws-ptr:) to ws-to-line-x(2:) end-if else move ws-to-line-z(ws-ptr:) to ws-to-line-x end-if move zero to ws-stored-numeric move space to ws-stored-sign 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 * Relative or absolute line number? 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 * If before the start or after the end, position at start or end 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 x5-pass-cursor-keys-not-tab move 0101 to ws-cursor perform d3-get-search-string * Let the search commence set string-found to false perform until string-found or ws-search = spaces or (User-func and Escape-key) evaluate ws-search-len *> Has something been typed in? when 1 continue *> Repeat last search when 2 *> grep needs delimiters and something when 3 *> to search for set string-search to true when other if (ws-search(1:1) = ws-search(ws-search-len - 1:1) or (ws-search(1:1) = ws-search(ws-search-len - 2:1) and (ws-search(ws-search-len - 1:1) = "c" or "C"))) and (ws-search(1:1) = "/" or "?" or "=") set grep-search to true if ws-search(ws-search-len - 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 d5-string-search else perform d7-grep-search end-if if not string-found move ws-search-line to ws-cursor-line move ws-search-len to ws-cursor-col perform d3-get-search-string 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 move ws-char-from(ws-scr) to ws-col ws-saved-col move 1 to ws-char-from(ws-scr) else move 1 to ws-col ws-saved-col 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. * Call a system function perform x3-pass-cursor-keys display ss-system-call accept ss-system-call perform x1-intercept-cursor-keys 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) if not ext-call display "COBDATA" upon environment-name display ws-cobdata(1:ws-cobdata-len) upon environment-value end-if call "SYSTEM" using ws-system-text if not ext-call display "COBDATA" upon environment-name display space upon environment-value end-if display "Press any key" accept ws-keypress at 2580 auto set Accept-terminated to true *> Don't end if Esc pressed perform s1-display-screen . c9-file-details section. * Get file details and display them move length ws-full-file-name to ws-full-file-name-len move spaces to ws-full-file-name display space at 0101 foreground-colour yellow with blank screen * If input file is a command, display the command evaluate true when view-file-name(1:1) = "<" move view-file-name(2:) to ws-full-file-name display "Command: " at 0502 view-file-name(2:) display "Press any key" at 0820 accept ws-keypress at 2580 auto set Accept-terminated to true *> Don't end if Esc pressed move ws-scr-linecol(ws-scr) to ws-linecol perform s1-display-screen exit section when view-file-name(1:2) = "./" move view-file-name(3:) to ws-full-file-name when other move zero to ws-mode call "CBL_LOCATE_FILE" using by reference view-file-name ws-mode ws-full-file-spec ws-exist-flag ws-path-flag returning ws-call-status end-evaluate 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 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 0902 ws-dir-name(1:ws-dir-name-len) display "Press any key" at 1220 accept ws-keypress at 2580 auto 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. * Either do a more on the file or edit it using vi. * Other editors are (sometimes) available. Perhaps I should use * an environment variable to override it. * The +n option in vi, and the -p with a G parameter, allow us * to start the edit at the current line. * Don't try and edit pipes. It'll only end in tears. if ws-command-line(1:1) = "<" exit section end-if move spaces to ws-shell move ws-scrline to ws-vi-start evaluate ws-keypress when "E" string "vi +" ws-vi-start " " view-file-name delimited by size into ws-shell when "M" string "more -p " ws-vi-start "G " view-file-name delimited by size into ws-shell end-evaluate 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 evaluate ws-keypress when "E" open input view-file perform d9-load-table when "M" perform s1-display-screen end-evaluate . c13-file-action section. * Call filemanager using this line as the directory name * Call fileview using this line as the file name * Call hexview using this line as the file name * Restore COBDATA if necessary, otherwise terminfo can get lost if not ext-call display "COBDATA" upon environment-name display ws-cobdata(1:ws-cobdata-len) upon environment-value end-if move spaces to ws-shell evaluate ws-keypress when "F" move "fm" to ws-shell when "V" move "fv" to ws-shell when "H" move "hv" to ws-shell end-evaluate string ls-view-tbl(ls-line-offset(ws-scrline) :ls-line-len(ws-scrline)) x'00' delimited by size into ws-shell(4:) call "SYSTEM" using ws-shell if not ext-call display "COBDATA" upon environment-name display space upon environment-value end-if perform s1-display-screen . c15-show-help section. * Show the help screen move ws-linecol to ws-scr-linecol(ws-scr) perform with test after until not User-func or (not Page-Up nonstd and not Page-Up-nonstd) display ss-help-1 accept ws-keypress at 2580 auto display ss-help-2 accept ws-keypress at 2580 auto end-perform set Accept-terminated to true *> Don't end if Esc pressed move ws-scr-linecol(ws-scr) to ws-linecol perform s1-display-screen . c17-syntax section. * Set syntax checking on/off and for what perform x3-pass-cursor-keys move 0101 to ws-cursor * Need to find out what language we're syntax checking for move ws-syntax-language to ws-saved-syntax-language move ws-syntax-on-ind to ws-saved-syntax-on-ind move ws-colour-comments-ind to ws-saved-colour-comments-ind move ws-colour-literals-ind to ws-saved-colour-literals-ind perform with test after until (User-func and Escape-key) or (valid-language and (ws-colour-comments-ind = "Y" or "N") and (ws-colour-literals-ind = "Y" or "N") and (ws-syntax-on-ind = "Y" or "N")) display ss-syntax accept ss-syntax if not (User-func and Escape-key) move function upper-case(ws-colour-comments-ind) to ws-colour-comments-ind move function upper-case(ws-colour-literals-ind) to ws-colour-literals-ind move function upper-case(ws-syntax-on-ind) to ws-syntax-on-ind move function lower-case(ws-syntax-language) to ws-syntax-language end-if end-perform perform x1-intercept-cursor-keys if User-func and Escape-key move ws-saved-colour-comments-ind to ws-colour-comments-ind move ws-saved-colour-literals-ind to ws-colour-literals-ind move ws-saved-syntax-on-ind to ws-syntax-on-ind move ws-saved-syntax-language to ws-syntax-language set Accept-terminated to true *> Don't end if Esc pressed end-if . c19-shell-session section. * The environment variable SHELL contains the shell invocation move z"$SHELL" to ws-shell if not ext-call 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 display "COBDATA" upon environment-name display space upon environment-value end-if . d1-find-file section. * Try to find the file that we've been given the name of * If we haven't been given a name, ask for it if view-file-name = spaces perform x3-pass-cursor-keys display ss-file perform with test after until (User-func and Escape-key) or view-file-name not = spaces accept ss-file end-perform perform x1-intercept-cursor-keys if (User-func and Escape-key) exit section end-if end-if move view-file-name to ws-file-name open input view-file * If we didn't find it, try explicitly looking in the current * directory if no-file and view-file-name(1:2) not = "./" move "./" to view-file-name move ws-file-name to view-file-name(3:) open input view-file 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 view-file-name string ws-last-file(1:ws-ptr) ws-file-name delimited by size into view-file-name open input view-file end-if end-if * Have we found it yet? If not, throw an error. if not valid-io display "File fails to open - " at 0405 ws-file-name if ws-file-status-1 = "9" move ws-file-status-2-num to ws-file-status-2-disp display "Error 9/" at 0605 ws-file-status-2-disp else display "Error " at 0605 ws-file-status end-if if not command-line-name accept ws-keypress at 2580 auto move spaces to view-file-name end-if end-if . d3-get-search-string section. display ss-search accept ss-search-string move ws-cursor-line to ws-search-line move ws-cursor-col to ws-search-len if Tab-key perform with test after until ws-wrap-search-ind = "Y" or "N" or space accept ss-search-wrap move function upper-case(ws-wrap-search-ind) to ws-wrap-search-ind move spaces to ws-search-msg if ws-wrap-search-ind not = "Y" and not = "N" and not = space move "Wrap search must be Y, N (default), or space" to ws-search-msg end-if end-perform end-if . d5-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-search-len > 1 compute ws-str-len = ws-search-len - 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 set search-wrapped to false perform varying ws-ptr from ws-start-line by 1 until string-found or (not wrap-search and ws-ptr > ws-last-line) or (wrap-search and search-wrapped and ws-ptr = ws-start-line) if ws-ptr > ws-last-line and not search-wrapped move zero to ws-ptr set search-wrapped to true exit perform cycle end-if 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-char-from(ws-scr) + ws-col: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 = (c-scrline-len - length "Not found") / 2 move "Not found" to ws-search-msg(ws-search-msg-start:) end-if . d7-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-search-len > 1 if case-sensitive compute ws-str-len = ws-search-len - 4 else compute ws-str-len = ws-search-len - 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 * Compile regular expression * If it's case-insensitive, set the flags appropriately 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 by reference 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 by reference ws-error by value ws-err-len returning ws-regerror-len subtract 1 from ws-regerror-len compute ws-search-msg-start = (c-scrline-len - (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-start-line = (ws-line-from(ws-scr) + ws-l) set search-wrapped to false * 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 string-found or (not wrap-search and ws-ptr > ws-last-line) or (wrap-search and search-wrapped and ws-ptr = ws-start-line) if ws-ptr > ws-last-line and not search-wrapped move zero to ws-ptr set search-wrapped to true exit perform cycle end-if 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 call "regexec" using by reference ws-regex-t by reference ws-grep-line by reference ws-nmatch by reference 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 = (c-scrline-len - length "Not found") / 2 move "Not found" to ws-search-msg(ws-search-msg-start:) end-if . d9-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 open 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 move spaces to view-rec read view-file * We could finish up with a part record error if we're looking * at the data part of a C-ISAM file, so don't do the normal * "at end" check but pick up the status afterwards if ws-file-status-1 = "9" and ws-file-status-2-num = 18 set end-of-file to true end-if if end-of-file exit perform end-if if not valid-io string "File error - " view-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 delimited by size into ws-err-line-2 end-if move 2 to ws-error-code perform z1-stop-error 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 view-rec add ws-rec-len to ws-vfile-offset end-perform close view-file 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 more 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 more to show file" to ws-err-line-2 end-if move 1 to ws-error-code perform z1-stop-error end-if move ws-vfile-offset to ws-vfile-len if ws-line-cnt = zero move "Empty file" to ws-err-line-1 move 2 to ws-error-code 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 move 2 to ws-error-code 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 holding lengths and offsets * of the main table records 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 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 move 2 to ws-error-code 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 and put them 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 view-rec call "CBL_READ_VFILE" using by value ws-vfile-id ws-vfile-offset ws-vfile-buff-len by reference view-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 view-rec to ls-view-tbl(ws-offset:ws-rec-len) add ws-rec-len to ws-offset end-perform * Close the vfile to free up the memory call "CBL_CLOSE_VFILE" using by value ws-vfile-id * Initialize screen pointers for the five screens 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. * Nothing terribly complex, just work out the range of lines * to display and put them into the scr-line array move spaces to ws-scr-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-lines = (ws-line-to(ws-scr) - ws-line-from(ws-scr)) + 1 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. Line length and the main table offset * are modified by the character position that the window is at, so * if our window is showing columns 11-90, the offset is +10 and * the line length is -10. 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 function upper-case(ws-scr-tbl) to ws-uc-scr-tbl move all white-x to ws-scr-fg-colour-map(ws-scr) move all black-x to ws-scr-bg-colour-map(ws-scr) display ss-main * Are we doing syntax checking? if syntax-on or colour-comments or colour-literals evaluate ws-syntax-language when "cobol" perform t1-cobol-syntax-highlight varying ws-scr-ptr from 1 by 1 until ws-scr-ptr > ws-scr-lines when "sh" perform t3-sh-syntax-highlight varying ws-scr-ptr from 1 by 1 until ws-scr-ptr > ws-scr-lines when "c" perform t5-c-syntax-highlight varying ws-scr-ptr from 1 by 1 until ws-scr-ptr > ws-scr-lines when "html" when "php" continue end-evaluate end-if . t1-cobol-syntax-highlight section. * We want to check the syntax on the entire line, then display the * visible bits coloured as appropriate compute ws-ptr = ws-line-from(ws-scr) + (ws-scr-ptr - 1) compute ws-last-scr-char = (ws-char-from(ws-scr) + c-scrline-len) - 1 move ls-line-offset(ws-ptr) to ws-offset move ls-line-len(ws-ptr) to ws-rec-len move ls-view-tbl(ws-offset:ws-rec-len) to ws-check-line if ws-check-line = spaces exit section end-if move function upper-case(ws-check-line) to ws-uc-check-line * If the line is a comment line (* in column 1 or 7), display it * as a comment line and exit if ws-check-line(1:1) = "*" or ws-check-line(7:1) = "*" if colour-comments move 1 to ws-verb-start move length ws-scr-line to ws-verb-len move ws-verb-start to ws-part-start move ws-verb-len to ws-part-len move green to ws-syn-colour perform x7-display-coloured-part end-if exit section end-if * If the significant part of the line is spaces, or all the visible * part of the line is spaces, exit if ws-check-line(8:) = spaces or ws-check-line(ws-char-from(ws-scr):c-scrline-len) = spaces exit section end-if * Need to go along line looking out for quotes and *> * Get the first word on the line and assume that is the * most likely bit to be a verb move zero to ws-quote-start ws-verb-start ws-verb-len set quoted doublequoted to false perform varying ws-syn-ptr from 8 by 1 until ws-syn-ptr > ws-rec-len or ws-check-line(ws-syn-ptr:2) = "*>" evaluate ws-check-line(ws-syn-ptr:1) when "'" if not doublequoted perform u1-process-quote end-if when '"' if not quoted perform u1-process-quote end-if when "(" when ")" if quoted or doublequoted exit perform cycle end-if move ws-verb-start to ws-saved-verb-start move ws-verb-len to ws-saved-verb-len move ws-syn-ptr to ws-verb-start move 1 to ws-verb-len move magenta to ws-syn-colour perform u3-highlight-verb move ws-saved-verb-start to ws-verb-start move ws-saved-verb-len to ws-verb-len when space when "." if ws-verb-start not zero and ws-verb-len zero and not quoted and not doublequoted compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if when other if ws-verb-start zero and not quoted and not doublequoted move ws-syn-ptr to ws-verb-start end-if end-evaluate end-perform * If the first word was also the last, work out how long it was if ws-verb-start not zero and ws-verb-len zero compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if * Is it a comment to the end of the line? if ws-syn-ptr not > ws-rec-len and ws-check-line(ws-syn-ptr:2) = "*>" and ws-syn-ptr not > ws-last-scr-char move ws-verb-start to ws-saved-verb-start move ws-verb-len to ws-saved-verb-len if colour-comments compute ws-part-start = (ws-syn-ptr - ws-char-from(ws-scr)) + 1 compute ws-part-len = (length ws-scr-line - ws-syn-ptr) + 1 move green to ws-syn-colour perform x7-display-coloured-part end-if end-if if ws-verb-start zero move spaces to ws-verb else move ws-uc-check-line(ws-verb-start:ws-verb-len) to ws-verb end-if if syntax-on evaluate true when std-cobol-divn when std-cobol-section move zero to ws-tally if std-cobol-divn inspect ws-uc-check-line tallying ws-tally for all " DIVISION" else inspect ws-uc-check-line tallying ws-tally for all " SECTION" end-if if ws-tally > zero compute ws-verb-len = (ws-rec-len - ws-verb-start) + 1 move blue to ws-syn-colour perform u3-highlight-verb end-if when std-cobol-para move blue to ws-syn-colour perform u3-highlight-verb when flow-cobol-verb move yellow to ws-syn-colour perform u3-highlight-verb when condition-cobol-verb move magenta to ws-syn-colour perform u3-highlight-verb when set-value-cobol-verb move red to ws-syn-colour perform u3-highlight-verb end-evaluate end-if . t3-sh-syntax-highlight section. * We want to check the syntax on the entire line, then display the * visible bits coloured as appropriate compute ws-ptr = ws-line-from(ws-scr) + (ws-scr-ptr - 1) compute ws-last-scr-char = (ws-char-from(ws-scr) + c-scrline-len) - 1 move ls-line-offset(ws-ptr) to ws-offset move ls-line-len(ws-ptr) to ws-rec-len move ls-view-tbl(ws-offset:ws-rec-len) to ws-check-line if ws-check-line = spaces exit section end-if * If the line is a comment line (# is first non-whitespace char), * display it as a comment line and exit perform varying ws-ptr from 1 by 1 until ws-check-line(ws-ptr:1) not = space and not = x'09' end-perform if ws-check-line(ws-ptr:1) = "#" and ws-ptr < ws-last-scr-char if colour-comments move 1 to ws-part-start move length ws-scr-line to ws-part-len move green to ws-syn-colour perform x7-display-coloured-part end-if exit section end-if * If the significant part of the line is spaces, or all the visible * part of the line is spaces, exit if ws-check-line(ws-ptr:) = spaces or ws-check-line(ws-char-from(ws-scr):c-scrline-len) = spaces exit section end-if * Need to go along line looking out for quotes and # * Get the first word on the line and assume that is the * most likely bit to be significant * To add a bit of complexity, let's cater for tests using [] and [[]] * And also for embedded commands using $() and expressions using $(()) move zero to ws-quote-start ws-verb-start ws-verb-len set quoted doublequoted bracketed cmd-start expr-start to false * ws-ptr is set to the first non-whitespace character perform varying ws-syn-ptr from ws-ptr by 1 until ws-syn-ptr > ws-rec-len or (ws-check-line(ws-syn-ptr:1) = "#" and not quoted and not doublequoted) evaluate ws-check-line(ws-syn-ptr:1) when "'" if not doublequoted perform u1-process-quote end-if when '"' if not quoted perform u1-process-quote end-if when space if ws-verb-start not zero and ws-verb-len zero and not quoted and not doublequoted compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if when "[" when "]" if quoted or doublequoted exit perform cycle end-if move ws-verb-start to ws-saved-verb-start move ws-verb-len to ws-saved-verb-len move ws-syn-ptr to ws-verb-start * Could be enhanced test using [[ ]] if ws-check-line(ws-syn-ptr:2) = "[[" or "]]" move 2 to ws-verb-len add 1 to ws-syn-ptr else move 1 to ws-verb-len end-if move magenta to ws-syn-colour perform u3-highlight-verb move ws-saved-verb-start to ws-verb-start move ws-saved-verb-len to ws-verb-len when "$" when ")" when "`" if quoted or doublequoted exit perform cycle end-if * Could be a plain old environment variable, s apecial * variable, an embedded command $(command)/``, or an * expression $((expression)) move ws-verb-start to ws-saved-verb-start move ws-verb-len to ws-saved-verb-len move ws-syn-ptr to ws-verb-start evaluate true when ws-check-line(ws-syn-ptr:2) = "$ " when ws-check-line(ws-syn-ptr:2) = "$)" when ws-check-line(ws-syn-ptr:2) = "$]" * Special variable move 2 to ws-verb-len move blue to ws-syn-colour perform u3-highlight-verb when ws-check-line(ws-syn-ptr:2) = "$#" when ws-check-line(ws-syn-ptr:2) = "$-" when ws-check-line(ws-syn-ptr:2) = "$?" when ws-check-line(ws-syn-ptr:2) = "$$" when ws-check-line(ws-syn-ptr:2) = "$!" when ws-check-line(ws-syn-ptr:2) = "$*" when ws-check-line(ws-syn-ptr:2) = "$@" when ws-check-line(ws-syn-ptr:2) = "$0" when ws-check-line(ws-syn-ptr:2) = "$1" when ws-check-line(ws-syn-ptr:2) = "$2" when ws-check-line(ws-syn-ptr:2) = "$3" when ws-check-line(ws-syn-ptr:2) = "$4" when ws-check-line(ws-syn-ptr:2) = "$5" when ws-check-line(ws-syn-ptr:2) = "$6" when ws-check-line(ws-syn-ptr:2) = "$7" when ws-check-line(ws-syn-ptr:2) = "$8" when ws-check-line(ws-syn-ptr:2) = "$9" * Special variable or parameter move 2 to ws-verb-len move blue to ws-syn-colour perform u3-highlight-verb add 1 to ws-syn-ptr when ws-check-line(ws-syn-ptr:3) = "$((" * Start of an expression move 3 to ws-verb-len move red to ws-syn-colour perform u3-highlight-verb set expr-start to true add 2 to ws-syn-ptr when ws-check-line(ws-syn-ptr:2) = "$(" * Start of an embedded command move 2 to ws-verb-len move red to ws-syn-colour perform u3-highlight-verb set cmd-start to true add 1 to ws-syn-ptr when ws-check-line(ws-syn-ptr:2) = "))" * End of an expression move 2 to ws-verb-len move red to ws-syn-colour perform u3-highlight-verb set expr-start to false add 1 to ws-syn-ptr when ws-check-line(ws-syn-ptr:1) = ")" * Could be the end of a bracketed condition, the end * of an embedded command, or the ) of a case statement evaluate true when bracketed set bracketed to false when cmd-start move 1 to ws-verb-len move red to ws-syn-colour perform u3-highlight-verb set cmd-start to false when other move 1 to ws-verb-len move magenta to ws-syn-colour perform u3-highlight-verb end-evaluate when ws-check-line(ws-syn-ptr:1) = "`" * Start or end of an embedded command using ticks move 1 to ws-verb-len move red to ws-syn-colour perform u3-highlight-verb when other * Start of an environment variable if ws-check-line(ws-syn-ptr:2) = "${" perform varying ws-verb-len from 1 by 1 until (ws-syn-ptr + ws-verb-len) > length ws-check-line or ws-check-line(ws-syn-ptr + ws-verb-len:1) = "}" end-perform add 1 to ws-verb-len else perform varying ws-verb-len from 1 by 1 until (ws-syn-ptr + ws-verb-len) > length ws-check-line or ws-check-line(ws-syn-ptr + ws-verb-len:1) = space or ws-check-line(ws-syn-ptr + ws-verb-len:1) = "-" or (ws-check-line(ws-syn-ptr + ws-verb-len:1) not numeric and ws-check-line(ws-syn-ptr + ws-verb-len:1) not alphabetic and ws-check-line(ws-syn-ptr + ws-verb-len:1) not = "_") end-perform end-if move yellow to ws-syn-colour perform u3-highlight-verb compute ws-syn-ptr = ws-syn-ptr + (ws-verb-len - 1) end-evaluate move ws-saved-verb-start to ws-verb-start move ws-saved-verb-len to ws-verb-len when "(" if quoted or doublequoted exit perform cycle end-if set bracketed to true when other if ws-verb-start zero and not quoted and not doublequoted move ws-syn-ptr to ws-verb-start end-if end-evaluate end-perform * If the first word was also the last, work out how long it was if ws-verb-start not zero and ws-verb-len zero compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if * Is it a comment to the end of the line? if ws-syn-ptr not > ws-rec-len and ws-check-line(ws-syn-ptr:1) = "#" and ws-syn-ptr not > ws-last-scr-char if colour-comments compute ws-part-start = (ws-syn-ptr - ws-char-from(ws-scr)) + 1 compute ws-part-len = (length ws-scr-line - ws-syn-ptr) + 1 move green to ws-syn-colour perform x7-display-coloured-part end-if end-if if ws-verb-start zero move spaces to ws-verb else move ws-check-line(ws-verb-start:ws-verb-len) to ws-verb end-if if syntax-on evaluate true when flow-sh-verb move magenta to ws-syn-colour perform u3-highlight-verb when condition-sh-verb move magenta to ws-syn-colour perform u3-highlight-verb when misc-sh-verb move red to ws-syn-colour perform u3-highlight-verb end-evaluate end-if . t5-c-syntax-highlight section. * We want to check the syntax on the entire line, then display the * visible bits coloured as appropriate compute ws-ptr = ws-line-from(ws-scr) + (ws-scr-ptr - 1) compute ws-last-scr-char = (ws-char-from(ws-scr) + c-scrline-len) - 1 move ls-line-offset(ws-ptr) to ws-offset move ls-line-len(ws-ptr) to ws-rec-len move ls-view-tbl(ws-offset:ws-rec-len) to ws-check-line if ws-check-line = spaces exit section end-if * If the line is a comment line (/* are first non-whitespace chars), * display it as a comment line and exit perform varying ws-ptr from 1 by 1 until ws-check-line(ws-ptr:1) not = space and not = x'09' end-perform if ws-check-line(ws-ptr:2) = "/*" and ws-ptr < ws-last-scr-char if colour-comments move 1 to ws-part-start move length ws-scr-line to ws-part-len move green to ws-syn-colour perform x7-display-coloured-part end-if exit section end-if * If the significant part of the line is spaces, or all the visible * part of the line is spaces, exit if ws-check-line(ws-ptr:) = spaces or ws-check-line(ws-char-from(ws-scr):c-scrline-len) = spaces exit section end-if * Need to go along line looking out for quotes and /* * Get the first word on the line and assume that is the * most likely bit to be significant * Let's mark brackets up too move zero to ws-quote-start ws-verb-start ws-verb-len set quoted doublequoted bracketed cmd-start expr-start to false * ws-ptr is set to the first non-whitespace character perform varying ws-syn-ptr from ws-ptr by 1 until ws-syn-ptr > ws-rec-len or ws-scr-line(ws-scr-ptr)(ws-syn-ptr:2) = "/*" evaluate ws-check-line(ws-syn-ptr:1) when "'" if not doublequoted perform u1-process-quote end-if when '"' if not quoted perform u1-process-quote end-if when space if ws-verb-start not zero and ws-verb-len zero and not quoted and not doublequoted compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if when "(" if ws-verb-start not zero and ws-verb-len zero and not quoted and not doublequoted compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if if quoted or doublequoted exit perform cycle end-if move ws-verb-start to ws-saved-verb-start move ws-verb-len to ws-saved-verb-len move ws-syn-ptr to ws-verb-start move 1 to ws-verb-len move magenta to ws-syn-colour perform u3-highlight-verb move ws-saved-verb-start to ws-verb-start move ws-saved-verb-len to ws-verb-len when "{" when "}" when "[" when "]" when ")" if quoted or doublequoted exit perform cycle end-if move ws-verb-start to ws-saved-verb-start move ws-verb-len to ws-saved-verb-len move ws-syn-ptr to ws-verb-start move 1 to ws-verb-len move magenta to ws-syn-colour perform u3-highlight-verb move ws-saved-verb-start to ws-verb-start move ws-saved-verb-len to ws-verb-len when other if ws-verb-start zero and not quoted and not doublequoted move ws-syn-ptr to ws-verb-start end-if end-evaluate end-perform * If the first word was also the last, work out how long it was if ws-verb-start not zero and ws-verb-len zero compute ws-verb-len = ws-syn-ptr - ws-verb-start end-if * Is it a comment to the end of the line? if ws-syn-ptr not > ws-rec-len and ws-check-line(ws-syn-ptr:2) = "/*" and ws-syn-ptr not > ws-last-scr-char if colour-comments compute ws-part-start = (ws-syn-ptr - ws-char-from(ws-scr)) + 1 compute ws-part-len = (length ws-scr-line - ws-syn-ptr) + 1 move green to ws-syn-colour perform x7-display-coloured-part end-if end-if if ws-verb-start zero move spaces to ws-verb else move ws-check-line(ws-verb-start:ws-verb-len) to ws-verb end-if if syntax-on evaluate true when flow-c-verb move yellow to ws-syn-colour perform u3-highlight-verb when condition-c-verb move magenta to ws-syn-colour perform u3-highlight-verb when misc-c-verb move red to ws-syn-colour perform u3-highlight-verb end-evaluate end-if . u1-process-quote section. * If this is the start of a literal, set ws-quote-start and * flag which type of quote, then exit * COBOL - we might have a continuation mark in column 7, in which * case we treat column 7 as the quote start and the quote as the * literal end if ws-uc-scr-line(ws-scr-ptr)(ws-syn-ptr:1) = "'" if not quoted set quoted to true if ws-syntax-language = "cobol" and ws-uc-scr-line(ws-scr-ptr)(7:1) = "-" move 7 to ws-quote-start else move ws-syn-ptr to ws-quote-start exit section end-if end-if else if not doublequoted set doublequoted to true if ws-syntax-language = "cobol" and ws-uc-scr-line(ws-scr-ptr)(7:1) = "-" move 7 to ws-quote-start else move ws-syn-ptr to ws-quote-start exit section end-if end-if end-if * Is any part of the quoted string going to be visible? if ws-quote-start > ws-last-scr-char or ws-syn-ptr < ws-char-from(ws-scr) exit section end-if * Now work out the start and length of the string to display relative * to the screen line compute ws-quote-len = (ws-syn-ptr - ws-quote-start) + 1 if ws-quote-start > ws-char-from(ws-scr) compute ws-quote-start = (ws-quote-start - ws-char-from(ws-scr)) + 1 else move 1 to ws-quote-start end-if if (ws-quote-start + ws-quote-len) - 1 > c-scrline-len compute ws-quote-len = (c-scrline-len - ws-quote-start) + 1 end-if if colour-literals move ws-quote-start to ws-part-start move ws-quote-len to ws-part-len move cyan to ws-syn-colour perform x7-display-coloured-part end-if move zero to ws-quote-start set quoted doublequoted to false . u3-highlight-verb section. * Is any part of the verb going to be visible? if ws-verb-start > ws-last-scr-char or (ws-verb-start + ws-verb-len) - 1 < ws-char-from(ws-scr) exit section end-if * We captured the start and length of the first word on the line when * we were going through the line, so we just display that bit if ws-verb-start > ws-char-from(ws-scr) compute ws-verb-start = (ws-verb-start - ws-char-from(ws-scr)) + 1 else move 1 to ws-verb-start end-if if (ws-verb-start + ws-verb-len) - 1 > c-scrline-len compute ws-verb-len = (c-scrline-len - ws-verb-start) + 1 end-if move ws-verb-start to ws-part-start move ws-verb-len to ws-part-len perform x7-display-coloured-part . 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-pass-cursor-keys-not-tab section. * Set the cursor-moving ADIS keys to normal behaviour * but leave the Tab keys to be intercepted move "2" to ws-key-control-type move 2 to ws-key-setting move 3 to ws-first-key-num move 5 to ws-num-of-keys call x"AF" using ws-set-bit-pairs ws-key-control . x7-display-coloured-part section. * I can't use an integer field as a foreground colour, only a 78 * level, so load the integers into the control ws-ctrl move ws-syn-colour to ws-ctrl-fg-colour if ws-syn-colour = blue or black move white to ws-ctrl-bg-colour else move black to ws-ctrl-bg-colour end-if move ws-part-start to ws-syn-col compute ws-syn-line = ws-scr-ptr + (ws-scr-start-line - 1) display ws-scr-line(ws-scr-ptr)(ws-part-start:ws-part-len) at ws-syn-linecol with control ws-ctrl perform varying ws-col-ptr from ws-syn-col by 1 until ws-col-ptr > (ws-part-start + (ws-part-len - 1)) move ws-ctrl-fg-colour to ws-scr-fg-colour-char (ws-scr ws-scr-ptr ws-col-ptr) move ws-ctrl-bg-colour to ws-scr-bg-colour-char (ws-scr ws-scr-ptr ws-col-ptr) end-perform . 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 fileview.