(FILECREATED "12-Nov-85 19:12:25" {ERIS}<LISPCORE>LIBRARY>RS232CMENU.;10 11980
changes to: (FNS RS232CMENU.SET.PARAMETERS)
previous date: " 8-Sep-85 18:46:00" {ERIS}<LISPCORE>LIBRARY>RS232CMENU.;9)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RS232CMENUCOMS)
(RPAQQ RS232CMENUCOMS ((COMS (* Interactive menu facility for RS232 control)
(FNS RS232C.FMENU.ABORT RS232C.FMENU.APPLY RS232C.FMENU.HANGUP
RS232C.FMENU.SENDBREAK RS232C.FMENU.SENDLONGBREAK
RS232CMENU.FILLIN.PARAMETERS RS232CMENU.SET.PARAMETERS)
(VARS RS232C.FMENU.SPEC TTY.FMENU.SPEC)
(GLOBALVARS RS232C.FMENU.SPEC TTY.FMENU.SPEC)
(DECLARE: DONTCOPY (FILES (LOADCOMP FROM VALUEOF LISPUSERSDIRECTORIES)
CHATDECLS))
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DLRS232C RS232CHAT FREEMENU))))
(* Interactive menu facility for RS232 control)
(DEFINEQ
(RS232C.FMENU.ABORT
(LAMBDA (ITEM WINDOW BUTTON) (* ejs: " 5-Sep-85 14:06")
(REMOVEWINDOW WINDOW)
(CLOSEW WINDOW)))
(RS232C.FMENU.APPLY
(LAMBDA (IGNORE WINDOW BUTTON) (* ejs: " 8-Sep-85 18:43")
(* * Collect up the selected parameters and call RS232C to change the state of the RS232 device)
(LET* ((DEVICENAME (WINDOWPROP WINDOW (QUOTE CHATDEVICE)))
(SETFN (SELECTQ DEVICENAME
(TTY (FUNCTION TTY.SET.PARAMETERS))
(RS232 (FUNCTION RS232C.SET.PARAMETERS))
(FUNCTION NILL))))
(APPLY* SETFN (bind ITEM VALUE for ID in (QUOTE (BaudRate Parity CharLength FlowControl
StopBits))
collect (SETQ ITEM (FM.ITEMFROMID WINDOW ID))
(SETQ VALUE (FM.ITEMPROP ITEM (QUOTE STATE)))
(SELECTQ ID
(BaudRate (CONS (QUOTE LINE.SPEED)
VALUE))
(Parity (CONS (QUOTE PARITY)
(U-CASE VALUE)))
(CharLength (CONS (QUOTE CHAR.LENGTH)
(SELECTQ VALUE
(Five 5)
(Six 6)
(Seven 7)
(Eight 8)
(ERROR
"Impossible character length"
VALUE))))
(FlowControl (CONS (QUOTE FLOW.CONTROL)
(SELECTQ VALUE
(XOnXOff (QUOTE XOnXOff))
(None NIL)
(ERROR
"Impossible flow control"
VALUE))))
(StopBits (CONS (QUOTE STOP.BITS)
(SELECTQ VALUE
(One 1)
(Two 2)
(ERROR "Impossible stop bits"
VALUE))))
NIL)))
(COND
((EQ DEVICENAME (QUOTE RS232))
(RS232C.REPORT.STATUS (SELECTQ (FM.ITEMPROP (FM.ITEMFROMID WINDOW (QUOTE Report))
(QUOTE STATE))
(Always T)
(Never NIL)
(Output% Only (QUOTE OUTPUT))
(Input% Only (QUOTE INPUT))
(ERROR "Impossible reporting status requested"
(FM.ITEMPROP (FM.ITEMFROMID WINDOW (QUOTE Report))
(QUOTE STATE)))))))
(printout (GETPROMPTWINDOW (MAINWINDOW WINDOW))
T
(SELECTQ DEVICENAME
(RS232 "Set RS232 port parameters")
(TTY "Set TTY port parameters")
"Set somebody's parameters!")))))
(RS232C.FMENU.HANGUP
(LAMBDA (ITEM WINDOW BUTTON) (* ejs: " 5-Sep-85 14:06")
(COND
((MOUSECONFIRM "This will break your connection; please confirm"
"Select the left mouse button to confirm"
(GETPROMPTWINDOW (MAINWINDOW WINDOW)))
(RS232MODEMHANGUP)))))
(RS232C.FMENU.SENDBREAK
(LAMBDA (ITEM WINDOW BUTTON) (* ejs: " 5-Sep-85 14:07")
(COND
((MOUSECONFIRM "This may break your connection; please confirm"
"Select the left mouse button to confirm"
(GETPROMPTWINDOW (MAINWINDOW WINDOW)))
(RS232SENDBREAK)))))
(RS232C.FMENU.SENDLONGBREAK
(LAMBDA (ITEM WINDOW BUTTON) (* ejs: " 5-Sep-85 14:07")
(COND
((MOUSECONFIRM "This may break your connection; please confirm"
"Select the left mouse button to confirm"
(GETPROMPTWINDOW (MAINWINDOW WINDOW)))
(RS232SENDBREAK T)))))
(RS232CMENU.FILLIN.PARAMETERS
(LAMBDA (WINDOW DEVICENAME) (* ejs: " 8-Sep-85 18:42")
(LET ((INFOFN (SELECTQ DEVICENAME
(TTY (FUNCTION TTY.GET.PARAMETERS))
(RS232 (FUNCTION RS232C.GET.PARAMETERS))
(FUNCTION NILL))))
(WINDOWPROP WINDOW (QUOTE CHATDEVICE)
DEVICENAME)
(bind ITEM for PROP.VAL in (APPLY* INFOFN (QUOTE (LINE.SPEED PARITY CHAR.LENGTH FLOW.CONTROL
STOP.BITS)))
as ID in (QUOTE (BaudRate Parity CharLength FlowControl StopBits))
do (SETQ ITEM (FM.ITEMFROMID WINDOW ID))
(FM.CHANGESTATE ITEM WINDOW (SELECTQ ID
(BaudRate (CDR PROP.VAL))
(Parity (SELECTQ (CDR PROP.VAL)
(EVEN (QUOTE Even))
(ODD (QUOTE Odd))
(NONE (QUOTE None))
(ERROR
"Impossible parity setting"
(CDR PROP.VAL))))
(CharLength (SELECTQ (CDR PROP.VAL)
(5 (QUOTE Five))
(6 (QUOTE Six))
(7 (QUOTE Seven))
(8 (QUOTE Eight))
(ERROR
"Impossible character length"
(CDR PROP.VAL))))
(FlowControl (COND
((LISTP (CDR PROP.VAL))
(SELECTQ (CADR PROP.VAL)
(0 (QUOTE None))
(1 (QUOTE XOnXOff))
(ERROR
"Unknown flow control setting"
(CDR PROP.VAL))))
((EQ (CDR PROP.VAL)
(QUOTE XOnXOff))
(QUOTE XOnXOff))
(T (QUOTE None))))
(StopBits (SELECTQ (CDR PROP.VAL)
(1 (QUOTE One))
(2 (QUOTE Two))
(ERROR
"Unknown stopbits setting"
(CDR PROP.VAL))))
NIL)))
(COND
((EQ DEVICENAME (QUOTE RS232))
(FM.CHANGESTATE (FM.ITEMFROMID WINDOW (QUOTE Report))
WINDOW
(SELECTQ (RS232C.REPORT.STATUS)
(T (QUOTE Always))
(OUTPUT (QUOTE Output% Only))
(INPUT (QUOTE Input% Only))
(NIL (QUOTE Never))
(ERROR "Impossible status reporting option" (
RS232C.REPORT.STATUS)))))))))
(RS232CMENU.SET.PARAMETERS
(LAMBDA (MAINWINDOW) (* ejs: "12-Nov-85 19:04")
(LET* ((CHATSTATE (WINDOWPROP MAINWINDOW (QUOTE CHATSTATE)))
(STREAM (fetch (CHAT.STATE INSTREAM) of CHATSTATE))
(DEVICENAME (fetch (FDEV DEVICENAME) of (fetch (STREAM DEVICE) of STREAM)))
(FMSPEC (SELECTQ DEVICENAME
(TTY TTY.FMENU.SPEC)
(RS232 RS232C.FMENU.SPEC)
(ERROR "unknown device" DEVICENAME)))
(FMENU (FM.FORMATMENU FMSPEC)))
(GETPROMPTWINDOW MAINWINDOW 1)
(WINDOWPROP FMENU (QUOTE MINSIZE)
(create POSITION
XCOORD ←(fetch (REGION WIDTH) of (WINDOWPROP FMENU
(QUOTE REGION))
)
YCOORD ←(fetch (REGION HEIGHT) of (WINDOWPROP FMENU
(QUOTE REGION)
))))
(WINDOWPROP FMENU (QUOTE MAXSIZE)
(create POSITION
XCOORD ← NIL
YCOORD ←(fetch (REGION HEIGHT) of (WINDOWPROP FMENU
(QUOTE REGION)
))))
(ATTACHWINDOW FMENU MAINWINDOW (QUOTE TOP)
(QUOTE JUSTIFY))
(RS232CMENU.FILLIN.PARAMETERS FMENU DEVICENAME))))
)
(RPAQQ RS232C.FMENU.SPEC (((TYPE MOMENTARY LABEL "Apply!" FONT (MODERN 10 BOLD)
MESSAGE "Makes the changes you've selected" SELECTEDFN
RS232C.FMENU.APPLY)
(TYPE MOMENTARY LABEL "Abort!" FONT (MODERN 10 BOLD)
MESSAGE "Closes this menu" SELECTEDFN RS232C.FMENU.ABORT)
(TYPE MOMENTARY LABEL "SendBreak!" FONT (MODERN 10 BOLD)
MESSAGE "Sends a short break" SELECTEDFN RS232C.FMENU.SENDBREAK)
(TYPE MOMENTARY LABEL "SendLongBreak!" FONT (MODERN 10 BOLD)
MESSAGE "Sends a long break" SELECTEDFN RS232C.FMENU.SENDLONGBREAK)
(TYPE MOMENTARY LABEL "Hangup!" FONT (MODERN 10 BOLD)
MESSAGE "Tries to hangup a modem connection" SELECTEDFN RS232C.FMENU.HANGUP))
((TYPE NCHOOSE LABEL "Baud Rate:" ID BaudRate FONT (MODERN 10 BOLD)
ITEMS
(50 75 110 134.5 150 300 600 1200 2400 3600 4800 7200 9600 19200 28880 38400 48000
56000 57600)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available baud rates")
(TYPE NCHOOSE LABEL "Parity:" ID Parity FONT (MODERN 10 BOLD)
ITEMS
(None Even Odd)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Parity Settings")
(TYPE NCHOOSE LABEL "Character Length:" ID CharLength FONT (MODERN 10 BOLD)
ITEMS
(Five Six Seven Eight)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Character Lengths"))
((TYPE NCHOOSE LABEL "Flow Control:" ID FlowControl FONT (MODERN 10 BOLD)
ITEMS
(XOnXOff None)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Flowcontrol Settings")
(TYPE NCHOOSE LABEL "Stop Bits:" ID StopBits FONT (MODERN 10 BOLD)
ITEMS
(One Two)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Stop Bits Settings")
(TYPE NCHOOSE LABEL "Report Errors:" ID Report FONT (MODERN 10 BOLD)
ITEMS
(Always Output% Only Input% Only Never)
ITEMFONT
(MODERN 10)
ITEMTITLE "Report Errors"))
(WINDOWPROPS TITLE "RS232 Port Settings")))
(RPAQQ TTY.FMENU.SPEC (((TYPE MOMENTARY LABEL "Apply!" FONT (MODERN 10 BOLD)
MESSAGE "Makes the changes you've selected" SELECTEDFN
RS232C.FMENU.APPLY)
(TYPE MOMENTARY LABEL "Abort!" FONT (MODERN 10 BOLD)
MESSAGE "Closes this menu" SELECTEDFN RS232C.FMENU.ABORT))
((TYPE NCHOOSE LABEL "Baud Rate:" ID BaudRate FONT (MODERN 10 BOLD)
ITEMS
(50 75 110 134.5 150 300 600 1200 1800 2000 2400 3600 4800 7200 9600 19200)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available baud rates")
(TYPE NCHOOSE LABEL "Parity:" ID Parity FONT (MODERN 10 BOLD)
ITEMS
(None Even Odd)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Parity Settings")
(TYPE NCHOOSE LABEL "Character Length:" ID CharLength FONT (MODERN 10 BOLD)
ITEMS
(Five Six Seven Eight)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Character Lengths"))
((TYPE NCHOOSE LABEL "Flow Control:" ID FlowControl FONT (MODERN 10 BOLD)
ITEMS
(XOnXOff None)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Flowcontrol Settings")
(TYPE NCHOOSE LABEL "Stop Bits:" ID StopBits FONT (MODERN 10 BOLD)
ITEMS
(One Two)
ITEMFONT
(MODERN 10)
ITEMTITLE "Available Stop Bits Settings"))
(WINDOWPROPS TITLE "TTY Port Settings")))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS RS232C.FMENU.SPEC TTY.FMENU.SPEC)
)
(DECLARE: DONTCOPY
(FILESLOAD (LOADCOMP FROM VALUEOF LISPUSERSDIRECTORIES)
CHATDECLS)
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DLRS232C RS232CHAT FREEMENU)
(PUTPROPS RS232CMENU COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (967 8255 (RS232C.FMENU.ABORT 977 . 1148) (RS232C.FMENU.APPLY 1150 . 3498) (
RS232C.FMENU.HANGUP 3500 . 3837) (RS232C.FMENU.SENDBREAK 3839 . 4176) (RS232C.FMENU.SENDLONGBREAK 4178
. 4521) (RS232CMENU.FILLIN.PARAMETERS 4523 . 6967) (RS232CMENU.SET.PARAMETERS 6969 . 8253)))))
STOP