(FILECREATED "28-Aug-85 16:40:28" {DSK}<LISPFILES>LEXDEMO.;2
 14379  

      changes to:  (VARS LEXDEMOCOMS)
		   (FNS LEXDEMO.MakeMainMenu)

      previous date: "28-Aug-85 15:31:33" {DSK}<LISPFILES>LEXDEMO.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LEXDEMOCOMS)

(RPAQQ LEXDEMOCOMS
 ((FNS LEXDEMO.MakeMainMenu LEXDEMO.TURNON SPECIALFUNCTIONKEYS LISTEN 
			 CHANGEDISPLAYSTATE CREPLACE DEALWITH DIALPHONENUMBER DISPLAYPAIRFROM 
			 GETCHARATTRIBUTE GETESCAPESEQUENCE PHONEPADMENU PRINT.INPUTBLOCK REVERSETEXT 
			 UNDERLINETEXT TALK LEXDEMO.SHUTOFF)
	[P (MOVEW (SETQ LEXDEMO.MainMenu (ADDMENU (LEXDEMO.MakeMainMenu NC.MainMenuWindow)))
		  (fetch LEFT of (GETWINDOWPROP NC.MainMenuWindow (QUOTE REGION)))
		  (DIFFERENCE (fetch BOTTOM of (GETWINDOWPROP NC.MainMenuWindow (QUOTE REGION)))
			      (fetch HEIGHT of (GETWINDOWPROP LEXDEMO.MainMenu (QUOTE REGION]
	(FILES RS232)))
(DEFINEQ

(LEXDEMO.MakeMainMenu

  [LAMBDA (
MAINWINDOW
)                                       (* Todd "28-Aug-85 16:26")

    (create
 MENU
	    ITEMS ←[
LIST
 (
LIST
 "ON" (
QUOTE
 (LEXDEMO.TURNON
)))
			 (
LIST
 "OFF" (
QUOTE
 (LEXDEMO.SHUTOFF
]
	    TITLE ← "Lexis Interface"
	    CENTERFLG ← T
	    MENUFONT ←(
FONTCREATE
 (
QUOTE
 HELVETICA)
				  12
				  (
QUOTE
 BRR))
	    MENUCOLUMNS ← 2
	    ITEMHEIGHT ← 25
	    ITEMWIDTH ←(
IQUOTIENT
 (
DIFFERENCE
 (fetch
 WIDTH of
 (
GETWINDOWPROP
 MAINWINDOW (
QUOTE
 REGION)
									     ))
					      2)
				  2)
	    MENUBORDERSIZE ← 1])

(LEXDEMO.TURNON

  [LAMBDA NIL                                                (* Todd "18-Jun-85 16:17")


          (* * LEXDEMO.TURNON initiates an RS232 interface to a LEXIS/NEXIS host machine. It creates a record of the 

	  transception, which is saved as {DSK}<LISPFILES>LEXIS-SESSION, and provides a shift-selection capability while the 

	  transception is in progress. --- John Todd)



    (
PROG
 ((LEXSTREAM (
OPENSTREAM
 (
QUOTE
 {CORE}LEXIS-SESSION)
				  (
QUOTE
 BOTH)))
	   (LEXWINDOW (
CREATEW
 (
GETBOXREGION
 600 400 NIL NIL NIL 
					     "Please specify area for LEXIS display window")
			       "LEXIS display window"))
	   (REPLYWINDOW (
CREATEW
 (
CREATEREGION
 0 0 600 80)
				 NIL 8))
	   FUNCTIONKEYS.MENU)
          (
ATTACHWINDOW
 REPLYWINDOW LEXWINDOW (
QUOTE
 BOTTOM)
			(
QUOTE
 LEFT))
          (
SETQ
 FUNCTIONKEYS.MENU (
ADDMENU
 (SPECIALFUNCTIONKEYS
 LEXWINDOW)))
          (
SETQ
 LEXDEMOWINDOWS (
LIST
 LEXWINDOW REPLYWINDOW FUNCTIONKEYS.MENU))
          (
ATTACHWINDOW
 FUNCTIONKEYS.MENU LEXWINDOW (
QUOTE
 RIGHT)
			(
QUOTE
 BOTTOM))
          (
SETQ
 RS232DLionTTYP NIL)
          (
RS232INIT
 1200 8 NIL 1)
          (
RS232CLEARBUFFER
 (
QUOTE
 BOTH))
          (DIALPHONENUMBER
)
          (
ADD.PROCESS
 (
LIST
 (
QUOTE
 LISTEN)
			     LEXSTREAM LEXWINDOW FUNCTIONKEYS.MENU))
          (
ADD.PROCESS
 (
LIST
 (
QUOTE
 TALK)
			     REPLYWINDOW])

(SPECIALFUNCTIONKEYS

  [LAMBDA (WINDOW)                                           (* Todd "17-Jun-85 10:45")

    (create
 MENU
	    ITEMS ←(
QUOTE
 (("NEXT PAGE" ".NP")
			    ("PREVIOUS PAGE" ".PP")
			    ("FIRST PAGE" ".FP")
			    ("NEXT DOCUMENT" ".ND")
			    ("PREVIOUS DOCUMENT" ".PD")
			    ("FIRST DOCUMENT" ".FD")
			    ("KWIC" ".KW")
			    ("FULL" ".FU")
			    ("CITE" ".CI")
			    ("SEGMTS" ".SE")
			    ("SELECT SERV" ".SS")
			    ("EXIT SERV" ".ES")
			    ("PRINT DOCUMENT" ".PR")
			    ("MAIL IT" ".MI")
			    ("SCREEN PRINT" ".SP")
			    ("NEW SEARCH" ".NS")
			    ("CHANGE FILE" ".CF")
			    ("CHANGE LIBRARY" ".CL")
			    ("SIGN OFF" ".SO")))
	    TITLE ← "SPECIAL KEY FUNCTIONS"
	    CENTERFLG ← T
	    MENUFONT ←(
FONTCREATE
 (
QUOTE
 HELVETICA)
				  10
				  (
QUOTE
 BOLD))
	    MENUCOLUMNS ← 2
	    MENUBORDERSIZE ← 1
	    WHENSELECTEDFN ←(
FUNCTION
 (LAMBDA (ITEM MENUNAME MOUSEKEY)
		(
RS232WRITECHARS
 (
CONCAT
 (
CADR
 ITEM)
					 (
CHARACTER
 13))
				 T])

(LISTEN

  [LAMBDA (LEXSTREAM LEXWINDOW FUNCTIONKEYS.MENU)            (* Todd "19-Jun-85 09:32")


          (* * comment)



    (
PROG
 ((WAITTIME 1500)
	   INCHAR)
          (
PUTWINDOWPROP
 LEXWINDOW (
QUOTE
 CHARDISPLAYBEGIN)
			 0)
          (
PUTWINDOWPROP
 LEXWINDOW (
QUOTE
 CHARDISPLAYSTATE)
			 (
QUOTE
 NORMAL))
          (
PUTWINDOWPROP
 LEXWINDOW (
QUOTE
 PAGEBEGIN)
			 0)
          (
PUTWINDOWPROP
 LEXWINDOW (
QUOTE
 REVLIST)
			 (
TCONC
 NIL 1))
          (
PUTWINDOWPROP
 LEXWINDOW (
QUOTE
 UNDLIST)
			 (
TCONC
 NIL 1))
          (do
 (
COND

		((
SETQ
 INCHAR (
RS232READBYTE
 WAITTIME))
		  (DEALWITH
 INCHAR))
		(T (PRINT.INPUTBLOCK
 LEXSTREAM LEXWINDOW])

(CHANGEDISPLAYSTATE

  [LAMBDA (DISPLAYWINDOW NEWSTATE)                           (* Todd "17-Jun-85 09:53")

    (
PROG
 [(CHARDISPLAYSTATE (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 CHARDISPLAYSTATE)))
	   (CHARDISPLAYBEGIN (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 CHARDISPLAYBEGIN]
          [
COND

	    ((
EQUAL
 CHARDISPLAYSTATE NEWSTATE)
	      NIL)
	    ((
EQUAL
 NEWSTATE (
QUOTE
 NORMAL))
	      [
COND

		((
EQUAL
 CHARDISPLAYSTATE (
QUOTE
 REVERSE))
		  (
TCONC
 (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 REVLIST))
			 (DISPLAYPAIRFROM
 CHARDISPLAYBEGIN)))
		(T (
TCONC
 (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 UNDLIST))
			  (DISPLAYPAIRFROM
 CHARDISPLAYBEGIN]
	      (
WINDOWPROP
 DISPLAYWINDOW (
QUOTE
 CHARDISPLAYBEGIN)
			  (
GETFILEPTR
 LEXSTREAM)))
	    ((
EQUAL
 NEWSTATE (
QUOTE
 UNDERLINE))
	      [
COND

		((
EQUAL
 CHARDISPLAYSTATE (
QUOTE
 REVERSE))
		  (
TCONC
 (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 REVLIST))
			 (DISPLAYPAIRFROM
 CHARDISPLAYBEGIN]
	      (
WINDOWPROP
 DISPLAYWINDOW (
QUOTE
 CHARDISPLAYBEGIN)
			  (
GETFILEPTR
 LEXSTREAM)))
	    (T [
COND

		 ((
EQUAL
 CHARDISPLAYSTATE (
QUOTE
 UNDERLINE))
		   (
TCONC
 (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 UNDLIST))
			  (DISPLAYPAIRFROM
 CHARDISPLAYBEGIN]
	       (
WINDOWPROP
 DISPLAYWINDOW (
QUOTE
 CHARDISPLAYBEGIN)
			   (
GETFILEPTR
 LEXSTREAM]
          (
RETURN
 NEWSTATE])

(CREPLACE

  [LAMBDA (INCHAR)                                           (* Todd "13-Jun-85 16:42")

    (
SELECTQ
 INCHAR
	     (0 32)
	     (10 32)
	     (127 32)
	     (NIL 32)
	     (
LOGAND
 127 INCHAR])

(DEALWITH

  [LAMBDA (INCHAR)                                           (* Todd "14-Jun-85 14:14")


          (* * Looking for acceptable control characters.)



    (
SELECTQ
 (CREPLACE
 INCHAR)
	     (7 (
RINGBELLS
))
	     (27 (GETESCAPESEQUENCE
 LEXWINDOW (
RS232READBYTE
 T)))
	     (
BOUT
 LEXSTREAM (CREPLACE
 INCHAR])

(DIALPHONENUMBER

  [LAMBDA NIL                                                (* Todd "18-Jun-85 16:15")


          (* * comment)



    (
PROG
 [(KEYPADMENU (
ADDMENU
 (PHONEPADMENU
]
          (
PROMPTPRINT
 "Please dial desired telephone number.")
          (
PUTWINDOWPROP
 KEYPADMENU (
QUOTE
 PROCESS)
			 (
THIS.PROCESS
))
          (
PUTWINDOWPROP
 KEYPADMENU (
QUOTE
 BUFFER)
			 NIL)
          (
RS232WRITECHARS
 (
CONCAT
 "ATDT " (
BLOCK
 T)
				   (
CHARACTER
 13))
			   T])

(DISPLAYPAIRFROM

  [LAMBDA (DISPLAYBEGIN)                                     (* Todd "14-Jun-85 14:14")


          (* * comment)



    (
CONS
 (
DIFFERENCE
 (
ADD1
 DISPLAYBEGIN)
		      (
GETWINDOWPROP
 LEXWINDOW (
QUOTE
 PAGEBEGIN)))
	  (
DIFFERENCE
 (
GETFILEPTR
 LEXSTREAM)
		      DISPLAYBEGIN])

(GETCHARATTRIBUTE

  [LAMBDA (LEXWINDOW INCHAR)                                 (* Todd "14-Jun-85 16:40")


          (* * Control character indicates a change of display mode. What to change it to?)



    (
SELECTQ
 (CREPLACE
 INCHAR)
	     (48 (
WINDOWPROP
 LEXWINDOW (
QUOTE
 CHARDISPLAYSTATE)
			     (CHANGEDISPLAYSTATE
 LEXWINDOW (
QUOTE
 NORMAL)))
		 (GETCHARATTRIBUTE
 LEXWINDOW (
RS232READBYTE
 T)))
	     (50 (CREPLACE
 (
RS232READBYTE
 T)))
	     (52 (
WINDOWPROP
 LEXWINDOW (
QUOTE
 CHARDISPLAYSTATE)
			     (CHANGEDISPLAYSTATE
 LEXWINDOW (
QUOTE
 UNDERLINE)))
		 (GETCHARATTRIBUTE
 LEXWINDOW (
RS232READBYTE
 T)))
	     (55 (
WINDOWPROP
 LEXWINDOW (
QUOTE
 CHARDISPLAYSTATE)
			     (CHANGEDISPLAYSTATE
 LEXWINDOW (
QUOTE
 REVERSE)))
		 (GETCHARATTRIBUTE
 LEXWINDOW (
RS232READBYTE
 T)))
	     NIL])

(GETESCAPESEQUENCE

  [LAMBDA (LEXWINDOW NEXTCHAR)                               (* Todd "17-Jun-85 09:24")


          (* * Found conrol character. What does it mean?)



    (
SELECTQ
 (CREPLACE
 NEXTCHAR)
	     (61 NIL)
	     (91 (GETCHARATTRIBUTE
 LEXWINDOW (
RS232READBYTE
 T)))
	     NIL])

(PHONEPADMENU

  [LAMBDA NIL                                                (* Todd "18-Jun-85 16:25")

    (create
 MENU
	    ITEMS ←(
QUOTE
 (1 2 3 4 5 6 7 8 9 * 0 # "," "Done" "Redial"))
	    TITLE ← "Phone keypad"
	    CENTERFLG ← T
	    MENUCOLUMNS ← 3
	    MENUFONT ←(
FONTCREATE
 (
QUOTE
 HELVETICA)
				  12
				  (
QUOTE
 BRR))
	    ITEMHEIGHT ← 30
	    ITEMWIDTH ← 45
	    MENUBORDERSIZE ← 1
	    WHENSELECTEDFN ←(
FUNCTION
 (LAMBDA (ITEM MENU BUTTON)
		(
COND

		  ((
EQUAL
 ITEM "Done")
		    (
WAKE.PROCESS
 (
GETWINDOWPROP
 (
WHICHW
)
						 (
QUOTE
 PROCESS))
				  (
GETWINDOWPROP
 (
WHICHW
)
						 (
QUOTE
 BUFFER)))
		    (
CLOSEW
 (
WHICHW
))
		    (
CLEARW
 PROMPTWINDOW))
		  ((
EQUAL
 ITEM "Redial")
		    (
WINDOWPROP
 (
WHICHW
)
				(
QUOTE
 BUFFER)
				NIL)
		    (
PROMPTPRINT
 "Please dial desired telephone number."))
		  (T (
PRIN1
 ITEM PROMPTWINDOW)
		     (
WINDOWPROP
 (
WHICHW
)
				 (
QUOTE
 BUFFER)
				 (
COND

				   ((
NULL
 (
GETWINDOWPROP
 (
WHICHW
)
							 (
QUOTE
 BUFFER)))
				     (
MKSTRING
 ITEM))
				   (T (
CONCAT
 (
GETWINDOWPROP
 (
WHICHW
)
							     (
QUOTE
 BUFFER))
					      ITEM])

(PRINT.INPUTBLOCK

  [LAMBDA (LEXSTREAM LEXWINDOW)                              (* Todd "19-Jun-85 13:48")


          (* * The host machine has stopped transmitting for WAITTIME. Respond by displaying the host machine's output.)



    (
PROG
 ((LEXSTREAM.CURCHAR (
GETFILEPTR
 LEXSTREAM)))
          (
COND

	    [(
LEQ
 LEXSTREAM.CURCHAR (
GETWINDOWPROP
 LEXWINDOW (
QUOTE
 PAGEBEGIN)))
	      (
SETFILEPTR
 LEXSTREAM (
GETWINDOWPROP
 LEXWINDOW (
QUOTE
 PAGEBEGIN]
	    (T (
OPENTEXTSTREAM
 LEXSTREAM LEXWINDOW (
GETWINDOWPROP
 LEXWINDOW (
QUOTE
 PAGEBEGIN))
			       LEXSTREAM.CURCHAR
			       (
QUOTE
 (READONLY T)))
	       (
WINDOWPROP
 LEXWINDOW (
QUOTE
 REVLIST)
			   (REVERSETEXT
 LEXWINDOW))
	       (
WINDOWPROP
 LEXWINDOW (
QUOTE
 UNDLIST)
			   (UNDERLINETEXT
 LEXWINDOW))
	       (
TEDIT.SHOWSEL
 (
TEXTSTREAM
 LEXWINDOW)
			      NIL)
	       (
PUTWINDOWPROP
 LEXWINDOW (
QUOTE
 PAGEBEGIN)
			      LEXSTREAM.CURCHAR)
	       (
SETFILEPTR
 LEXSTREAM LEXSTREAM.CURCHAR])

(REVERSETEXT

  [LAMBDA (DISPLAYWINDOW)                                    (* Todd "14-Jun-85 16:21")


          (* * An input block has been read. Given the positions and lengths of reverse-videod sections in REVLIST, display 

	  the text block.)



    (
PROG
 ((REVLIST (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 REVLIST)))
	   SELECTION)
          [for
 X in
 (
NTH
 (
CAR
 REVLIST)
			 2)
	     do
 (
SETQ
 SELECTION (
TEDIT.SETSEL
 (
TEXTSTREAM
 DISPLAYWINDOW)
					      (
CAR
 X)
					      (
CDR
 X)
					      (
QUOTE
 LEFT)))
		(
TEDIT.LOOKS
 (
TEXTSTREAM
 DISPLAYWINDOW)
			     (
QUOTE
 (FACE BRR]
          (
RETURN
 (
TCONC
 NIL 1])

(UNDERLINETEXT

  [LAMBDA (DISPLAYWINDOW)                                    (* Todd "14-Jun-85 16:25")


          (* * An input block has been read. Given the positions and lengths of underlined sections in UNDLIST, display the 

	  text block.)



    (
PROG
 ((UNDLIST (
GETWINDOWPROP
 DISPLAYWINDOW (
QUOTE
 UNDLIST)))
	   SELECTION)
          [for
 X in
 (
NTH
 (
CAR
 UNDLIST)
			 2)
	     do
 (
SETQ
 SELECTION (
TEDIT.SETSEL
 (
TEXTSTREAM
 DISPLAYWINDOW)
					      (
CAR
 X)
					      (
CDR
 X)
					      (
QUOTE
 LEFT)))
		(
TEDIT.LOOKS
 (
TEXTSTREAM
 DISPLAYWINDOW)
			     (
QUOTE
 (UNDERLINE ON]
          (
RETURN
 (
TCONC
 NIL 1])

(TALK

  [LAMBDA (REPLYWINDOW)                                      (* Todd "19-Jun-85 08:29")


          (* * comment)



    (
TTY.PROCESS
 (
THIS.PROCESS
))
    (while
 T
       do
 (
RS232WRITECHARS
 (
CONCAT
 (
COND

				     ((
PROMPTFORWORD
 ">" NIL NIL REPLYWINDOW NIL NIL
						     (
LIST
 9 10 13 27)))
				     (T ""))
				   (
CHARACTER
 13))
			   T)
	  (
TERPRI
 REPLYWINDOW])

(LEXDEMO.SHUTOFF

  [LAMBDA NIL                                                (* Todd "18-Jun-85 16:54")


          (* * comment)



    (
DEL.PROCESS
 (
QUOTE
 TALK))
    (
DEL.PROCESS
 (
QUOTE
 LISTEN))
    [
COND

      ((
BOUNDP
 (
QUOTE
 LEXDEMOWINDOWS))
	(for
 WINDOW in
 LEXDEMOWINDOWS do
 (
CLOSEW
 WINDOW]
    (
CLEARW
 PROMPTWINDOW)
    (
PRIN1
 (
CONCAT
 "Closing LEXIS connection ... " (
CHARACTER
 13))
	   PROMPTWINDOW)
    [
COND

      ((
OPENP
 (
QUOTE
 {CORE}LEXIS-SESSION))
	(
CLOSEF
 (
QUOTE
 {CORE}LEXIS-SESSION))
	(
PRIN1
 (
CONCAT
 "A record of your LEXIS session is stored as " (
COPYFILE
 (
QUOTE
 
									      {CORE}LEXIS-SESSION)
										(
QUOTE
 
								    {DSK}<LISPFILES>LEXIS-SESSION))
		       (
CHARACTER
 13))
	       PROMPTWINDOW)
	(
DELFILE
 (
QUOTE
 {CORE}LEXIS-SESSION]
    (
PRIN1
 "... connection closed." PROMPTWINDOW)
    (
TERPRI
 PROMPTWINDOW])
)
[MOVEW (SETQ LEXDEMO.MainMenu (ADDMENU (LEXDEMO.MakeMainMenu NC.MainMenuWindow)))
       (fetch LEFT of (GETWINDOWPROP NC.MainMenuWindow (QUOTE REGION)))
       (DIFFERENCE (fetch BOTTOM of (GETWINDOWPROP NC.MainMenuWindow (QUOTE REGION)))
		   (fetch HEIGHT of (GETWINDOWPROP LEXDEMO.MainMenu (QUOTE REGION]
(FILESLOAD RS232)
(PUTPROPS LEXDEMO COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (933 13974 (LEXDEMO.MakeMainMenu 943 . 1572) (LEXDEMO.TURNON 1574 . 3043) (
SPECIALFUNCTIONKEYS 3045 . 4074) (LISTEN 4076 . 4806) (CHANGEDISPLAYSTATE 4808 . 6273) (CREPLACE 6275
 . 6492) (DEALWITH 6494 . 6846) (DIALPHONENUMBER 6848 . 7372) (DISPLAYPAIRFROM 7374 . 7701) (
GETCHARATTRIBUTE 7703 . 8579) (GETESCAPESEQUENCE 8581 . 8895) (PHONEPADMENU 8897 . 10121) (
PRINT.INPUTBLOCK 10123 . 11170) (REVERSETEXT 11172 . 11871) (UNDERLINETEXT 11873 . 12574) (TALK 12576
 . 13001) (LEXDEMO.SHUTOFF 13003 . 13972)))))
STOP