(FILECREATED "15-Apr-86 12:18:47" {DANTE}<NEWMAN>LISP>AUXMENU.;19
 6842   

      changes to:  (VARS AUXMENUCOMS DefaultMiddleButtonBackgroundMenuCommands)
		   (FNS BackgroundButtonFN CreateMiddleButtonBackgroundMenu Auxmenu.Other.Directory)

      previous date: "14-Apr-86 11:40:55" {DANTE}<NEWMAN>LISP>AUXMENU.;18)


(PRETTYCOMPRINT AUXMENUCOMS)

(RPAQQ AUXMENUCOMS
 [(* * This file sets up the Middle button background menu. It could very easily 
			 set up a Left button background menu also. The variable 
			 DefaultMiddleButtonBackgroundMenuCommands contains a set of default commands 
			 for the middle button background menu. The variable 
			 MiddleButtonBackgroundMenuCommands is the actual list of commands that is 
			 used to create the menu. The menu is contained in the global variable 
			 MiddleButtonBackgroundMenu. The function CreateMiddleButtonBackgroundMenu 
			 accepts a list of commands and returns a menu.)
		      (VARS DefaultMiddleButtonBackgroundMenuCommands)
		      (GLOBALVARS MiddleButtonBackgroundMenuCommands MiddleButtonBackgroundMenu)
		      (FNS BackgroundButtonFN CreateMiddleButtonBackgroundMenu 
			   Auxmenu.Other.Directory)
		      (INITVARS (MiddleButtonBackgroundMenuCommands 
							DefaultMiddleButtonBackgroundMenuCommands)
				(MiddleButtonBackgroundMenu NIL))
		      (P (SETQ BACKGROUNDBUTTONEVENTFN (QUOTE BackgroundButtonFN])
(* * This file sets up the Middle button background menu. It could very easily set up a Left 
button background menu also. The variable DefaultMiddleButtonBackgroundMenuCommands contains a 
set of default commands for the middle button background menu. The variable 
MiddleButtonBackgroundMenuCommands is the actual list of commands that is used to create the 
menu. The menu is contained in the global variable MiddleButtonBackgroundMenu. The function 
CreateMiddleButtonBackgroundMenu accepts a list of commands and returns a menu.)



(RPAQQ DefaultMiddleButtonBackgroundMenuCommands
 ((Greet (GREET)
							   " Do a (GREET)")
	(Login (LOGIN)
	       " Do a (LOGIN)")
	(Logout (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
			  [PROMPTPRINT (CONCAT " Logging out at " (MKSTRING (DATE]
			  (TERPRI PROMPTWINDOW)
			  (LOGOUT))
		" Do a (LOGOUT) "
		(SUBITEMS (Fast (LOGOUT T)
				" Do (LOGOUT T) ")
			  (Safe (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
					  [PROMPTPRINT (CONCAT " Logging out at " (MKSTRING (DATE]
					  (TERPRI PROMPTWINDOW)
					  (LOGOUT (QUOTE ?)))
				" Do (LOGOUT '?) ")))
	(Reclaim (RPT 5 (QUOTE (RECLAIM)))
		 " Perform a garbage collection. ")
	(Cleanup (CLEANUP)
		 " Do a (CLEANUP)")
	(Connect (DIRECTORYNAME T)
		 " Show the current connected directory. "
		 (SUBITEMS ({DSK} (/CNDIR (QUOTE {DSK}))
				  " Connect to the local DSK.")
			   (Default (/CNDIR LOGINHOST/DIR)
				    " Connect to LOGINHOST/DIR. ")
			   (Other (Auxmenu.Other.Directory)
				  " Prompt for the directory to connect to. ")))
	(Closeall (CLOSEALL)
		  " Close all open files.")
	(Open% Files (OPENP)
		     " List Open Files")
	(VMem% Size (VMEMSIZE)
		    " Find the current size of the Virtual Memory.")
	(Free% Pages (DISKFREEPAGES)
		     " List the number of free pages on the local file volume.")
	(Disk% Partition (DISKPARTITION)
			 " Display the name of the current partition.")
	(Volume% Display (DSKDISPLAY (QUOTE ON))
			 " Open the local disk descriptor window. ")
	(Default% Printers DEFAULTPRINTINGHOST " List the default printers. ")
	(File% Changes (FILEPKGCHANGES)
		       " List the changes made to the loaded files. ")
	(Loaded% Files FILELST " List the loaded files. ")
	(Lafite%(ON%) (LAFITE (QUOTE ON))
		      " Turn Lafite On ")))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS MiddleButtonBackgroundMenuCommands MiddleButtonBackgroundMenu)
)
(DEFINEQ

(BackgroundButtonFN

  [LAMBDA NIL                                                (* Marshall "14-Apr-86 11:40")


          (* * This function actually calls the middle-button background menu. It is the value of the variable 

	  BACKGROUNDBUTTONEVENTFN)



    (
RESETLST
 (
RESETSAVE
 (
TTYDISPLAYSTREAM
 PROMPTWINDOW))
		(
PROG
 (Result)
		        [
COND

			  ((
OR
 (
NOT
 (
BOUNDP
 (
QUOTE
 MiddleButtonBackgroundMenu)))
				 (
NULL
 MiddleButtonBackgroundMenu))
                                                             (* If the menu is NIL, reset it)

			    (
SETQ
 MiddleButtonBackgroundMenu (CreateMiddleButtonBackgroundMenu

				MiddleButtonBackgroundMenuCommands]
		        (
COND

			  ((
AND
 (MOUSESTATE MIDDLE)
				  (
SETQ
 Result (
MENU
 MiddleButtonBackgroundMenu)))
                                                             (* If there is a result, print it to the PROMPTWINDOW)

			    (
TERPRI
 PROMPTWINDOW)
			    (
PRIN1
 (
CONCAT
 " " Result)
				     PROMPTWINDOW)
			    (
TERPRI
 PROMPTWINDOW])

(CreateMiddleButtonBackgroundMenu

  [LAMBDA (CommandList)                                      (* edited: "28-Mar-85 15:34")


          (* * Create the middle-button background menu.)



    (create
 MENU
	      ITEMS _ CommandList
	      MENUCOLUMNS _ 1
	      CENTERFLG _ T
	      WHENSELECTEDFN _(
QUOTE
 DEFAULTWHENSELECTEDFN])

(Auxmenu.Other.Directory

  [LAMBDA NIL                                                (* edited: "28-Mar-85 15:42")


          (* * This function destructively modifies the MiddleButtonBackgroundMenuCommands variable to include the new 

	  directories typed in after "Other" is selected in the "Connect" submenu so that the user can connect to that 

	  directory via the menu later.)



    (
PROG
 ((Directory (
PROMPTFORWORD
 " Enter the name of the directory to connect to: " NIL NIL 
					 PROMPTWINDOW)))
	    [
RPLACD
 (
CDDR
 (
CADDDR
 (
ASSOC
 (
QUOTE
 Connect)
						 MiddleButtonBackgroundMenuCommands)))
		      (
CONS
 (
LIST
 (
MKATOM
 Directory)
				      (
LIST
 (
QUOTE
 /CNDIR)
					      Directory)
				      (
CONCAT
 " Connect to " (
MKSTRING
 Directory)))
			      (
COPY
 (
CDDDR
 (
CADDDR
 (
ASSOC
 (
QUOTE
 Connect)
								  MiddleButtonBackgroundMenuCommands]
                                                             (* Destructuve modification)

	    (
SETQ
 MiddleButtonBackgroundMenu (CreateMiddleButtonBackgroundMenu
 
							       MiddleButtonBackgroundMenuCommands))
                                                             (* reset menu variables)

	    (
RETURN
 (
/CNDIR
 Directory))                  (* connect to the directory)

	])
)

(RPAQ? MiddleButtonBackgroundMenuCommands
 DefaultMiddleButtonBackgroundMenuCommands)

(RPAQ? MiddleButtonBackgroundMenu
 NIL)
(SETQ BACKGROUNDBUTTONEVENTFN (QUOTE BackgroundButtonFN))
(PUTPROPS AUXMENU COPYRIGHT (NONE))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3785 6592 (BackgroundButtonFN 3795 . 4886) (CreateMiddleButtonBackgroundMenu 4888 . 
5235) (Auxmenu.Other.Directory 5237 . 6590)))))
STOP