// A L T O E X E C U T I V E // User Input Module - ExecInput.bcpl // Copyright Xerox Corporation 1980 // last modified by R. Johnsson, May 21, 1980 10:27 PM get "streams.d" get "altofilesys.d" get "COMSTRUCT.BCPL" static [ ShouldFlash = false ] let Cancel() = LASTONEINKEYS(CONTROLC) ne 0 and EDITCHARS(TOQ, FROMQ, PROMPT, OKFORTIMEOUT, Terminators, OverwritePreload; numargs na) = valof [ if PROMPT ne 0 then InitUserLine(PROMPT) if na ls 6 then OverwritePreload = false let InPreload = not ISEMPTYQ(FROMQ) let C = GNC(FROMQ, (na gr 3? OKFORTIMEOUT, true)& ISEMPTYQ(TOQ)) [ if (na le 4)? C eq $*N, valof [ for i=1 to Terminators>>STRING.length do if C eq Terminators>>STRING.char^i then resultis true resultis false ] then [ PUTQR(TOQ, C) resultis true ] switchon C into [ case NULL: endcase case CONTROLA: case BACKSPACE: test ISEMPTYQ(TOQ) ifso if PROMPT ne 0 then [ WRITE($?) InitUserLine(PROMPT) ] ifnot [ let char = GETQR(TOQ) if PROMPT ne 0 then unless EraseChar(char) do OverType(TOQ, PROMPT) ] endcase case CONTROLW: DeleteWord(TOQ, PROMPT) endcase case $^: case $': if PROMPT ne 0 then WRITE(C) PUTQR(TOQ, C) C = GNC(FROMQ, false) if PROMPT ne 0 then WRITE(C) PUTQR(TOQ, C) endcase case CONTROLU: CALLBRAVO = true endcase case CONTROLX: [ let MYBQ = vec size QS/16 INITQ(MYBQ) APPENDQ(MYBQ, MYBQ, TOQ) PUTQR(MYBQ, $*N) // Add CR for EXPAND INITQ(TOQ) unless EXPAND(TOQ, MYBQ, true) do resultis false GETQR(TOQ) // Remove added CR RETYPE(TOQ, WRITE, PROMPT) ] endcase case CONTROLC: if PROMPT ne 0 then WRITE(CONTROLC) resultis false case DELETEKEY: EMPTYOUTQ(TOQ) CALLBRAVO = false if PROMPT ne 0 then [ WRITE("*SXXX") InitUserLine(PROMPT) ] endcase case ESCAPE: [ let REMQ = vec size QS/16 INITQ(REMQ) test EXPANDESC(TOQ, REMQ, true) ne 1 ifso ShouldFlash = true ifnot PUTQR(REMQ, CONDSP) APPENDQ(FROMQ, REMQ, FROMQ) ] endcase case CONDSP: C = GNC(FROMQ, false) if ISFILECHAR(C) & (C ne $!) & (C ne $$) then [ if PROMPT ne 0 then WRITE($*S) PUTQR(TOQ, $*S) ] loop case $*T: case $?: [ if PROMPT ne 0 then WRITE($?) let MYQ = vec size QS/16 INITQ(MYQ) PUTQR(MYQ, $?) let S = vec 20 let DE = GETSUBSYS(MYQ, S, ";") EMPTYOUTQ(MYQ) COPYQ(TOQ, MYQ) QFToComCm(MYQ) CALLIFLOCAL(DE) if C eq $*T then XFERQWHILE(GETQR, PUTQR, TOQ, PUTQF, MYQ, IsCommandChar) EMPTYOUTQ(MYQ) InitUserLine(PROMPT) MapQ(TOQ, WRITE) ] endcase case $*L: case 201b: case 202b: case 203b: [ let filename = nil test C eq $*L ifso filename = "Line.cm" ifnot [ let num = C - 200b filename = "Key0.cm" filename>>STRING.char^4 = num + $0 ] let s = MyOpenFile(filename, ksTypeReadOnly, charItem) if s eq 0 then endcase until Endofs(s) do [ let c = Gets(s) if PROMPT ne 0 then WRITE(c) PUTQR(TOQ, c) ] Closes(s) endcase ] default: if (not InPreload) & OverwritePreload then [ EMPTYOUTQ(TOQ) if PROMPT ne 0 then OverType(TOQ, PROMPT) ] if PROMPT ne 0 then WRITE(C) PUTQR(TOQ, C) ] unless InPreload do OverwritePreload = false InPreload = not ISEMPTYQ(FROMQ) C = GNC(FROMQ, OKFORTIMEOUT&ISEMPTYQ(TOQ)) ] repeat ] and RemoveUpArrows(Q) be [ let DestQ = vec size QS/16 INITQ(DestQ) until ISEMPTYQ(Q) do [ let C = GETQF(Q) if C eq $^ then [ DIDEXPAND = true unless ISEMPTYQ(Q) do C = GETQF(Q) loop ] if C eq $' then [ DIDEXPAND = true unless ISEMPTYQ(Q) do C = GETQF(Q) ] PUTQR(DestQ, C) ] APPENDQ(Q, DestQ, Q) ] and GNC(Q, OKFORTIMEOUT) = ISEMPTYQ(Q)? valof [ if ShouldFlash then [ FlashScreen() ShouldFlash = false ] if Endofs(keys) then TwiddleThumbs(OKFORTIMEOUT? Q, 0) unless ISEMPTYQ(Q) resultis GETQF(Q) resultis Gets(keys) ] , GETQF(Q) and DeleteWord(Q, PROMPT) be [ if ISEMPTYQ(Q) then [ if PROMPT ne 0 then [ WRITE($?) InitUserLine(PROMPT) ] return ] let C = GETQR(Q) let erasing = true until ISEMPTYQ(Q) % IsCommandChar(C) do [ if erasing then erasing = EraseChar(C) C = GETQR(Q) ] if ISEMPTYQ(Q) then [ if erasing then erasing = EraseChar(C) if PROMPT ne 0 & (not erasing) then OverType(Q, PROMPT) return ] until ISEMPTYQ(Q) % ISNTFILECHAR(C) do [ if erasing then erasing = EraseChar(C) C = GETQR(Q) ] test IsCommandChar(C) ifso if erasing then erasing = EraseChar(C) ifnot PUTQR(Q, C) if PROMPT ne 0 & (not erasing) then OverType(Q) ] and EXPAND(LQ, BQ, FULLBUF; numargs NA) = valof [ if NA ls 3 then FULLBUF = false if ISEMPTYQ(BQ) then resultis true let C = GETQF(BQ) let INFILENAME = false let HASASTAR = false [ if HASASTAR & (not ISITEMCHAR(C)) do [ EXPANDSTAR(LQ) HASASTAR = false DIDEXPAND = true ] switchon C into [ case $;: case $*N: if INFILENAME then [ PUTQF(BQ, C) PUTQF(BQ, $@) // Convenience endcase ] test FULLBUF ifso [ PUTQR(LQ, C) ] ifnot [ PUTQR(LQ, $*N) until ISEMPTYQ(BQ) do [ let NC = GETQF(BQ) if (NC ne $*N) & (NC ne $;) then [ PUTQF(BQ, NC) break ] ] resultis true ] endcase case $^: case $': PUTQR(LQ, C) PUTQR(LQ, GETQF(BQ)) endcase case $/: C = GETQF(BQ) test C eq $/ ifso [ while (C ne $*N) & (C ne $;) do C = GETQF(BQ) ] ifnot PUTQR(LQ, $/) loop endcase case $@: INFILENAME = not INFILENAME test INFILENAME ifso PUTQR(LQ, $@) ifnot [ let EXPQ = vec size QS/16 INITQ(EXPQ) unless SUBSTFILE(LQ, EXPQ) do resultis 0 test FULLBUF ifso APPENDQ(LQ, LQ, EXPQ) ifnot APPENDQ(BQ, EXPQ, BQ) ] endcase case $**: case $#: PUTQR(LQ, C) HASASTAR = true endcase default: PUTQR(LQ, C) ] if ISEMPTYQ(BQ) then [ if HASASTAR then [ EXPANDSTAR(LQ) DIDEXPAND = true ] resultis true ] if ISEMPTYQ(BQ) then resultis true C = GETQF(BQ) ] repeat ] and SUBSTFILE(LQ, Q) = valof [ if LOOKFORCTLC() then resultis false let FNQ = vec size QS/16 INITQ(FNQ) let C = GETQR(LQ) while C ne $@ do [ PUTQF(FNQ, C) C = GETQR(LQ) ] let STR = vec 200 let MYDE = GETSUBSYS(FNQ, STR, ".CM.;**.CM.;.;**.") EMPTYOUTQ(FNQ) let V = true switchon MYDE into [ default: if (MYDE>>MYDE.TYPE eq ISFILE) then [ let FILE = MyOpenFile(STR, ksTypeReadOnly, charItem) STREAMTOQR(FILE, FNQ) Closes(FILE) APPENDQ(Q, FNQ, Q) INITQ(FNQ) PUTQR(Q, $*N) // To make EDITCHARS stop EDITCHARS(FNQ, Q, 0, false) APPENDQ(Q, FNQ, Q) GETQR(Q) // Removes extra CR endcase ] case NONAME: case NOFILE: WRITE(FORMATN( "*NFile name *"*" unknown. Type what it would contain.", STR)) V = ASKUSER(FNQ) unless ISEMPTYQ(FNQ) do GETQR(FNQ) // Remove final // CR APPENDQ(Q, FNQ, Q) endcase ] DIDEXPAND = true resultis V ] and ASKUSER(Q) = valof [ Resets(keys) // FLUSH KBD let MYQ = vec size QS/16 INITQ(MYQ) resultis EDITCHARS(Q, MYQ, ">>", false) ] and ISNTITEMCHAR(C) = not ISITEMCHAR(C)