(FILECREATED " 3-Apr-86 10:04:23" {DANTE}<NEWMAN>LISP>AUXMENU.;17 6620
changes to: (VARS AUXMENUCOMS DefaultMiddleButtonBackgroundMenuCommands)
(FNS BackgroundButtonFN CreateMiddleButtonBackgroundMenu Auxmenu.Other.Directory)
previous date: "28-Jan-86 14:03:51" {DANTE}<NEWMAN>LISP>AUXMENU.;15)
(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))
(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. ")))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MiddleButtonBackgroundMenuCommands MiddleButtonBackgroundMenu)
)
(DEFINEQ
(BackgroundButtonFN
[LAMBDA NIL (* Newman "23-Dec-85 13: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
((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)
(SETQ BACKGROUNDBUTTONEVENTFN (QUOTE BackgroundButtonFN))
(PUTPROPS AUXMENU COPYRIGHT (NONE))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3685 6414 (BackgroundButtonFN 3695 . 4708) (CreateMiddleButtonBackgroundMenu 4710 .
5057) (Auxmenu.Other.Directory 5059 . 6412)))))
STOP