(FILECREATED " 4-Aug-85 04:10:33" {ERIS}<LISPCORE>SOURCES>PASSWORDS.;39 31068
changes to: (FNS \INTERNAL/GETPASSWORD)
previous date: "17-May-85 19:40:38" {ERIS}<LISPCORE>SOURCES>PASSWORDS.;38)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PASSWORDSCOMS)
(RPAQQ PASSWORDSCOMS ([COMS (FNS LOGIN SETPASSWORD \INTERNAL/GETPASSWORD \INTERNAL/SETPASSWORD
\LOGIN.READ PROVIDE.PROMPTING.WINDOW \ADJUST.USERNAME \ENCRYPT.PWD
\DECRYPT.PWD)
[INITVARS (LOGINPASSWORDS (HASHARRAY 8))
(\GETPASSWORD.LOCK (CREATE.MONITORLOCK "GetPassword"))
(DEFAULTREGISTRY)
(\AFTERLOGINFNS)
(\PROC.READY T)
(UNSCHEDULEDPROMPTREGION (QUOTE (262 466 500 100]
(GLOBALVARS LOGINPASSWORDS USERNAME \GETPASSWORD.LOCK DEFAULTREGISTRY
\AFTERLOGINFNS UNSCHEDULEDPROMPTREGION \PROC.READY
TTYREGIONOFFSETS \TTYREGIONOFFSETSPTR)
(DECLARE: EVAL@COMPILE DONTCOPY (PROP DMACRO EMPASSWORDLOC)
(EXPORT (MACROS \DECRYPT.PWD.CHAR)))
(P (MOVD? (QUOTE NILL)
(QUOTE CLBUFS]
(COMS (* PROMPTFORWORD)
(FNS PROMPTFORWORD \PROMPTFORWORDBIN \PROMPTFORWORDERASE \PROMPTFORWORDBS
\PROMPTFORWORDRETYPE)
(INITVARS (\PROMPTFORWORDTTBL NIL)
(\PROMPTFORWORD.CURSOR))
(GLOBALVARS \PROMPTFORWORDTTBL \PROMPTFORWORD.CURSOR))
(LOCALVARS . T)))
(DEFINEQ
(LOGIN
[LAMBDA (HOST FLG DIRECTORY MSG) (* bvm: "24-Jul-84 18:11")
(* Forces a login at HOST optionally connecting to DIRECTORY, and returns the name logged in.
MSG is optional message string to print before asking)
(PROG ((NSFLG (STRPOS ":" HOST)))
(RETURN (CAR (\INTERNAL/GETPASSWORD (SELECTQ HOST
((NIL NS:: GV)
HOST)
(OR (COND
(NSFLG (\CANONICAL.NSHOSTNAME HOST))
(T (\CANONICAL.HOSTNAME HOST)))
(ERROR "Host not found" HOST)))
(NEQ FLG (QUOTE QUIET))
DIRECTORY MSG NIL (AND NSFLG (QUOTE NS])
(SETPASSWORD
[LAMBDA (HOST USER PASSWORD DIRECTORY) (* bvm: "13-May-85 17:44")
(CAR (\INTERNAL/SETPASSWORD (AND HOST (OR (CANONICAL.HOSTNAME HOST)
HOST))
(CONS (AND USER (MKSTRING USER))
(MKSTRING PASSWORD))
DIRECTORY])
(\INTERNAL/GETPASSWORD
[LAMBDA (HOST ALWAYSASK DIRECTORY MSG DEFAULTNAME OSTYPE)
(* lmm " 4-Aug-85 04:10")
(* returns (name . password) with which to login (or connect if DIRECTORY given) at HOST, performing an alto-style
login if necessary, or if ALWAYSASK is true. MSG is optional message string to print before asking)
[COND
((AND HOST (NOT OSTYPE)
(STRPOS ":" HOST))
(SETQ OSTYPE (QUOTE NS]
(PROG ((INFO (GETHASH (if (STRINGP HOST)
then (MKATOM (U-CASE HOST))
else HOST)
LOGINPASSWORDS))
NAME/PASS)
(COND
([AND (NOT ALWAYSASK)
(SETQ NAME/PASS (COND
(DIRECTORY [IF (STRINGP DIRECTORY)
THEN (SETQ DIRECTORY (MKATOM (U-CASE DIRECTORY]
(ASSOC DIRECTORY (CDR INFO)))
(T (CAR INFO] (* We already have login info)
(RETURN NAME/PASS)))
(RETURN (\INTERNAL/SETPASSWORD HOST NIL DIRECTORY ALWAYSASK MSG DEFAULTNAME OSTYPE])
(\INTERNAL/SETPASSWORD
[LAMBDA (HOST NEWNAME/PASS DIRECTORY ALWAYSASK MSG DEFAULTNAME OSTYPE)
(* bvm: "17-May-85 19:37")
(LET (RESULT INFOCHANGED)
[SETQ RESULT
(WITH.MONITOR
\GETPASSWORD.LOCK (* Don't grab the monitor til now, since we don't
really care if what we fetched above was about to
change)
(CAR
(NLSETQ
(PROG ((INFO (GETHASH HOST LOGINPASSWORDS))
PASSWORDADDR NAME/PASS DISKNAME PWD NSINFO NEWNAME)
(COND
(DIRECTORY [COND
((NOT INFO)
(SETQ INFO (PUTHASH HOST (CONS)
LOGINPASSWORDS]
[COND
((NOT NEWNAME/PASS)
(SETQ NEWNAME/PASS (COND
((NULL ALWAYSASK) (* First time, guess that no password is needed)
(CONS DIRECTORY ""))
(T (\LOGIN.READ HOST DIRECTORY MSG T OSTYPE]
[COND
(NEWNAME/PASS
(COND
[(SETQ NAME/PASS (ASSOC DIRECTORY (CDR INFO)))
(RPLACD NAME/PASS (\ENCRYPT.PWD (CONCAT (CDR NEWNAME/PASS]
(T (RPLACD INFO (CONS [CONS (CAR NEWNAME/PASS)
(\ENCRYPT.PWD (CONCAT
(CDR NEWNAME/PASS]
(CDR INFO]
(RETURN NEWNAME/PASS))
(T [COND
((EQ (SYSTEMTYPE)
(QUOTE D))
[OR OSTYPE (SETQ OSTYPE (COND
(HOST (GETOSTYPE HOST))
(T (QUOTE LOCAL]
(COND
((NEQ (SETQ PASSWORDADDR (EMPASSWORDLOC))
0)
(SETQ PASSWORDADDR (EMPOINTER PASSWORDADDR]
[COND
((EQ OSTYPE (QUOTE NS))
(SETQ NSINFO (GETHASH (QUOTE NS::)
LOGINPASSWORDS]
(SETQ DISKNAME (\ADJUST.USERNAME (USERNAME NIL T T)
OSTYPE))
(COND
(NEWNAME/PASS [SETQ NAME/PASS (CONS (CAR NEWNAME/PASS)
(CONCAT (CDR NEWNAME/PASS]
(SETQ INFOCHANGED T))
[(AND NSINFO (NULL ALWAYSASK)) (* For NS hosts, there is a uniform login.
Try that first)
(SETQ NAME/PASS (CONS (CAAR NSINFO)
(\DECRYPT.PWD (CDAR NSINFO]
[(PROGN [SETQ DEFAULTNAME (COND
((NOT DEFAULTNAME)
(OR (CAAR (OR NSINFO INFO))
DISKNAME))
(T (\ADJUST.USERNAME DEFAULTNAME OSTYPE]
(AND (NULL ALWAYSASK)
DISKNAME PASSWORDADDR (OR (EQ DEFAULTNAME DISKNAME)
(EQ (ALPHORDER DEFAULTNAME DISKNAME
UPPERCASEARRAY)
(QUOTE EQUAL)))
(IGREATERP (NCHARS (SETQ PWD (GetBcplString PASSWORDADDR)))
0))) (* Try using the global password if DEFAULTNAME matches
the global name. Match is case-insensitive, of course)
(SETQ NAME/PASS (CONS DEFAULTNAME (SETQ PWD (SELECTQ
OSTYPE
(UNIX (L-CASE PWD))
(TENEX (U-CASE PWD))
PWD]
(T (SETQ NAME/PASS (\LOGIN.READ HOST DEFAULTNAME MSG NIL OSTYPE))
(SETQ INFOCHANGED T)))
(SETQ NEWNAME (CAR NAME/PASS))
[COND
(INFOCHANGED [COND
[(EQ OSTYPE (QUOTE NS))
(* Don't touch alto login)
(COND
((OR (NULL NSINFO)
(EQ (CAAR NSINFO)
NEWNAME))
(FRPLACA (OR NSINFO (PUTHASH (QUOTE NS::)
(CONS)
LOGINPASSWORDS))
NAME/PASS]
((EQ NEWNAME DISKNAME)
(AND PASSWORDADDR (SetBcplString PASSWORDADDR
(CDR NAME/PASS]
(COND
((OR (NULL HOST)
(NULL DISKNAME)
(AND (NEQ OSTYPE (QUOTE NS))
PASSWORDADDR
(EQ (\GETBASE PASSWORDADDR 0)
0)))
(* There was no password before, or user forced login)
(COND
((GETD (QUOTE SETUSERNAME))
(SETUSERNAME (COND
(NEWNAME (COND
((EQ OSTYPE (QUOTE NS))
(\ADJUST.USERNAME
NEWNAME
(QUOTE LOCAL)))
(T NEWNAME)))
(T "")))
(AND PASSWORDADDR (SetBcplString
PASSWORDADDR
(COND
(NEWNAME (CDR NAME/PASS))
(T ""]
(COND
((NULL HOST)
(CLRHASH LOGINPASSWORDS)
(COND
((NULL NEWNAME)
(RETURN NIL)))
(SETQ INFO)))
(\ENCRYPT.PWD (CDR NAME/PASS))
(FRPLACA (OR INFO (PUTHASH HOST (CONS)
LOGINPASSWORDS))
NAME/PASS)))
(RETURN NAME/PASS]
[COND
(INFOCHANGED (for FN in \AFTERLOGINFNS
do (* Report change to any user packages that cache user
info)
(APPLY* FN HOST (CAR RESULT]
RESULT])
(\LOGIN.READ
[LAMBDA (HOST DEFAULTNAME MSG CONNECTFLG OSTYPE) (* bvm: "15-Aug-84 16:02")
(PROG [(PROMPT (COND
((NEQ OSTYPE (QUOTE NS))
"Login: ")
(HOST (* This would get to be a pretty long line)
" (terminate input with <return>)
Login: ")
(T "Login (<return> to terminate): ")))
(HELPFN
"
You are being asked for a user name and password for login.
Type <return> to accept the given user name, or <BS> to back
up over it, or type a new name followed by <return>.
")
(TERMINATIONS (COND
((EQ OSTYPE (QUOTE NS))
(CHARCODE (CR LF)))
(T (* default)
NIL]
(COND
(CONNECTFLG (SETQ PROMPT (CONCAT "Connect password for " DEFAULTNAME ": "))
(SETQ HELPFN "Type <return> followed by the password for the directory.
")))
[COND
(HOST (SETQ PROMPT (CONCAT "{" HOST "} " PROMPT]
[COND
(MSG (SETQ PROMPT (CONCAT MSG (CONSTANT (CHARACTER (CHARCODE EOL)))
PROMPT]
(RETURN (RESETLST (PROVIDE.PROMPTING.WINDOW "Password prompter")
(FRESHLINE T)
(PROG1 [RESETBUFS (COND
(CONNECTFLG (CONS DEFAULTNAME
(PROMPTFORWORD PROMPT NIL NIL T
(QUOTE *)
T TERMINATIONS)))
(T (PROG ((NAME (PROMPTFORWORD PROMPT DEFAULTNAME
HELPFN T NIL T
TERMINATIONS)))
[COND
((AND HOST DEFAULTREGISTRY
(SELECTQ OSTYPE
((NIL IFS)
T)
NIL)
(NOT (STRPOS "." NAME)))
(PRIN1 "." T)
(PRIN1 DEFAULTREGISTRY T)
(SETQ NAME (CONCAT NAME "."
DEFAULTREGISTRY]
(RETURN (CONS (MKATOM NAME)
(PROMPTFORWORD " (password) "
NIL NIL T
(QUOTE *]
(TERPRI T])
(PROVIDE.PROMPTING.WINDOW
[LAMBDA (TITLE REGION) (* bvm: "13-May-85 16:21")
(* * Called under RESETLST -- makes sure this process has a tty window; if it doesn't, makes a dramatic one which
will be closed on exit.)
[COND
((AND (NOT (TTY.PROCESSP))
(NOT \PROC.READY)) (* Called before world has woken up, so mouse is not
available. Use brute force)
(RESETSAVE (TTY.PROCESS (THIS.PROCESS]
(COND
([AND (WINDOWWORLD)
(OR (NOT (HASTTYWINDOWP))
(NOT (OPENWP (WFROMDS (TTYDISPLAYSTREAM)
T] (* Make a nice tty window and clean up afterwards)
(PROG ((W (CREATEW [OR REGION (PROGN (SETQ \TTYREGIONOFFSETSPTR (OR (CDR \TTYREGIONOFFSETSPTR)
TTYREGIONOFFSETS))
(SETQ REGION (CREATEREGION (IPLUS (CAAR
\TTYREGIONOFFSETSPTR)
(fetch (REGION LEFT)
of
UNSCHEDULEDPROMPTREGION))
(IPLUS (CDAR
\TTYREGIONOFFSETSPTR)
(fetch (REGION BOTTOM)
of
UNSCHEDULEDPROMPTREGION))
(fetch (REGION WIDTH)
of UNSCHEDULEDPROMPTREGION)
(fetch (REGION HEIGHT)
of UNSCHEDULEDPROMPTREGION]
(OR TITLE "Special input window")
12))
STR)
(RESETSAVE NIL (LIST (QUOTE CLOSEW)
W))
(RESETSAVE (TTYDISPLAYSTREAM W))
(RESETSAVE NIL (LIST (QUOTE WINDOWPROP)
W
(QUOTE CLOSEFN)
NIL))
[WINDOWPROP W (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW PROC)
(COND
((AND (SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)))
(PROCESSP PROC))
(PROCESS.APPLY PROC (FUNCTION ERROR!))
(QUOTE DON'T]
[COND
((NOT (TTY.PROCESSP))
(RELMOVETO (LRSH (IDIFFERENCE (fetch (REGION WIDTH) of REGION)
(STRINGWIDTH (SETQ STR "-> Click here, please <-")
W))
1)
0 W)
(printout T STR T T)
(SELECTQ (MACHINETYPE)
(DANDELION (RINGBELLS))
NIL)
(until (WAIT.FOR.TTY 30000) do (FLASHWINDOW W 1]
(RETURN W])
(\ADJUST.USERNAME
[LAMBDA (NAME OSTYPE) (* bvm: "17-May-85 19:03")
(COND
((AND NAME (NEQ (NCHARS NAME)
0)) (* Don't do this for blank name, as occurs after DLion
boot)
(SELECTQ OSTYPE
[(NIL IFS)
(COND
((AND DEFAULTREGISTRY (NOT (STRPOS "." NAME)))
(SETQ NAME (PACK* NAME "." DEFAULTREGISTRY]
(PROGN [LET (POS)
(COND
((AND DEFAULTREGISTRY (SETQ POS (STRPOS "." NAME)))
(* For folks who login at the alto exec using a
registry, get rid of it)
(SETQ NAME (SUBSTRING NAME 1 (SUB1 POS]
(SELECTQ OSTYPE
(UNIX (SETQ NAME (L-CASE NAME)))
[NS (COND
((AND CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION
(NOT (STRPOS (QUOTE :)
NAME)))
(SETQ NAME (CONCAT NAME (QUOTE :)
CH.DEFAULT.DOMAIN
(QUOTE :)
CH.DEFAULT.ORGANIZATION]
NIL)))
NAME])
(\ENCRYPT.PWD
[LAMBDA (STR) (* bvm: " 3-NOV-83 22:09")
(* * Destructively disguises the characters of STR so that passwords are not stored in clear text anywhere.
Decode with \DECRYPT.PWD, or macro \DECRYPT.PWD.CHAR)
(for I from 1 do (RPLCHARCODE STR I (LOGXOR (OR (NTHCHARCODE STR I)
(RETURN STR))
73])
(\DECRYPT.PWD
[LAMBDA (STR) (* bvm: " 3-NOV-83 22:09")
(* undoes \ENCRYPT.PWD. Easy, it being its own inverse)
(\ENCRYPT.PWD (CONCAT STR])
)
(RPAQ? LOGINPASSWORDS (HASHARRAY 8))
(RPAQ? \GETPASSWORD.LOCK (CREATE.MONITORLOCK "GetPassword"))
(RPAQ? DEFAULTREGISTRY )
(RPAQ? \AFTERLOGINFNS )
(RPAQ? \PROC.READY T)
(RPAQ? UNSCHEDULEDPROMPTREGION (QUOTE (262 466 500 100)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LOGINPASSWORDS USERNAME \GETPASSWORD.LOCK DEFAULTREGISTRY \AFTERLOGINFNS
UNSCHEDULEDPROMPTREGION \PROC.READY TTYREGIONOFFSETS \TTYREGIONOFFSETSPTR)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(PUTPROPS EMPASSWORDLOC DMACRO [LAMBDA NIL (* lmm "24-MAR-83 06:46")
(fetch (IFPAGE UserPswdAddr)
of \InterfacePage])
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DECRYPT.PWD.CHAR MACRO ((CHAR)
(LOGXOR CHAR 73)))
)
(* END EXPORTED DEFINITIONS)
)
(MOVD? (QUOTE NILL)
(QUOTE CLBUFS))
(* PROMPTFORWORD)
(DEFINEQ
(PROMPTFORWORD
[LAMBDA (PROMPT.STR CANDIDATE.STR GENERATE?LIST.FN ECHO.CHANNEL DONTECHOTYPEIN.FLG URGENCY.OPTION
TERMINCHARS.LST KEYBD.CHANNEL) (* bvm: " 4-Jan-85 14:51")
(DECLARE (SPECVARS TERMINCHARS.LST ECHO.CHANNEL DONTECHOTYPEIN.FLG))
[COND
((NOT (TERMTABLEP \PROMPTFORWORDTTBL)) (* Initializes the special readtable on the first time
through.)
(SETQ \PROMPTFORWORDTTBL (bind (TTBL ←(COPYTERMTABLE (QUOTE ORIG))) for CHAR from 0
to 31 do (SELCHARQ CHAR
((EOL ESCAPE SPACE LF TAB))
(ECHOCHAR CHAR (QUOTE INDICATE)
TTBL))
finally (PROGN (ECHOMODE NIL TTBL)
(CONTROL T TTBL)
(RETURN TTBL]
(RESETLST (RESETSAVE (SETTERMTABLE \PROMPTFORWORDTTBL))
(PROG ([CHARBUFFER (COND
(CANDIDATE.STR (DREVERSE (CHCON CANDIDATE.STR]
TTYD X0Y0 TIMELIMITEXPIRED? BELLBEENHEARD? CANDIDATATE.LENGTH CHAR BEGUNTYPING?
RUBBING? ?HELPMSGTRIEDP ?HELPMSGLIST TIMER)
(DECLARE (SPECVARS TTYD X0Y0 TIMELIMITEXPIRED? BELLBEENHEARD? CHARBUFFER RUBBING?)
)
[COND
[(EQMEMB (QUOTE TTY)
URGENCY.OPTION) (* If we're going to switch the TTY process, better do
it before looking for TTYDISPLAYSTREAM etc.)
[OR (TTY.PROCESSP)
(RESETSAVE (TTY.PROCESS (THIS.PROCESS]
(AND \PROMPTFORWORD.CURSOR (RESETSAVE (CURSOR \PROMPTFORWORD.CURSOR]
(T (OR (FIXP URGENCY.OPTION)
(SELECTQ URGENCY.OPTION
((NIL T)
T)
NIL)
(\ILLEGAL.ARG URGENCY.OPTION]
(SETQ ECHO.CHANNEL (\OUTSTREAMARG (OR ECHO.CHANNEL T)))
(* Normalize the echo channel.)
(SETQ TTYD (DISPLAYSTREAMP ECHO.CHANNEL))
[COND
((AND TTYD (NEQ ECHO.CHANNEL (TTYDISPLAYSTREAM)))
(RESETSAVE (TTYDISPLAYSTREAM ECHO.CHANNEL]
[COND
((AND DONTECHOTYPEIN.FLG (NEQ DONTECHOTYPEIN.FLG T))
(SETQ DONTECHOTYPEIN.FLG (COND
((EQ (NCHARS DONTECHOTYPEIN.FLG)
1)
(NTHCHARCODE DONTECHOTYPEIN.FLG 1))
(T T]
(COND
[(NULL TERMINCHARS.LST)
(SETQ TERMINCHARS.LST (CHARCODE (EOL ESCAPE SPACE LF TAB]
((CHARCODEP TERMINCHARS.LST)
(SETQ TERMINCHARS.LST (LIST TERMINCHARS.LST)))
([OR (NLISTP TERMINCHARS.LST)
(for C in TERMINCHARS.LST bind CONVERTIBLEP unless (CHARCODEP C)
do (COND
((AND (OR (LITATOM C)
(STRINGP C))
(EQ 1 (NCHARS C)))
(SETQ CONVERTIBLEP T))
(T (RETURN T)))
finally (COND
(CONVERTIBLEP (* List not all charcodes, but all are at least
charcode like)
(SETQ TERMINCHARS.LST
(MAPCAR TERMINCHARS.LST
(FUNCTION (LAMBDA (C)
(OR (FIXP C)
(CHCON1 C]
(\ILLEGAL.ARG TERMINCHARS.LST)))
[COND
(KEYBD.CHANNEL (SETQ KEYBD.CHANNEL (\INSTREAMARG KEYBD.CHANNEL]
[COND
(URGENCY.OPTION (SETQ TIMER (SETUPTIMER (OR (FIXP URGENCY.OPTION)
0)
NIL
(QUOTE SECONDS]
(* * Now ready to begin. Print the prompt, gather input)
PROMPTAGAIN
(COND
(PROMPT.STR (PRIN3 PROMPT.STR ECHO.CHANNEL)
(PRIN3 " " ECHO.CHANNEL)))
[COND
(TTYD (SETQ X0Y0 (create POSITION
XCOORD ←(DSPXPOSITION NIL TTYD)
YCOORD ←(DSPYPOSITION NIL TTYD]
(COND
(CHARBUFFER
(* If there is input, e.g. the candidate string, echo it. This is the one place calling \PROMPTFORWORDRETYPE that
doesn't want the line erased first.)
(\PROMPTFORWORDRETYPE)))
[until (OR (NULL (SETQ CHAR (\PROMPTFORWORDBIN KEYBD.CHANNEL TTYD URGENCY.OPTION
TIMER)))
(FMEMB CHAR TERMINCHARS.LST))
do (COND
((SELECTQ (GETSYNTAX CHAR \PROMPTFORWORDTTBL)
(CHARDELETE (COND
(CHARBUFFER (SETQ BEGUNTYPING? T)
(\PROMPTFORWORDBS))
(T (SETQ RUBBING?)))
NIL)
(LINEDELETE (COND
(CHARBUFFER (COND
((NEQ DONTECHOTYPEIN.FLG T)
(\PROMPTFORWORDERASE)))
(SETQ BEGUNTYPING? T)
(SETQ CHARBUFFER))
(T (SETQ RUBBING?)))
NIL)
(RETYPE (COND
(CHARBUFFER (COND
((NEQ DONTECHOTYPEIN.FLG T)
(\PROMPTFORWORDERASE)))
(\PROMPTFORWORDRETYPE))
(T (SETQ RUBBING?)))
NIL)
(WORDDELETE (COND
[CHARBUFFER (SETQ BEGUNTYPING? T)
(bind (SPACEP ←(SYNTAXP (CAR
CHARBUFFER)
(QUOTE
WORDSEPR)
\PROMPTFORWORDTTBL))
do (\PROMPTFORWORDBS)
(COND
((NULL CHARBUFFER)
(RETURN)))
(SETQ CHAR (CAR CHARBUFFER))
(COND
[(NOT SPACEP)
(COND
((SYNTAXP CHAR
(QUOTE WORDSEPR)
\PROMPTFORWORDTTBL)
(RETURN]
((NOT (SYNTAXP CHAR
(QUOTE
WORDSEPR)
\PROMPTFORWORDTTBL))
(SETQ SPACEP NIL]
(T (SETQ RUBBING?)))
NIL)
(CNTRLV (COND
((NOT DONTECHOTYPEIN.FLG)
(* Well, so echo the ↑V SO THAT THE LOSER CAN SEE THAT HE'S IN THE STATE OF WAITING FOR THE NEXT CHARACTER AFTER A
↑V)
(COND
((AND RUBBING? (NOT TTYD))
(BOUT ECHO.CHANNEL (CHARCODE \))
(SETQ RUBBING?)))
(PRIN3 (CHARACTER CHAR)
ECHO.CHANNEL)))
(COND
((NULL (SETQ CHAR (\PROMPTFORWORDBIN KEYBD.CHANNEL
TTYD
URGENCY.OPTION
TIMER T)))
(RETURN T)))
(COND
((AND TTYD (NOT DONTECHOTYPEIN.FLG)
(NULL (DSPRUBOUTCHAR TTYD CHAR)))
(* Well, we tried to erase the ↑V so that the typed-in
charcter could be echoed, but apparently the ↑V was
split between lines.)
(\PROMPTFORWORDERASE)
(\PROMPTFORWORDRETYPE)))
T)
(COND
((EQ CHAR (CHARCODE ?))
(FRESHLINE ECHO.CHANNEL)
[COND
((AND GENERATE?LIST.FN (NOT ?HELPMSGTRIEDP))
(SETQ ?HELPMSGLIST (OR (STRINGP GENERATE?LIST.FN)
(APPLY* GENERATE?LIST.FN
PROMPT.STR CANDIDATE.STR)
))
(SETQ ?HELPMSGTRIEDP T))
((NOT ?HELPMSGTRIEDP)
(SETQ ?HELPMSGLIST (QUOTE ??]
(COND
((LISTP ?HELPMSGLIST)
(PRIN3 (QUOTE {)
ECHO.CHANNEL)
(PRIN3 (CONSTANT (CHARACTER (CHARCODE SPACE)))
ECHO.CHANNEL)
[MAPC ?HELPMSGLIST
(FUNCTION (LAMBDA (X)
(PRIN1 X ECHO.CHANNEL)
(PRIN3 (CONSTANT (CHARACTER (CHARCODE SPACE)))
ECHO.CHANNEL]
(PRIN3 (QUOTE })
ECHO.CHANNEL))
(T (PRIN1 ?HELPMSGLIST ECHO.CHANNEL)
(* FOO we'd really like this FRESHLINE to be just a
MOVETO some initial position.)
))
(FRESHLINE ECHO.CHANNEL)
(GO PROMPTAGAIN))
(T T))) (* If the SELCHARQ does't select out any of its
"special" characters, then just fall through here)
(COND
((AND (NOT BEGUNTYPING?)
CHARBUFFER) (* This is the case of the CANDIDATE.STR having been
proffered, but the user starts typing something else.)
(COND
((NOT DONTECHOTYPEIN.FLG)
(* Don't need to do anything if type-in isn't being
echoed)
(\PROMPTFORWORDERASE)))
(SETQ CHARBUFFER)))
(push CHARBUFFER CHAR)
(SETQ BEGUNTYPING? T)
(COND
((NEQ DONTECHOTYPEIN.FLG T)
(* Well, so echo the typed-in character already!)
(COND
((AND RUBBING? (NOT TTYD))
(PRIN3 (QUOTE \)
ECHO.CHANNEL)
(SETQ RUBBING?)))
(BOUT ECHO.CHANNEL (OR DONTECHOTYPEIN.FLG CHAR]
[SETQ CHARBUFFER (COND
[TIMELIMITEXPIRED? (* Ha, we overflowed the time limit.)
(COND
(CANDIDATE.STR (CONCAT CANDIDATE.STR]
(CHARBUFFER (CONCATCODES (DREVERSE CHARBUFFER]
(\CARET.DOWN ECHO.CHANNEL)
[COND
((AND \DRIBBLE.OFD (EQ ECHO.CHANNEL \TERM.OFD))
(COND
(PROMPT.STR (PRIN1 PROMPT.STR \DRIBBLE.OFD)
(SPACES 1 \DRIBBLE.OFD)))
(COND
((AND CHARBUFFER (NULL DONTECHOTYPEIN.FLG))
(PRIN1 CHARBUFFER \DRIBBLE.OFD]
(RETURN CHARBUFFER])
(\PROMPTFORWORDBIN
(LAMBDA (INSTREAM DISPLAYECHOSTREAM URGENCY.OPTION TIMER)
(* JonL " 9-Nov-84 22:35")
(* Takes in one character from the KEYBD.CHANNEL)
(DECLARE (USEDFREE TERMINCHARS.LST TIMELIMITEXPIRED? BELLBEENHEARD?))
(PROG ((WAITINTERVAL.secs 15)
(TTYWAITLIMIT (if URGENCY.OPTION
then (if BELLBEENHEARD?
then 30000
else 0)))
(BROADURGENCY? (AND URGENCY.OPTION (NOT (FIXP URGENCY.OPTION))))
CHAR READABLE)
NEXTROUND
(if BROADURGENCY?
then (SETQ TIMER (SETUPTIMER WAITINTERVAL.secs TIMER (QUOTE SECONDS))))
LP (if (SETQ READABLE (OR INSTREAM (WAIT.FOR.TTY TTYWAITLIMIT)))
then (* Ready to read)
(if (SETQ CHAR (if (NULL INSTREAM)
then (\GETSYSBUF)
elseif (READP INSTREAM T)
then (BIN INSTREAM)
elseif (\EOFP INSTREAM)
then (CAR TERMINCHARS.LST)))
then (RETURN CHAR))
(if DISPLAYECHOSTREAM
then (* \TTYBACKGROUND so that a caret will flash)
(\TTYBACKGROUND)
else (BLOCK)))
(if (AND TIMER (TIMEREXPIRED? TIMER (QUOTE SECONDS)))
then (if (AND URGENCY.OPTION (NOT BROADURGENCY?))
then (SETQ TIMELIMITEXPIRED? T)
(RETURN))
else (SETQ TTYWAITLIMIT 30000)
(AND READABLE (GO LP)))
(if (NULL BELLBEENHEARD?)
then (SETQ BELLBEENHEARD? T)
(SELECTQ (MACHINETYPE)
(DANDELION (RINGBELLS))
NIL))
(FLASHWINDOW DISPLAYECHOSTREAM NIL 350)
(if (AND BROADURGENCY? (TTY.PROCESSP))
then (SETQ WAITINTERVAL.secs (IMIN (LLSH WAITINTERVAL.secs 1)
(TIMES 2 60))))
(* Double the wait interval time
(the time between "flashings") up to about 2 minutes,
so that it doesn't become obnoxious)
(GO NEXTROUND))))
(\PROMPTFORWORDERASE
(LAMBDA NIL (* JonL "29-Jul-84 21:45")
(DECLARE (USEDFREE TTYD X0Y0 ECHO.CHANNEL)) (* Called whenever the CHARBUFFER is being cleared out,
or when it is necessary to retype the whole series of
input characters)
(* If TTYD is non-null, then it is guaranteed to be a display stream. X0Y0 is a POSITION where the user started
typing in (or where the default CANDIDATE was started) Erase that portion of the screen.)
(if TTYD
then (PROG ((Y (DSPYPOSITION NIL TTYD))
(0X (fetch XCOORD of X0Y0))
(0Y (fetch YCOORD of X0Y0)))
(MOVETO 0X 0Y TTYD)
(DSPCLEOL TTYD 0X)
(if (NOT (IEQP 0Y Y))
then (* Foobar, how can you tell if the stupid window has
been scrolling?)
(DSPCLEOL TTYD (DSPLEFTMARGIN NIL TTYD)
(IDIFFERENCE Y (FONTDESCENT TTYD))
(IDIFFERENCE 0Y Y))))
else (TERPRI ECHO.CHANNEL))))
(\PROMPTFORWORDBS
[LAMBDA NIL (* bvm: " 4-Jan-85 14:51")
(DECLARE (USEDFREE TTYD DONTECHOTYPEIN.FLG RUBBING? ECHO.CHANNEL CHARBUFFER))
(PROG (C (CH (pop CHARBUFFER)))
[COND
((NEQ DONTECHOTYPEIN.FLG T)
(SETQ C (OR DONTECHOTYPEIN.FLG CH))
(COND
[TTYD (COND
((NULL (DSPRUBOUTCHAR TTYD C))
(\PROMPTFORWORDERASE)
(\PROMPTFORWORDRETYPE]
(T (COND
((NOT RUBBING?)
(PRIN3 (QUOTE \)
ECHO.CHANNEL)
(SETQ RUBBING? T)))
(BOUT ECHO.CHANNEL C]
(RETURN C])
(\PROMPTFORWORDRETYPE
(LAMBDA NIL (* JonL "29-Jul-84 21:52")
(DECLARE (USEDFREE DONTECHOTYPEIN.FLG ECHO.CHANNEL CHARBUFFER))
(* * Retypes input as seen so far. All callers except one have already done a \PROMPTFORWORDERASE so the
ECHO.CHANNEL will be positioned correctly.)
(if (NEQ DONTECHOTYPEIN.FLG T)
then (for CHAR in (REVERSE CHARBUFFER) do (BOUT ECHO.CHANNEL (OR DONTECHOTYPEIN.FLG CHAR))))))
)
(RPAQ? \PROMPTFORWORDTTBL NIL)
(RPAQ? \PROMPTFORWORD.CURSOR )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \PROMPTFORWORDTTBL \PROMPTFORWORD.CURSOR)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS PASSWORDS COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1435 15249 (LOGIN 1445 . 2109) (SETPASSWORD 2111 . 2429) (\INTERNAL/GETPASSWORD 2431 .
3611) (\INTERNAL/SETPASSWORD 3613 . 8953) (\LOGIN.READ 8955 . 10885) (PROVIDE.PROMPTING.WINDOW 10887
. 13378) (\ADJUST.USERNAME 13380 . 14563) (\ENCRYPT.PWD 14565 . 14979) (\DECRYPT.PWD 14981 . 15247))
(16120 30757 (PROMPTFORWORD 16130 . 26035) (\PROMPTFORWORDBIN 26037 . 28423) (\PROMPTFORWORDERASE
28425 . 29553) (\PROMPTFORWORDBS 29555 . 30239) (\PROMPTFORWORDRETYPE 30241 . 30755)))))
STOP