diff --git a/fonts/xerox/.ReadMe b/fonts/xerox/.ReadMe deleted file mode 100644 index 2bc12d9e..00000000 --- a/fonts/xerox/.ReadMe +++ /dev/null @@ -1,3 +0,0 @@ -This directory contains fonts and font information which are to be used for Xerox internal uses only. Under no circumstances can these fonts be released for customer use. For information, contact Frank Shih, Lisp Development, Xerox Artificial Intelligence Systems. - -The screen fonts labelled ITCBauhaus are in fact just renamed copies of the font Modern. This is because ITCBauhaus is not yet available at 72 dpi, and so the generic Modern is substituted instead. Printers containing the font ITCBauhaus should be able to correctly render the file, however. diff --git a/lispusers/HARDCOPY-RETAIN.DFASL b/lispusers/HARDCOPY-RETAIN.DFASL new file mode 100644 index 00000000..e3d6d9e2 Binary files /dev/null and b/lispusers/HARDCOPY-RETAIN.DFASL differ diff --git a/lispusers/INSPECTCODE-TEDIT.LCOM b/lispusers/INSPECTCODE-TEDIT.LCOM new file mode 100644 index 00000000..bd9b604c Binary files /dev/null and b/lispusers/INSPECTCODE-TEDIT.LCOM differ diff --git a/lispusers/KEYOBJ.LCOM b/lispusers/KEYOBJ.LCOM new file mode 100644 index 00000000..17f6918a Binary files /dev/null and b/lispusers/KEYOBJ.LCOM differ diff --git a/lispusers/MACWINDOW.TXT b/lispusers/MACWINDOW.TXT new file mode 100644 index 00000000..a79bd768 --- /dev/null +++ b/lispusers/MACWINDOW.TXT @@ -0,0 +1,4 @@ +MACWINDOWS + + +Changes shrinking and expanding icons with a zoom. diff --git a/lispusers/MANAGER b/lispusers/MANAGER index e16b866b..bc2290fa 100644 --- a/lispusers/MANAGER +++ b/lispusers/MANAGER @@ -1,82 +1,192 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") -(FILECREATED "18-Nov-87 15:18:24" |{POGO:AISNORTH:XEROX}WORK>MANAGER.;2| 76893 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS Manager.DO.COMMAND Manager.SORT.COMS) +(FILECREATED "10-Feb-2022 22:17:51" {DSK}larry>medley>lispusers>MANAGER.;4 111722 - previous date%: "16-Sep-87 12:30:48" |{POGO:AISNORTH:XEROX}WORK>MANAGER.;1|) + :CHANGES-TO (ADVICE (MARKASCHANGED :IN DEFAULT.EDITDEFA0001) + LOADFNS LOAD \ADDTOFILEBLOCK/ADDNEWCOM DELFROMCOMS ADDTOCOMS UPDATEFILES + UNMARKASCHANGED MARKASCHANGED MAKEFILE ADDTOFILES? ADDFILE) + (VARS MANAGERCOMS) + (FNS Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW + Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE + Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE + Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES + Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT + Manager.GETFILE Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE + Manager.MAINMENUITEMS Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV + Manager.MENUCOLUMNS Manager.MENUHASITEM Manager.MENUITEMS + Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS Manager.SORT.COMS + Manager.SORTBYCOLUMN) + + :PREVIOUS-DATE "18-Nov-87 15:18:24" |{POGO:AISNORTH:XEROX}WORK>MANAGER.;2|) -(* " -Copyright (c) 1986, 1987, 1900 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation. ") (PRETTYCOMPRINT MANAGERCOMS) -(RPAQQ MANAGERCOMS ((* ;; "The Manager : a menu based interface to the file manager. ") (* ;; "Originally written by: Jay Ferguson of Ford Aerospace & Communications Corp and Robert Noble of Intellicorp. ") (* ;; "Rewritten by Larry Masinter, winter of 1986.") (* ;; "Further modifications & significant enhancements by Andrew J. Cameron III, summer of 1987.") (* ;; "Ongoing maintenance and performance tuning by Ron Fischer at Xerox AI Systems.") (* ;; "") (* ;; "There are two patches in here that should be removed if Xerox Lisp is fixed. The first is the advice (MARKASCHANGED :IN DEFAULT.EDITDEFA0001) that removes a (mostly) redundant call to MARKASCHANGED in the editor interface, which otherwise slows down manager updates. Somehow this call is not redundant when editing FILELST (perhaps there's a special case for FILELST or when items are not in any existing files). The second is the fns Manager.REMOVE.DUPLICATE.ADVICE called by the advice on LOAD and LOADFNS, which removes redundant advice which would otherwise pile up and cause massive slow downs in manager updates!") (* ;; "") (* ;; "The edit history is now kept in the file MANAGER.HISTORY.") (* ;; "") (* ;; "Known bugs and feature requests are now kept in the documentation file MANAGER.TEDIT.") (* ;; "") (SPECVARS Manager.ACTIVEFLG MANAGER-CASES MANAGER-ADDTOFILES?) (GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands BackgroundMenu) (VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES) (MANAGER-ADDTOFILES?) MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-ITEM-OPERATION-COMMANDS MANAGER-MAIN-MENU-ITEMS MANAGER.BM MANAGER.BM.MASK) (INITVARS (Manager.ACTIVEFLG NIL) (Manager.SORTFILELSTFLG T) (Manager.MENUROWS 20) (Manager.DATASPACE NIL) (MANAGER-WINDOWS NIL) (MANAGER-MAIN-WINDOW NIL) (MANAGER-OPEN-WINDOWS NIL) (MANAGER-FILE-MENU NIL) (MANAGER-FILELST-MENU NIL) (MANAGER-FILE-OPERATIONS-MENU NIL) (MANAGER-FILE-FILE-RELATION-MENU NIL) (MANAGER-MARKED-SHADE BOLDMENUFONT)) (FILES FILEBROWSER) (* ; "for SEE command") (FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS Manager.SORT.COMS Manager.SORTBYCOLUMN) (ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)) (MACROS GETDATUM PUTDATUM Manager.TTYCOMMAND) (PROP MANAGER-DEFINITION-TYPE-COMMANDS ADVICE FNS RECORDS VARS FUNCTIONS) (ADDVARS (BackgroundMenuCommands (File% Manager (MANAGER) "Starts the menu driven file manager"))) (P (LSUBST (QUOTE Manager) NIL BackgroundMenuCommands) (* ; "remove old manager entry if it exists") (SETQ BackgroundMenu NIL) (* ; " cause the backGround menu to be rebuilt") (MANAGER.RESET (CL:SYMBOL-VALUE (QUOTE Manager.ACTIVEFLG))) (* ; "Shutdown any old manager windows and restart if we're already running.") (if (STREQUAL MANAGER-ACTIVITY-WINDOW-TITLE (WINDOWPROP NIL (QUOTE TITLE))) then (* ; "If we're in the manager activity window, close it, since we dropped the pointer to it in MANAGER.RESET.") (CLOSEW NIL))) (PROP (MAKEFILE-ENVIRONMENT FILETYPE) MANAGER) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA)))) -) +(RPAQQ MANAGERCOMS + [ + (* ;; "The Manager : a menu based interface to the file manager. ") + + + (* ;; "Originally written by: Jay Ferguson of Ford Aerospace & Communications Corp and Robert Noble of Intellicorp. ") + + + (* ;; "Rewritten by Larry Masinter, winter of 1986.") + + + (* ;; + "Further modifications & significant enhancements by Andrew J. Cameron III, summer of 1987.") + + + (* ;; "Ongoing maintenance and performance tuning by Ron Fischer at Xerox AI Systems.") + + + (* ;; "") + + + (* ;; "There are two patches in here that should be removed if Xerox Lisp is fixed. The first is the advice (MARKASCHANGED :IN DEFAULT.EDITDEFA0001) that removes a (mostly) redundant call to MARKASCHANGED in the editor interface, which otherwise slows down manager updates. Somehow this call is not redundant when editing FILELST (perhaps there's a special case for FILELST or when items are not in any existing files). The second is the fns Manager.REMOVE.DUPLICATE.ADVICE called by the advice on LOAD and LOADFNS, which removes redundant advice which would otherwise pile up and cause massive slow downs in manager updates!") + + + (* ;; "") + + + (* ;; "The edit history is now kept in the file MANAGER.HISTORY.") + + + (* ;; "") + + + (* ;; "Known bugs and feature requests are now kept in the documentation file MANAGER.TEDIT.") + + + (* ;; "") + + (SPECVARS Manager.ACTIVEFLG MANAGER-CASES MANAGER-ADDTOFILES?) + (GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG + MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS + MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS + MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands + BackgroundMenu) + (VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES) + (MANAGER-ADDTOFILES?) + MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS + MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-ITEM-OPERATION-COMMANDS + MANAGER-MAIN-MENU-ITEMS MANAGER.BM MANAGER.BM.MASK) + (INITVARS (Manager.ACTIVEFLG NIL) + (Manager.SORTFILELSTFLG T) + (Manager.MENUROWS 20) + (Manager.DATASPACE NIL) + (MANAGER-WINDOWS NIL) + (MANAGER-MAIN-WINDOW NIL) + (MANAGER-OPEN-WINDOWS NIL) + (MANAGER-FILE-MENU NIL) + (MANAGER-FILELST-MENU NIL) + (MANAGER-FILE-OPERATIONS-MENU NIL) + (MANAGER-FILE-FILE-RELATION-MENU NIL) + (MANAGER-MARKED-SHADE BOLDMENUFONT)) + (FILES FILEBROWSER) + (* ; "for SEE command") + (FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING + Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW + Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE Manager.COLLECTCOMS + Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE Manager.HIGHLIGHTED + Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED? + Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE? + Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN + Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM + Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS + Manager.SORT.COMS Manager.SORTBYCOLUMN) + (ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS + DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN + DEFAULT.EDITDEFA0001)) + (MACROS GETDATUM PUTDATUM Manager.TTYCOMMAND) + (PROP MANAGER-DEFINITION-TYPE-COMMANDS ADVICE FNS RECORDS VARS FUNCTIONS) + (ADDVARS (BackgroundMenuCommands (File% Manager (MANAGER) + "Starts the menu driven file manager"))) + (P (LSUBST 'Manager NIL BackgroundMenuCommands) + (* ; + "remove old manager entry if it exists") + (SETQ BackgroundMenu NIL) + (* ; + " cause the backGround menu to be rebuilt") + (MANAGER.RESET (CL:SYMBOL-VALUE 'Manager.ACTIVEFLG)) + (* ; + "Shutdown any old manager windows and restart if we're already running.") + (if (STREQUAL MANAGER-ACTIVITY-WINDOW-TITLE (WINDOWPROP NIL 'TITLE)) + then + (* ; "If we're in the manager activity window, close it, since we dropped the pointer to it in MANAGER.RESET.") + (CLOSEW NIL))) + (PROP (MAKEFILE-ENVIRONMENT FILETYPE) + MANAGER) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA]) -(* ;; "The Manager : a menu based interface to the file manager. ") +(* ;; "The Manager : a menu based interface to the file manager. ") -(* ;; +(* ;; "Originally written by: Jay Ferguson of Ford Aerospace & Communications Corp and Robert Noble of Intellicorp. " ) -(* ;; "Rewritten by Larry Masinter, winter of 1986.") +(* ;; "Rewritten by Larry Masinter, winter of 1986.") -(* ;; "Further modifications & significant enhancements by Andrew J. Cameron III, summer of 1987.") +(* ;; "Further modifications & significant enhancements by Andrew J. Cameron III, summer of 1987.") -(* ;; "Ongoing maintenance and performance tuning by Ron Fischer at Xerox AI Systems.") +(* ;; "Ongoing maintenance and performance tuning by Ron Fischer at Xerox AI Systems.") -(* ;; "") +(* ;; "") -(* ;; +(* ;; "There are two patches in here that should be removed if Xerox Lisp is fixed. The first is the advice (MARKASCHANGED :IN DEFAULT.EDITDEFA0001) that removes a (mostly) redundant call to MARKASCHANGED in the editor interface, which otherwise slows down manager updates. Somehow this call is not redundant when editing FILELST (perhaps there's a special case for FILELST or when items are not in any existing files). The second is the fns Manager.REMOVE.DUPLICATE.ADVICE called by the advice on LOAD and LOADFNS, which removes redundant advice which would otherwise pile up and cause massive slow downs in manager updates!" ) -(* ;; "") +(* ;; "") -(* ;; "The edit history is now kept in the file MANAGER.HISTORY.") +(* ;; "The edit history is now kept in the file MANAGER.HISTORY.") -(* ;; "") +(* ;; "") -(* ;; "Known bugs and feature requests are now kept in the documentation file MANAGER.TEDIT.") +(* ;; "Known bugs and feature requests are now kept in the documentation file MANAGER.TEDIT.") -(* ;; "") +(* ;; "") (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -84,7 +194,10 @@ Copyright (c) 1986, 1987, 1900 by Xerox Corporation. All rights reserved. ) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands BackgroundMenu) +(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG + MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS + MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-MAIN-MENU-ITEMS + MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands BackgroundMenu) ) (RPAQQ *UNMANAGED-TYPES* (EXPRESSIONS FILES FIELDS FILEVARS-ARE-NOW-OK)) @@ -95,25 +208,185 @@ Copyright (c) 1986, 1987, 1900 by Xerox Corporation. All rights reserved. (RPAQQ MANAGER-ADDTOFILES? NIL) -(RPAQQ MANAGER-FILE-FILE-RELATION-COMMANDS ((" Delete " (QUOTE DELETE) "Delete this file") ("Rename" (QUOTE RENAME) "Rename this file") ("Copy" (QUOTE COPY) "Copy this item to another file") ("Mark" (QUOTE CHANGED) "Mark this file as being changed") ("Unmark" (QUOTE UNMARK) "Unmark this file as being changed")) -) +(RPAQQ MANAGER-FILE-FILE-RELATION-COMMANDS + ((" Delete " 'DELETE "Delete this file") + ("Rename" 'RENAME "Rename this file") + ("Copy" 'COPY "Copy this item to another file") + ("Mark" 'CHANGED "Mark this file as being changed") + ("Unmark" 'UNMARK "Unmark this file as being changed"))) -(RPAQQ MANAGER-FILE-OPERATIONS-COMMANDS (("See" (QUOTE SEE) "Show file in a window" (SUBITEMS ("Fast" (QUOTE SEE) "Show file in a window") (" Scrollable " (QUOTE TEDIT-SEE) "Show file in a scrollable window"))) ("(Re)Load" (QUOTE LOAD) "Load the source of this file" (SUBITEMS ("Load" (QUOTE LOAD) "Load the source of this file") (" SysLoad " (QUOTE SYSLOAD) "SysLoad the file: smashes everything on the way in and is not UNDOable"))) ("MakeFile" (QUOTE MAKEFILE) "Dump the source of this file" (SUBITEMS ("MakeFile" (QUOTE MAKEFILE) "Dump the source of this file, by remaking it") ("New" (QUOTE NEW) "Don't copy any definitions from old version") ("Fast" (QUOTE FAST) "Dump the source without pretty printing") (" CommonLisp " (QUOTE COMMON-MAKEFILE) "Create a .LSP file containing plain CommonLisp source -Will load Common-MakeFile if necessary"))) ("List" (QUOTE LIST) "List this file on the default printer") ("CleanUp" (QUOTE CLEANUP) "Dump, list and recompile this file" (SUBITEMS ("CleanUp" (QUOTE CLEANUP) "Dump, list and recompile this file, using the default cleanup compiler") (" Set default: compile-file " CLEANUPC "Change the default cleanup compiler to compile-file; yeilding .dfasl files") ("Set default: TCOMPL" CLEANUPT "Change the default cleanup compiler to TCOMPL; yeilding .LCOM files -This compiler will be going away soon"))) ("MasterScope" (QUOTE ANALYZE) "Analyze the FNS on the selected file with MasterScope" (SUBITEMS ("Analyze" (QUOTE ANALYZE) "Analyze the FNS on the selected file with MasterScope") ("Check" (QUOTE CHECK) "Check the file for problems through MasterScope") ("Show Paths" (QUOTE SHOWPATHFILE) "Show all functions called by functions in this file") (" DataBaseFNS " (QUOTE DBFILE) "Display DATABASE property for this file -Will load DataBaseFNS if necessary" (SUBITEMS ("Set to Ask" (QUOTE DBFILEASK) "Ask about disposition of MasterScope information when loading and storing this file") ("Set to On" (QUOTE DBFILEON) "Automatically maintain the MasterScope information for this file") ("Set to Off" (QUOTE DBFILEOFF) "Do not automatically maintain the MasterScope information for this file") (" Load DB " (QUOTE LOADDB) "Load this file's MasterScope information, if it exists and make it's upkeep automatic") ("Dump DB" (QUOTE DUMPDB) "Dump this file's MasterScope information, if it exists and make it's upkeep automatic"))))) ("Compile" (QUOTE COMPILE) "Compile this file" (SUBITEMS ("Compile" (QUOTE COMPILE) "InterLisp compiler") (" CL:COMPILE-FILE " (QUOTE CL:COMPILE-FILE) "CommonLisp compiler"))) ("Changes" (QUOTE CHANGES) "Show the changes that have been made to this file." (SUBITEMS ("Brief" (QUOTE CHANGES) "Show the changes that have been made to this file.") (" Everything " (QUOTE PL) "Display everything on this file's property list") ("Edit PL" (QUOTE EDIT) "Edit this file's property list")))) -) +(RPAQQ MANAGER-FILE-OPERATIONS-COMMANDS + [("See" 'SEE "Show file in a window" (SUBITEMS ("Fast" 'SEE "Show file in a window") + (" Scrollable " 'TEDIT-SEE + "Show file in a scrollable window"))) + ("(Re)Load" 'LOAD "Load the source of this file" (SUBITEMS ("Load" 'LOAD + "Load the source of this file" + ) + (" SysLoad " 'SYSLOAD + "SysLoad the file: smashes everything on the way in and is not UNDOable" + ))) + ("MakeFile" 'MAKEFILE "Dump the source of this file" (SUBITEMS ("MakeFile" 'MAKEFILE + "Dump the source of this file, by remaking it" + ) + ("New" 'NEW + "Don't copy any definitions from old version" + ) + ("Fast" 'FAST + "Dump the source without pretty printing" + ) + (" CommonLisp " 'COMMON-MAKEFILE + + "Create a .LSP file containing plain CommonLisp source +Will load Common-MakeFile if necessary"))) + ("List" 'LIST "List this file on the default printer") + ("CleanUp" 'CLEANUP "Dump, list and recompile this file" (SUBITEMS ("CleanUp" 'CLEANUP + "Dump, list and recompile this file, using the default cleanup compiler" + ) + ( + " Set default: compile-file " + CLEANUPC + "Change the default cleanup compiler to compile-file; yeilding .dfasl files" + ) + ("Set default: TCOMPL" + CLEANUPT "Change the default cleanup compiler to TCOMPL; yeilding .LCOM files +This compiler will be going away soon"))) + ["MasterScope" 'ANALYZE "Analyze the FNS on the selected file with MasterScope" + (SUBITEMS ("Analyze" 'ANALYZE "Analyze the FNS on the selected file with MasterScope") + ("Check" 'CHECK "Check the file for problems through MasterScope") + ("Show Paths" 'SHOWPATHFILE + "Show all functions called by functions in this file") + (" DataBaseFNS " 'DBFILE + "Display DATABASE property for this file +Will load DataBaseFNS if necessary" (SUBITEMS ("Set to Ask" 'DBFILEASK + "Ask about disposition of MasterScope information when loading and storing this file" + ) + ("Set to On" 'DBFILEON + "Automatically maintain the MasterScope information for this file" + ) + ("Set to Off" 'DBFILEOFF + "Do not automatically maintain the MasterScope information for this file" + ) + (" Load DB " 'LOADDB + "Load this file's MasterScope information, if it exists and make it's upkeep automatic" + ) + ("Dump DB" 'DUMPDB + "Dump this file's MasterScope information, if it exists and make it's upkeep automatic" + ] + ("Compile" 'COMPILE "Compile this file" (SUBITEMS ("Compile" 'COMPILE "InterLisp compiler") + (" CL:COMPILE-FILE " 'CL:COMPILE-FILE + "CommonLisp compiler"))) + ("Changes" 'CHANGES "Show the changes that have been made to this file." + (SUBITEMS ("Brief" 'CHANGES "Show the changes that have been made to this file.") + (" Everything " 'PL "Display everything on this file's property list") + ("Edit PL" 'EDIT "Edit this file's property list"]) -(RPAQQ MANAGER-ITEM-FILE-RELATION-COMMANDS ((" Delete " (QUOTE DELETE) "Delete this item") ("EditAll" (QUOTE EDITCALLERS) "Edit occurances of this item's name in its file") ("Rename" (QUOTE RENAME) "Rename this item and update its file with new name" (SUBITEMS ("Rename" (QUOTE RENAME) "Rename this item locally and update its file with new name") ("CopyDef" (QUOTE COPYDEF) "Make a copy with a new name") (" Rename All " (QUOTE RENAME-ALL) "Rename this item in *ALL* loaded files"))) ("Move" (QUOTE MOVE) "Move this item to another file") ("Copy" (QUOTE COPY) "Copy this item to another file") ("Mark" (QUOTE CHANGED) "Mark this item as being changed" (SUBITEMS ("Changed" (QUOTE CHANGED) "Mark item as being CHANGED") (" Defined " (QUOTE DEFINED) "Mark item as being DEFINED") ("Deleted" (QUOTE DELETED) "Mark item as being DELETED"))) ("Unmark" (QUOTE UNMARK) "Unmark this item as being changed")) -) +(RPAQQ MANAGER-ITEM-FILE-RELATION-COMMANDS + ((" Delete " 'DELETE "Delete this item") + ("EditAll" 'EDITCALLERS "Edit occurances of this item's name in its file") + ("Rename" 'RENAME "Rename this item and update its file with new name" + (SUBITEMS ("Rename" 'RENAME + "Rename this item locally and update its file with new name") + ("CopyDef" 'COPYDEF "Make a copy with a new name") + (" Rename All " 'RENAME-ALL "Rename this item in *ALL* loaded files"))) + ("Move" 'MOVE "Move this item to another file") + ("Copy" 'COPY "Copy this item to another file") + ("Mark" 'CHANGED "Mark this item as being changed" (SUBITEMS ("Changed" 'CHANGED + "Mark item as being CHANGED" + ) + (" Defined " 'DEFINED + "Mark item as being DEFINED" + ) + ("Deleted" 'DELETED + "Mark item as being DELETED" + ))) + ("Unmark" 'UNMARK "Unmark this item as being changed"))) -(RPAQQ MANAGER-ITEM-OPERATION-COMMANDS (("Edit" (QUOTE EDIT) "Edit this item") (" PrettyPrint " (QUOTE SHOWDEF) "Show how this item would be written to a file" (SUBITEMS ("Show" (QUOTE SHOWDEF) "Show how this item would be written to a file") ("Value" (QUOTE PV) "Display (Pretty-Print) this item's value") ("Function Def" (QUOTE PF) "Display (Pretty-Print) this item's function definition") (" Property List " (QUOTE PL) "Display this item's property list"))) (" Documentation " (QUOTE CLDOC) "Show the CommonLisp documentation string for this item" (SUBITEMS (" Documentation " (QUOTE CLDOC) "Show the CommonLisp documentation string for this item") (" Describe " (QUOTE CLDESCRIBE) "Show the CommonLisp description of this item")))) -) +(RPAQQ MANAGER-ITEM-OPERATION-COMMANDS + [("Edit" 'EDIT "Edit this item") + (" PrettyPrint " 'SHOWDEF "Show how this item would be written to a file" + (SUBITEMS ("Show" 'SHOWDEF "Show how this item would be written to a file") + ("Value" 'PV "Display (Pretty-Print) this item's value") + ("Function Def" 'PF "Display (Pretty-Print) this item's function definition") + (" Property List " 'PL "Display this item's property list"))) + (" Documentation " 'CLDOC "Show the CommonLisp documentation string for this item" + (SUBITEMS (" Documentation " 'CLDOC + "Show the CommonLisp documentation string for this item") + (" Describe " 'CLDESCRIBE "Show the CommonLisp description of this item"]) -(RPAQQ MANAGER-MAIN-MENU-ITEMS (("MakeFiles" (QUOTE MAKEFILE) "Update the source of all changed files") ("CleanUp" (QUOTE CLEANUP) "Dump, list and recompile any changed files" (SUBITEMS ("CleanUp" (QUOTE CLEANUP) "Dump, list and recompile any changed files, using the default cleanup compiler") (" Set default: compile-file " (QUOTE CLEANUPC) "Change the default cleanup compiler to compile-file; yielding .dfasl files") ("Set default: TCOMPL" (QUOTE CLEANUPT) "Change the default cleanup compiler to TCOMPL; yielding .LCOM files -This compiler will be going away soon"))) ("Changes" (QUOTE CHANGES) "Prints all the changes that have been made") ("MS DataBaseFNS" (QUOTE DB) "Displays the current MasterScope database flags, -Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the current MasterScope database flags" (SUBITEMS (" Set to Ask " (QUOTE DBASK) "Ask user when Loading and/or Saving files") ("Set to On" (QUOTE DBON) "Always maintain MasterScope database information") ("Set to Off" (QUOTE DBOFF) "Stop maintaining MasterScope database information"))) ("Load" (QUOTE DB) "Displays the current MasterScope database flags" (SUBITEMS (" Set to Ask " (QUOTE DBLOADASK) "Ask user when Loading files") ("Set to On" (QUOTE DBLOADON) "Maintain MasterScope database information when Loading") ("Set to Off" (QUOTE DBLOADOFF) "Don't load MasterScore information from database files"))) (" Save " (QUOTE DB) "Displays the current MasterScope database flags" (SUBITEMS (" Set to Ask " (QUOTE DBSAVEASK) "Ask user when Saving files") ("Set to On" (QUOTE DBSAVEON) "Maintain MasterScope database information when Loading") ("Set to Off" (QUOTE DBSAVEOFF) "Don't save MasterScore information in database files"))))) ("Files?" (QUOTE FILES?) "Ask for updates and display status of files") ("Add" (QUOTE LOADFNSLATER) "Add a file to the FileManager's menu" (SUBITEMS ("LoadFns" (QUOTE LOADFNSLATER) "Notice a file using LOADFNS" (SUBITEMS (" LoadFns Later " (QUOTE LOADFNSLATER) "Notice a file, but don't load the function defs until needed") ("LoadFns Now" (QUOTE LOADFNSNOW) "Notice a file and loads all it's function defs"))) ("LoadFrom" (QUOTE LOADFROMLATER) "Notice a file using LOADFROM" (SUBITEMS (" LoadFrom Later " (QUOTE LOADFROMLATER) "Notice a file with side-effects, but don't load the function defs until needed") ("LoadFrom Now" (QUOTE LOADFROMNOW) "Notice a file with side-effects and load all it's function defs"))) ("Load" (QUOTE LOAD) "Notice a file by actually LOADing it") ("AddFile" (QUOTE ADDFILE) "Notices a file via ADDFILE (buggy)") ("Edit FILELST" (QUOTE EDIT) "Edit the variable which lists the files noticed by the file package"))) ("Advice" (QUOTE SHOWADVICE) "Display the list of advised or traced fns and functions.") ("Quit" (QUOTE QUIT) "Shut down all manager windows" (SUBITEMS ("Quit" (QUOTE QUIT) "Shut down all manager windows") (" Reset " (QUOTE RESET) "Reset the manager, leaving only the main window open")))) -) +(RPAQQ MANAGER-MAIN-MENU-ITEMS + [("MakeFiles" 'MAKEFILE "Update the source of all changed files") + ("CleanUp" 'CLEANUP "Dump, list and recompile any changed files" (SUBITEMS + ("CleanUp" 'CLEANUP + "Dump, list and recompile any changed files, using the default cleanup compiler" + ) + ( + " Set default: compile-file " + 'CLEANUPC + "Change the default cleanup compiler to compile-file; yielding .dfasl files" + ) + ("Set default: TCOMPL" + 'CLEANUPT "Change the default cleanup compiler to TCOMPL; yielding .LCOM files +This compiler will be going away soon"))) + ("Changes" 'CHANGES "Prints all the changes that have been made") + ["MS DataBaseFNS" 'DB + "Displays the current MasterScope database flags, +Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB + "Displays the current MasterScope database flags" + (SUBITEMS (" Set to Ask " 'DBASK + "Ask user when Loading and/or Saving files" + ) + ("Set to On" 'DBON + "Always maintain MasterScope database information" + ) + ("Set to Off" 'DBOFF + "Stop maintaining MasterScope database information" + ))) + ("Load" 'DB + "Displays the current MasterScope database flags" + (SUBITEMS (" Set to Ask " 'DBLOADASK + "Ask user when Loading files") + ("Set to On" 'DBLOADON + "Maintain MasterScope database information when Loading" + ) + ("Set to Off" 'DBLOADOFF + "Don't load MasterScore information from database files" + ))) + (" Save " 'DB + "Displays the current MasterScope database flags" + (SUBITEMS (" Set to Ask " 'DBSAVEASK + "Ask user when Saving files") + ("Set to On" 'DBSAVEON + "Maintain MasterScope database information when Loading" + ) + ("Set to Off" 'DBSAVEOFF + "Don't save MasterScore information in database files" + ] + ("Files?" 'FILES? "Ask for updates and display status of files") + ("Add" 'LOADFNSLATER "Add a file to the FileManager's menu" + (SUBITEMS ("LoadFns" 'LOADFNSLATER "Notice a file using LOADFNS" + (SUBITEMS (" LoadFns Later " 'LOADFNSLATER + "Notice a file, but don't load the function defs until needed" + ) + ("LoadFns Now" 'LOADFNSNOW + "Notice a file and loads all it's function defs"))) + ("LoadFrom" 'LOADFROMLATER "Notice a file using LOADFROM" + (SUBITEMS (" LoadFrom Later " 'LOADFROMLATER + "Notice a file with side-effects, but don't load the function defs until needed" + ) + ("LoadFrom Now" 'LOADFROMNOW + "Notice a file with side-effects and load all it's function defs" + ))) + ("Load" 'LOAD "Notice a file by actually LOADing it") + ("AddFile" 'ADDFILE "Notices a file via ADDFILE (buggy)") + ("Edit FILELST" 'EDIT + "Edit the variable which lists the files noticed by the file package"))) + ("Advice" 'SHOWADVICE "Display the list of advised or traced fns and functions.") + ("Quit" 'QUIT "Shut down all manager windows" (SUBITEMS ("Quit" 'QUIT + "Shut down all manager windows" + ) + (" Reset " 'RESET + "Reset the manager, leaving only the main window open" + ]) (RPAQQ MANAGER.BM #*(72 40)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OOOOOOOOOOL@@@@@@@@@OOOOOOOOOOL@@@@@@@@@LIOOOOOOOOL@@@@@@@@@MEAAAAAAOOL@@@@@@@@@MMMEMEEGOOL@@@@@@@@@MMAEAAGGOOL@@@@@@@@@MMAEAMAGOOL@@@@@@@@@OOOOOAOOOOL@@@@@@@@@OOOOOOOOOOL@@@@@@@@@H@@@@@@@@HD@@@@@@@@@IK@@@@@@@DD@@@@@@@@@IEGGE@@@@JD@@@@@@@@FIAEEE@@@@EEOOOOOO@@FIADEE@@@@JEOOOOOO@@FIAGEG@@@@DEOGOOOO@@FH@@@@@@@@HENBCOOO@@FOOOOOOOOOOMOFKOOO@@FH@@@@@@@@HEOFKOOO@@FIL@@@B@@@DEOFCOOO@@FIB@@@B@@@JEOOOOOO@@FILNNNN@@@EEOOOOOO@@DIBBLNN@@@JD@@@@@A@@DIBNFHJ@@@DDLIEHMM@@DILNNNN@@@HEAEEEAA@@DH@@@@@@@@@DIEEIAI@@DOOOOOOOOOOLEEEEAA@@DH@@@@@@@@HEHHIDMM@@DI@B@@F@@@DD@@@@@A@@FIGGGGDNNNJEOOOOOO@@DIEBEEFBHJED@@@@@A@@DIEBDDDNHHJD@@@@@A@@DIECGDDNNNDDNJCIJA@@DH@@@@@@@@HDHJBBAA@@DOOOOOOOOOOLLJCCIA@@D@@@@@@@@@@@HJB@IA@@DDANANDDDDHLHKKKBA@@D@@@@@@@@@@@@@@@@A@@GOOOOOOOOOOOOOOOOO@@ ) @@ -144,11 +417,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (RPAQ? MANAGER-FILE-FILE-RELATION-MENU NIL) (RPAQ? MANAGER-MARKED-SHADE BOLDMENUFONT) + (FILESLOAD FILEBROWSER) -(* ; "for SEE command") +(* ; "for SEE command") (DEFINEQ @@ -157,32 +431,29 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "Turns manager on if its not already on") - (if (OR (NULL Manager.ACTIVEFLG) + (if (OR (NULL Manager.ACTIVEFLG) (NULL MANAGER-MAIN-WINDOW) (Manager.FILELSTCHANGED?)) - then - - (* ;; "If either the manager was off or FILELST changed, rebuild main menu.") + then + (* ;; "If either the manager was off or FILELST changed, rebuild main menu.") - (if Manager.ACTIVEFLG then (Manager.MAINCLOSE)) - (LET ((Manager.ACTIVEFLG NIL)) - (UPDATEFILES)) - (if FILELST then (Manager.MAINOPEN POSITION) - else - (PROMPTPRINT "FILELST is empty; there are no files to manage.")) - else - (TOTOPW MANAGER-MAIN-WINDOW]) + (if Manager.ACTIVEFLG + then (Manager.MAINCLOSE)) + (LET ((Manager.ACTIVEFLG NIL)) + (UPDATEFILES)) + (if FILELST + then (Manager.MAINOPEN POSITION) + else (PROMPTPRINT "FILELST is empty; there are no files to manage.")) + else (TOTOPW MANAGER-MAIN-WINDOW]) (MANAGER.RESET [LAMBDA (RESTARTFLG) (* ; "Edited 21-Aug-87 11:41 by raf") (* ;;; "Remove all cached menu info, close the main window, clear the global data space. If the RESTARTFLG is true, turn everything on again.") - - (* ;; "Delete all of the menu caches") - (for X in FILEPKGCOMSPLST when (LITATOM X) - do - (REMPROP X 'MANAGER-ITEM-OPERATION-MENU)) + (* ;; "Delete all of the menu caches") + + (for X in FILEPKGCOMSPLST when (LITATOM X) do (REMPROP X 'MANAGER-ITEM-OPERATION-MENU)) (SETQ MANAGER-MAIN-MENU NIL) (SETQ MANAGER-FILE-OPERATIONS-MENU NIL) (SETQ MANAGER-ITEM-FILE-RELATION-MENU NIL) @@ -191,24 +462,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (WINDOWPROP MANAGER-MAIN-WINDOW 'REGION] (* ;  "Save away the old region (if there was one.") - - (* ;; "Close the main window and all subwindows.") + + (* ;; "Close the main window and all subwindows.") (Manager.MAINCLOSE T) - - (* ;; "Clear the data space.") + + (* ;; "Clear the data space.") [SETQ Manager.DATASPACE (COPY '((NIL] - (if RESTARTFLG then - - (* ;; "Now turn it all on again.") + (if RESTARTFLG + then + (* ;; "Now turn it all on again.") - [MANAGER (AND REGION (create POSITION XCOORD _ (fetch (REGION LEFT) - of REGION) - YCOORD _ (fetch (REGION BOTTOM) - of REGION] - else - (SETQ Manager.ACTIVEFLG NIL]) + [MANAGER (AND REGION (create POSITION + XCOORD _ (fetch (REGION LEFT) of REGION) + YCOORD _ (fetch (REGION BOTTOM) of REGION] + else (SETQ Manager.ACTIVEFLG NIL]) (Manager.ADDADV [LAMBDA (!VALUE FILECOMS NAME COMSTYPE) (* ; "Edited 16-Aug-87 22:38 by raf") @@ -216,28 +485,24 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "Called when any file's COMS are added to or deleted from. For each open subitem window of that file, if we're under ADDTOFILES? save the change, otherwise update the window.") (PROG (FILE SUBITEMS ITEMS) - (if (OR (NULL !VALUE) + (if (OR (NULL !VALUE) (LISTP FILECOMS)) - then - (RETURN) - else - (if [SETQ FILE (for F in FILELST thereis (EQ FILECOMS (FILECOMS F] - then - (for WINDOW in MANAGER-OPEN-WINDOWS bind STUFF when - (AND (OPENWP WINDOW) - (EQ [CDR (SETQ STUFF (GETDATUM (CAR (WINDOWPROP WINDOW 'MENU] - COMSTYPE) - (EQ (CAR STUFF) - FILE)) - do - (if MANAGER-ADDTOFILES? then (pushnew MANAGER-CASES STUFF) - else - (Manager.COMSOPEN FILE COMSTYPE))) - (Manager.RESETSUBITEMS FILE COMSTYPE]) + then (RETURN) + else (if [SETQ FILE (for F in FILELST thereis (EQ FILECOMS (FILECOMS F] + then (for WINDOW in MANAGER-OPEN-WINDOWS bind STUFF + when (AND (OPENWP WINDOW) + (EQ [CDR (SETQ STUFF (GETDATUM (CAR (WINDOWPROP WINDOW + 'MENU] + COMSTYPE) + (EQ (CAR STUFF) + FILE)) do (if MANAGER-ADDTOFILES? + then (pushnew MANAGER-CASES STUFF) + else (Manager.COMSOPEN FILE COMSTYPE))) + (Manager.RESETSUBITEMS FILE COMSTYPE]) (Manager.ADDTOFILES? - [LAMBDA NIL (* lmm "16-Nov-86 23:16") - (for CASE in MANAGER-CASES do (Manager.COMSOPEN (CAR CASE) + [LAMBDA NIL (* lmm "16-Nov-86 23:16") + (for CASE in MANAGER-CASES do (Manager.COMSOPEN (CAR CASE) (CDR CASE))) (SETQ MANAGER-CASES NIL]) @@ -248,48 +513,445 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (COND ((EQ MARKING? 'CLISP) (* ; " ignore") - ) ((AND (EQ ITEM 'FILELST) (EQ TYPE 'VARS)) (* ; "FILELST has been edited.") - (MANAGER)) ((EQ TYPE 'FILES) (* ; "A whole file has been marked.") - (UPDATEFILES)) - (T (* ;; "For each manager menu window that's open we look to see if it contains the named definition. We can only update a menu if the window is expanded (and can't see the menu when its window is shrunk).") + (T + (* ;; "For each manager menu window that's open we look to see if it contains the named definition. We can only update a menu if the window is expanded (and can't see the menu when its window is shrunk).") - (for WINDOW in MANAGER-OPEN-WINDOWS bind MENU (UPDATEFILES _ NIL) - when - [AND (OPENWP WINDOW) - (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] - do - (if [AND (Manager.MENUHASITEM ITEM MENU) - (EQ TYPE (CDR (GETDATUM MENU] - then - (SELECTQ MARKING? - ((DELETED DEFINED) - (SETQ UPDATEFILES T) - (Manager.COMSOPEN (CAR (GETDATUM MENU)) - TYPE NIL)) - (Manager.HIGHLIGHT ITEM MENU MARKING?))) - finally - (Manager.MAINUPDATE UPDATEFILES]) + (for WINDOW in MANAGER-OPEN-WINDOWS bind MENU (UPDATEFILES _ NIL) + when [AND (OPENWP WINDOW) + (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] + do (if [AND (Manager.MENUHASITEM ITEM MENU) + (EQ TYPE (CDR (GETDATUM MENU] + then (SELECTQ MARKING? + ((DELETED DEFINED) + (SETQ UPDATEFILES T) + (Manager.COMSOPEN (CAR (GETDATUM MENU)) + TYPE NIL)) + (Manager.HIGHLIGHT ITEM MENU MARKING?))) finally (Manager.MAINUPDATE + UPDATEFILES]) -(Manager.DO.COMMAND -(LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 18-Nov-87 14:30 by raf") (if (EQ COMSTYPE (QUOTE FILEVARS)) then (SETQ COMSTYPE (QUOTE VARS)) (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.")) (SELECTQ COMMAND (NIL (* ; "Do nothing.")) (EDIT (WITH-READER-ENVIRONMENT (if FILE then (Manager.GET.ENVIRONMENT FILE) else (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE* *READ-BASE*)) (* ; "SEdit does not use *package*. ") (COND ((EQ COMSTYPE (QUOTE FILES)) (ED ITEM (QUOTE PROPERTY-LIST))) ((NULL COMSTYPE) (EDITDEF (QUOTE FILELST) (QUOTE VARS))) (T (EDITDEF ITEM COMSTYPE NIL NIL (QUOTE (:DONTWAIT))))))) (ADD.PROCESS (BQUOTE (CL:APPLY (QUOTE (\, (FUNCTION (LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (WITH-READER-ENVIRONMENT (if FILE then (Manager.GET.ENVIRONMENT FILE) else (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE* *READ-BASE*)) (LET ((ACTIVITY-WINDOW NIL) (ACTIVITY-WINDOW-WAS-SHRUNK NIL)) (RESETLST (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) (if (NOT (FMEMB COMMAND (QUOTE (BREAK TRACE UNBREAK CHANGED DELETED DEFINED UNMARK SEE LIST HARDCOPY REMOVE NIL)))) then (* ; "steal the TTY, if we really need it (there are also further complementary lists at the bottom of the following BLOCK).") (TTYDISPLAYSTREAM (SETQ ACTIVITY-WINDOW (Manager.WINDOW))) (SETQ ACTIVITY-WINDOW-WAS-SHRUNK (NOT (OPENWP ACTIVITY-WINDOW)))) (CL:BLOCK NIL (CL:ECASE COMMAND (READVISE (APPLY* (FUNCTION READVISE) ITEM)) (UNADVISE (APPLY* (FUNCTION UNADVISE) ITEM)) (SHOWADVICE (printout T .FONT LAMBDAFONT "Advised and traced fns and functions:" .FONT DEFAULTFONT T) (for ITEM in ADVISEDFNS do (printout T 10 ITEM T))) (RESET (COND ((MOUSECONFIRM "Reset the Manager destroying all the menus? " NIL T) (CL:FORMAT T "Expunging and reconstructing the Manager's menus~%%Please Stand By.") (MANAGER.RESET T) (CL:FORMAT T "~&Done.~%%-----") (CLOSEW T)))) (QUIT (COND ((MOUSECONFIRM "Quit the Manager? " NIL T) (Manager.MAINCLOSE T) (CLOSEW T)))) (RELOAD (CL:FORMAT T "~&Loading ~A definition of ~S from ~A." ITEM COMSTYPE FILE) (LOADDEF ITEM COMSTYPE FILE)) (SHOWDEF (printout T .FONT LAMBDAFONT COMSTYPE " definition of " ITEM .FONT DEFAULTFONT " (source file format):" T) (SHOWDEF ITEM COMSTYPE)) (BREAK (APPLY* (QUOTE BREAK) ITEM)) (TRACE (EVAL (LIST (QUOTE TRACE) ITEM))) (UNBREAK (EVAL (LIST (QUOTE UNBREAK) ITEM))) (DISASSEMBLE (printout T .FONT LAMBDAFONT "Compiled code for " ITEM ":" .FONT DEFAULTFONT T) (INSPECTCODE ITEM)) (PV (printout T .FONT LAMBDAFONT "Value of " ITEM ":" .FONT DEFAULTFONT T (if (BOUNDP ITEM) then (EVAL ITEM) else "Not bound!"))) (PF (printout T .FONT LAMBDAFONT "Function definition of " ITEM ":" .FONT DEFAULTFONT T) (PF ITEM)) (PL (printout T .FONT LAMBDAFONT "Property list for " ITEM ":" .FONT DEFAULTFONT T) (PRINTPROPS (if (EQ COMSTYPE (QUOTE PROPS)) then (CAR ITEM) else ITEM))) (CLDESCRIBE (printout T .FONT LAMBDAFONT "Description of " ITEM ":" .FONT DEFAULTFONT T) (CL:DESCRIBE ITEM)) (CLDOC (printout T .FONT LAMBDAFONT "Documentation for " ITEM ":" .FONT DEFAULTFONT T) (CL:DOCUMENTATION ITEM)) (FIELDS (printout T .FONT LAMBDAFONT "Fields of " ITEM ":" .FONT DEFAULTFONT T (REVERSE (RECORDFIELDNAMES ITEM)))) (ARGS (printout T .FONT LAMBDAFONT "Arguments of " ITEM ": " .FONT DEFAULTFONT T 10 (SMARTARGLIST ITEM) T)) (EDITCALLERS (EDITCALLERS ITEM FILE)) (COPYDEF (LET ((FILENAME (Manager.PROMPT (CONCAT "Rename " ITEM " to: ")))) (if FILENAME then (COPYDEF ITEM FILENAME COMSTYPE)))) (RENAME (LET ((FILENAME (Manager.PROMPT (CONCAT "Rename " ITEM " to: ")))) (if FILENAME then (RENAME ITEM FILENAME COMSTYPE FILE)))) (RENAME-ALL (LET ((FILENAME (Manager.PROMPT (CONCAT "Rename " ITEM " to: ")))) (if FILENAME then (RENAME ITEM FILENAME COMSTYPE FILELST)))) (DELETE (if (MOUSECONFIRM (CONCAT "DELETE the " COMSTYPE " " ITEM " from " FILE "?")) then (DELFROMFILES ITEM COMSTYPE FILE))) (LOAD (LET ((FILENAME (Manager.PROMPT "Filename: "))) (if FILENAME then (LOAD FILENAME)))) (LOADFNSLATER (LET ((FILENAME (Manager.PROMPT "Filename: "))) (if FILENAME then (LOADFNS NIL FILENAME (QUOTE ALLPROP) (QUOTE VARS))))) (LOADFNSNOW (LET ((FILENAME (Manager.PROMPT "Filename: "))) (if FILENAME then (LOADFNS T FILENAME (QUOTE ALLPROP) (QUOTE VARS))))) (LOADFROMLATER (LET ((FILENAME (Manager.PROMPT "Filename: "))) (if FILENAME then (LOADFROM FILENAME)))) (LOADFROMNOW (LET ((FILENAME (Manager.PROMPT "Filename: "))) (if FILENAME then (LOADFROM FILENAME T)))) (ADDFILE (LET ((FILENAME (Manager.PROMPT "Filename: "))) (if FILENAME then (ADDFILE FILENAME)))) (SYSLOAD (COND ((MOUSECONFIRM (CONCAT "Do you really want to SYSLOAD " FILE "?" NIL T)) NIL (LOAD FILE (QUOTE SYSLOAD))))) (MOVE (LET ((ANSWER (Manager.GETFILE (CONCAT "File to move " COMSTYPE " " ITEM " to")))) (AND ANSWER (MOVETOFILE ANSWER ITEM COMSTYPE FILE)))) (COPY (LET ((ANSWER (Manager.GETFILE (CONCAT "File to copy " COMSTYPE " " ITEM " to")))) (AND ANSWER (ADDTOFILE ITEM COMSTYPE ANSWER)))) ((CHANGED DELETED DEFINED) (if COMSTYPE then (MARKASCHANGED ITEM COMSTYPE COMMAND) else (MARKASCHANGED (FILECOMS ITEM) (QUOTE VARS) COMMAND) (UPDATEFILES) (* ; "This is needed because the main menu is a special case. Its not in the open windows list, nor does it carry %"type%" information (like that it contains filevars)."))) (UNMARK (if (EQ COMSTYPE (QUOTE FILES)) then (* ; "whole file") (COND ((MOUSECONFIRM (CONCAT "Unmark entire contents of " FILE "?" NIL T)) (/RPLACD (GETPROP FILE (QUOTE FILE)) NIL) (Manager.insurefilehighlights FILE) (Manager.HIGHLIGHT FILE MENU))) else (* ; "single item") (UNMARKASCHANGED ITEM COMSTYPE))) (SEE (FB.FASTSEE.ONEFILE FILE (LET ((W (CREATEW NIL (CONCAT "Seeing " FILE "...")))) (DSPSCROLL (QUOTE ON) W) (WINDOWPROP W (QUOTE PAGEFULLFN) (QUOTE FB.SEEFULLFN)) (TTYDISPLAYSTREAM W) W))) (LOAD (printout T .FONT LAMBDAFONT "Loading file " FILE "." .FONT DEFAULTFONT T) (LOAD FILE)) ((MAKEFILE NEW FAST) (if FILE then (printout T .FONT LAMBDAFONT "Writing file " FILE "." .FONT DEFAULTFONT T) (PRINT (MAKEFILE FILE (if (EQ COMMAND (QUOTE MAKEFILE)) then NIL else COMMAND)) T) else (printout T .FONT LAMBDAFONT "Writing files ") (PRINT (MAKEFILES (if (EQ COMMAND (QUOTE MAKEFILE)) then NIL else (LIST COMMAND)))) (printout T .FONT DEFAULTFONT T))) (COMMON-MAKEFILE (FILESLOAD (QUOTE COMMON-MAKEFILE)) (if FILE then (printout T .FONT LAMBDAFONT "Writing CommonLisp source into " FILE ".LSP" .FONT DEFAULTFONT T) (PRINT (USER::COMMON-MAKEFILE FILE) T) else (CL:FORMAT T "~&CommonLispify must be selected separately for each file"))) ((LIST HARDCOPY) (LISTFILES1 FILE)) (CLEANUP (printout T .FONT LAMBDAFONT "Cleanup..." .FONT DEFAULTFONT T) (* ; "These are different, presumably because CLEANUP is an NLAMBDA.") (if FILE then (APPLY* (FUNCTION CLEANUP) FILE) else (CLEANUP))) (CLEANUPT (printout T .FONT LAMBDAFONT "Changing default cleanup compiler:" .FONT DEFAULTFONT T "Old value " *DEFAULT-CLEANUP-COMPILER* T "New value: " (SETQ *DEFAULT-CLEANUP-COMPILER* (QUOTE TCOMPL)) T)) (CLEANUPC (printout T .FONT LAMBDAFONT "Changing default cleanup compiler:" .FONT DEFAULTFONT T "Old value " *DEFAULT-CLEANUP-COMPILER* T "New value: " (SETQ *DEFAULT-CLEANUP-COMPILER* (QUOTE COMPILE-FILE)) T)) (* ;; " Masterscope stuff") (ANALYZE (printout T .FONT LAMBDAFONT "Analyzing the file " FILE " with MasterScope..." .FONT DEFAULTFONT T) (MASTERSCOPE (BQUOTE (ANALYZE FNS ON %, FILE)))) (CHECK (printout T .FONT LAMBDAFONT "Checking the file " FILE " with MasterScope..." .FONT DEFAULTFONT T) (MASTERSCOPE (BQUOTE (CHECK %, FILE)))) (DESCRIBE (SELECTQ COMSTYPE (VARS (CL:FORMAT T "~&~a is used by:~%% ~a" ITEM (MASTERSCOPE (BQUOTE (WHO USES (QUOTE (\, ITEM))))))) (PROGN NIL (printout T .FONT LAMBDAFONT "MasterScope analysis of " ITEM ":" .FONT DEFAULTFONT T) (MSDESCRIBE ITEM)))) (SHOWPATHTO (printout T .FONT LAMBDAFONT "Showing who calls " ITEM " with MasterScope..." .FONT DEFAULTFONT T) (MASTERSCOPE (BQUOTE (SHOW PATHS TO %, ITEM)))) (SHOWPATHFROM (printout T .FONT LAMBDAFONT "Showing who is called by " ITEM " with MasterScope..." .FONT DEFAULTFONT T) (MASTERSCOPE (BQUOTE (SHOW PATHS FROM %, ITEM)))) (SHOWPATHFILE (printout T .FONT LAMBDAFONT "Showing who is called by functions in the file " ITEM " with MasterScope..." .FONT DEFAULTFONT T) (MASTERSCOPE (BQUOTE (SHOW PATHS FROM ON %, FILE)))) (* ;; "DATABASEFNS stuff") (DB (FILESLOAD (QUOTE DATABASEFNS)) (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" SAVEDBFLG LOADBFLG)) (DBFILE (FILESLOAD (QUOTE DATABASEFNS)) (CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE (GETPROP FILE (QUOTE DATABASE))) (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" SAVEDBFLG LOADBFLG)) (DBON (FILESLOAD (QUOTE DATABASEFNS)) (SETQ LOADBFLG (QUOTE ON)) (SETQ SAVEDBFLG (QUOTE ON))) (DBOFF (FILESLOAD (QUOTE DATABASEFNS)) (SETQ LOADBFLG (QUOTE OFF)) (SETQ SAVEDBFLG (QUOTE OFF))) (DBASK (FILESLOAD (QUOTE DATABASEFNS)) (SETQ LOADBFLG (QUOTE ASK)) (SETQ SAVEDBFLG (QUOTE ASK))) (DBLOADON (FILESLOAD (QUOTE DATABASEFNS)) (SETQ LOADBFLG (QUOTE ON))) (DBSAVEON (FILESLOAD (QUOTE DATABASEFNS)) (SETQ SAVEDBFLG (QUOTE ON))) (DBLOADOFF (FILESLOAD (QUOTE DATABASEFNS)) (SETQ LOADBFLG (QUOTE OFF))) (DBSAVEOFF (FILESLOAD (QUOTE DATABASEFNS)) (SETQ SAVEDBFLG (QUOTE OFF))) (DBLOADASK (FILESLOAD (QUOTE DATABASEFNS)) (SETQ LOADBFLG (QUOTE ASK))) (DBSAVEASK (FILESLOAD (QUOTE DATABASEFNS)) (SETQ SAVEDBFLG (QUOTE ASK))) (DBFILEON (FILESLOAD (QUOTE DATABASEFNS)) (PUTPROP FILE (QUOTE DATABASE) (QUOTE ON))) (DBFILEOFF (FILESLOAD (QUOTE DATABASEFNS)) (PUTPROP FILE (QUOTE DATABASE) (QUOTE OFF))) (DBFILEASK (FILESLOAD (QUOTE DATABASEFNS)) (PUTPROP FILE (QUOTE DATABASE) (QUOTE ASK))) (DUMPDB (printout T .FONT LAMBDAFONT "Dumping the Masterscope Database for file " FILE .FONT DEFAULTFONT T) (FILESLOAD (QUOTE DATABASEFNS)) (DUMPDB FILE)) (LOADDB (printout T .FONT LAMBDAFONT "Loading the Masterscope Database for file " FILE .FONT DEFAULTFONT T) (FILESLOAD (QUOTE DATABASEFNS)) (LOADDB FILE)) (COMPILE (printout T .FONT LAMBDAFONT "Compiling..." .FONT DEFAULTFONT T) (if (EQ COMSTYPE (QUOTE FILES)) then (APPLY* (FUNCTION COMPILEFILES) FILE) (Manager.REMOVE.DUPLICATE.ADVICE FILE) else (PRINT (CL:COMPILE ITEM) T))) (CL:COMPILE-FILE (printout T .FONT LAMBDAFONT "Compiling using compile-file..." .FONT DEFAULTFONT T) (CL:COMPILE-FILE FILE) (Manager.REMOVE.DUPLICATE.ADVICE FILE)) (REMOVE (DELDEF FILE (QUOTE FILE))) (CHANGES (* ; "FILE is NIL from main menu") (Manager.CHANGED? FILE)) (FILES? (printout T .FONT LAMBDAFONT "Files and their changes:" .FONT DEFAULTFONT T) (FILES?))) (* ;; "Relase the window now, but get ready to shrink it back down unless another manager command comes along and need the window.") (if (NOT (FMEMB COMMAND (QUOTE (BREAK TRACE UNBREAK CHANGED DELETED DEFINED UNMARK SEE LIST HARDCOPY REMOVE QUIT RESET RENAME COPY NIL)))) then (CL:FORMAT T "~&------")))) (* ;; "Shink the dialog window after ten seconds so long as its not in use by another manager command.") (if ACTIVITY-WINDOW-WAS-SHRUNK then (if (FMEMB COMMAND (QUOTE (SHOWDEF SHOWADVICE PV PF PL CLDESCRIBE CLDOC FIELDS ARGS DB DBFILE MAKEFILE NEW FAST COMMON-MAKEFILE CLEANUPT CLEANUPC CLEANUP ANALYZE CHECK DESCRIBE CHANGES FILES? COMPILE CL:COMPILE NIL))) then (DISMISS 10000) else (DISMISS NIL)) (if (EQ ACTIVITY-WINDOW (CAR MANAGER-WINDOWS)) then (SHRINKW T))))))))) (QUOTE ((\, COMMAND) (\, ITEM) (\, COMSTYPE) (\, FILE) (\, MENU))))) (QUOTE NAME) (QUOTE MANAGER-COMMAND))) NIL) -) +(Manager.DO.COMMAND + [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 18-Nov-87 14:30 by raf") + (if (EQ COMSTYPE 'FILEVARS) + then (SETQ COMSTYPE 'VARS) (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.") + ) + (SELECTQ COMMAND + (NIL (* ; "Do nothing.")) + (EDIT (WITH-READER-ENVIRONMENT (if FILE + then (Manager.GET.ENVIRONMENT FILE) + else (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE* + *READ-BASE*)) + (* ; "SEdit does not use *package*. ") + [COND + ((EQ COMSTYPE 'FILES) + (ED ITEM 'PROPERTY-LIST)) + ((NULL COMSTYPE) + (EDITDEF 'FILELST 'VARS)) + (T (EDITDEF ITEM COMSTYPE NIL NIL '(:DONTWAIT])) + (ADD.PROCESS + `[CL:APPLY + ',[FUNCTION (LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) + (WITH-READER-ENVIRONMENT (if FILE + then (Manager.GET.ENVIRONMENT FILE) + else (MAKE-READER-ENVIRONMENT *PACKAGE* + *READTABLE* *READ-BASE*)) + [LET + ((ACTIVITY-WINDOW NIL) + (ACTIVITY-WINDOW-WAS-SHRUNK NIL)) + (RESETLST + (RESETSAVE (TTY.PROCESS (THIS.PROCESS))) + [if [NOT (FMEMB COMMAND + '(BREAK TRACE UNBREAK CHANGED DELETED DEFINED + UNMARK SEE LIST HARDCOPY REMOVE NIL] + then (* ; "steal the TTY, if we really need it (there are also further complementary lists at the bottom of the following BLOCK).") + (TTYDISPLAYSTREAM (SETQ ACTIVITY-WINDOW (Manager.WINDOW))) + (SETQ ACTIVITY-WINDOW-WAS-SHRUNK (NOT (OPENWP + ACTIVITY-WINDOW + ] + (CL:BLOCK NIL + (CL:ECASE COMMAND + (READVISE (APPLY* (FUNCTION READVISE) + ITEM)) + (UNADVISE (APPLY* (FUNCTION UNADVISE) + ITEM)) + (SHOWADVICE + (printout T .FONT LAMBDAFONT + "Advised and traced fns and functions:" .FONT + DEFAULTFONT T) + (for ITEM in ADVISEDFNS + do (printout T 10 ITEM T))) + (RESET (COND + ((MOUSECONFIRM + "Reset the Manager destroying all the menus? " + NIL T) + (CL:FORMAT T + "Expunging and reconstructing the Manager's menus~%%Please Stand By." + ) + (MANAGER.RESET T) + (CL:FORMAT T "~&Done.~%%-----") + (CLOSEW T)))) + (QUIT (COND + ((MOUSECONFIRM "Quit the Manager? " NIL T) + (Manager.MAINCLOSE T) + (CLOSEW T)))) + (RELOAD + (CL:FORMAT T "~&Loading ~A definition of ~S from ~A." + ITEM COMSTYPE FILE) + (LOADDEF ITEM COMSTYPE FILE)) + (SHOWDEF + (printout T .FONT LAMBDAFONT COMSTYPE " definition of " + ITEM .FONT DEFAULTFONT " (source file format):" T + ) + (SHOWDEF ITEM COMSTYPE)) + (BREAK (APPLY* 'BREAK ITEM)) + (TRACE (EVAL (LIST 'TRACE ITEM))) + (UNBREAK (EVAL (LIST 'UNBREAK ITEM))) + (DISASSEMBLE + (printout T .FONT LAMBDAFONT "Compiled code for " ITEM + ":" .FONT DEFAULTFONT T) + (INSPECTCODE ITEM)) + (PV (printout T .FONT LAMBDAFONT "Value of " ITEM ":" .FONT + DEFAULTFONT T (if (BOUNDP ITEM) + then (EVAL ITEM) + else "Not bound!"))) + (PF + (printout T .FONT LAMBDAFONT "Function definition of " + ITEM ":" .FONT DEFAULTFONT T) + (PF ITEM)) + (PL + (printout T .FONT LAMBDAFONT "Property list for " ITEM + ":" .FONT DEFAULTFONT T) + (PRINTPROPS (if (EQ COMSTYPE 'PROPS) + then (CAR ITEM) + else ITEM))) + (CLDESCRIBE + (printout T .FONT LAMBDAFONT "Description of " ITEM ":" + .FONT DEFAULTFONT T) + (CL:DESCRIBE ITEM)) + (CLDOC + (printout T .FONT LAMBDAFONT "Documentation for " ITEM + ":" .FONT DEFAULTFONT T) + (CL:DOCUMENTATION ITEM)) + (FIELDS (printout T .FONT LAMBDAFONT "Fields of " ITEM ":" + .FONT DEFAULTFONT T (REVERSE ( + RECORDFIELDNAMES + ITEM)))) + (ARGS (printout T .FONT LAMBDAFONT "Arguments of " ITEM + ": " .FONT DEFAULTFONT T 10 (SMARTARGLIST + ITEM) + T)) + (EDITCALLERS (EDITCALLERS ITEM FILE)) + (COPYDEF (LET [(FILENAME (Manager.PROMPT (CONCAT "Rename " + ITEM + " to: "] + (if FILENAME + then (COPYDEF ITEM FILENAME COMSTYPE)))) + (RENAME (LET [(FILENAME (Manager.PROMPT (CONCAT "Rename " + ITEM " to: " + ] + (if FILENAME + then (RENAME ITEM FILENAME COMSTYPE FILE)) + )) + (RENAME-ALL (LET [(FILENAME (Manager.PROMPT (CONCAT + "Rename " + ITEM + " to: "] + (if FILENAME + then (RENAME ITEM FILENAME COMSTYPE + FILELST)))) + (DELETE (if (MOUSECONFIRM (CONCAT "DELETE the " COMSTYPE + " " ITEM " from " FILE "?" + )) + then (DELFROMFILES ITEM COMSTYPE FILE))) + (LOAD (LET ((FILENAME (Manager.PROMPT "Filename: "))) + (if FILENAME + then (LOAD FILENAME)))) + (LOADFNSLATER [LET ((FILENAME (Manager.PROMPT "Filename: ") + )) + (if FILENAME + then (LOADFNS NIL FILENAME + 'ALLPROP + 'VARS]) + (LOADFNSNOW [LET ((FILENAME (Manager.PROMPT "Filename: "))) + (if FILENAME + then (LOADFNS T FILENAME 'ALLPROP + 'VARS]) + (LOADFROMLATER (LET ((FILENAME (Manager.PROMPT "Filename: " + ))) + (if FILENAME + then (LOADFROM FILENAME)))) + (LOADFROMNOW (LET ((FILENAME (Manager.PROMPT "Filename: ")) + ) + (if FILENAME + then (LOADFROM FILENAME T)))) + (ADDFILE (LET ((FILENAME (Manager.PROMPT "Filename: "))) + (if FILENAME + then (ADDFILE FILENAME)))) + (SYSLOAD [COND + ((MOUSECONFIRM (CONCAT + "Do you really want to SYSLOAD " + FILE "?" NIL T)) + NIL + (LOAD FILE 'SYSLOAD]) + (MOVE (LET [(ANSWER (Manager.GETFILE (CONCAT + "File to move " + COMSTYPE " " + ITEM " to"] + (AND ANSWER (MOVETOFILE ANSWER ITEM COMSTYPE + FILE)))) + (COPY (LET [(ANSWER (Manager.GETFILE (CONCAT + "File to copy " + COMSTYPE " " + ITEM " to"] + (AND ANSWER (ADDTOFILE ITEM COMSTYPE ANSWER)))) + ((CHANGED DELETED DEFINED) + (if COMSTYPE + then (MARKASCHANGED ITEM COMSTYPE COMMAND) + else (MARKASCHANGED (FILECOMS ITEM) + 'VARS COMMAND) + (UPDATEFILES) + (* ; "This is needed because the main menu is a special case. Its not in the open windows list, nor does it carry %"type%" information (like that it contains filevars).") + )) + (UNMARK (if (EQ COMSTYPE 'FILES) + then (* ; "whole file") + (COND + ((MOUSECONFIRM (CONCAT + "Unmark entire contents of " + FILE "?" NIL T)) + (/RPLACD (GETPROP FILE 'FILE) + NIL) + (Manager.insurefilehighlights FILE) + (Manager.HIGHLIGHT FILE MENU))) + else (* ; "single item") + (UNMARKASCHANGED ITEM COMSTYPE))) + (SEE (FB.FASTSEE.ONEFILE + FILE + (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE "..."] + (DSPSCROLL 'ON W) + (WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN) + (TTYDISPLAYSTREAM W) + W))) + (LOAD + (printout T .FONT LAMBDAFONT "Loading file " FILE "." + .FONT DEFAULTFONT T) + (LOAD FILE)) + ((MAKEFILE NEW FAST) + (if FILE + then (printout T .FONT LAMBDAFONT "Writing file " + FILE "." .FONT DEFAULTFONT T) + (PRINT (MAKEFILE + FILE + (if (EQ COMMAND 'MAKEFILE) + then NIL + else COMMAND)) + T) + else (printout T .FONT LAMBDAFONT "Writing files ") + [PRINT (MAKEFILES + (if (EQ COMMAND 'MAKEFILE) + then NIL + else (LIST COMMAND] + (printout T .FONT DEFAULTFONT T))) + (COMMON-MAKEFILE + (FILESLOAD 'COMMON-MAKEFILE) + (if FILE + then (printout T .FONT LAMBDAFONT + "Writing CommonLisp source into " FILE + ".LSP" .FONT DEFAULTFONT T) + (PRINT (USER::COMMON-MAKEFILE FILE) + T) + else (CL:FORMAT T + "~&CommonLispify must be selected separately for each file" + ))) + ((LIST HARDCOPY) (LISTFILES1 FILE)) + (CLEANUP + (printout T .FONT LAMBDAFONT "Cleanup..." .FONT + DEFAULTFONT T) + (* ; + "These are different, presumably because CLEANUP is an NLAMBDA.") + (if FILE + then (APPLY* (FUNCTION CLEANUP) + FILE) + else (CLEANUP))) + (CLEANUPT (printout T .FONT LAMBDAFONT + "Changing default cleanup compiler:" .FONT + DEFAULTFONT T "Old value " + *DEFAULT-CLEANUP-COMPILER* T "New value: " + (SETQ *DEFAULT-CLEANUP-COMPILER* + 'TCOMPL) + T)) + (CLEANUPC (printout T .FONT LAMBDAFONT + "Changing default cleanup compiler:" .FONT + DEFAULTFONT T "Old value " + *DEFAULT-CLEANUP-COMPILER* T "New value: " + (SETQ *DEFAULT-CLEANUP-COMPILER* + 'COMPILE-FILE) + T)) + + (* ;; " Masterscope stuff") + + (ANALYZE + (printout T .FONT LAMBDAFONT "Analyzing the file " FILE + " with MasterScope..." .FONT DEFAULTFONT T) + (MASTERSCOPE `(ANALYZE FNS ON %, FILE))) + (CHECK + (printout T .FONT LAMBDAFONT "Checking the file " FILE + " with MasterScope..." .FONT DEFAULTFONT T) + (MASTERSCOPE `(CHECK %, FILE))) + (DESCRIBE + (SELECTQ COMSTYPE + (VARS [CL:FORMAT + T "~&~a is used by:~%% ~a" ITEM + (MASTERSCOPE + `(WHO USES ',ITEM]) + (PROGN NIL + (printout T .FONT LAMBDAFONT + "MasterScope analysis of " ITEM ":" + .FONT DEFAULTFONT T) + (MSDESCRIBE ITEM)))) + (SHOWPATHTO + (printout T .FONT LAMBDAFONT "Showing who calls " ITEM + " with MasterScope..." .FONT DEFAULTFONT T) + (MASTERSCOPE `(SHOW PATHS TO %, ITEM))) + (SHOWPATHFROM + (printout T .FONT LAMBDAFONT "Showing who is called by " + ITEM " with MasterScope..." .FONT DEFAULTFONT T) + (MASTERSCOPE `(SHOW PATHS FROM %, ITEM))) + (SHOWPATHFILE + (printout T .FONT LAMBDAFONT + "Showing who is called by functions in the file " + ITEM " with MasterScope..." .FONT DEFAULTFONT T) + (MASTERSCOPE `(SHOW PATHS FROM ON %, FILE))) + + (* ;; "DATABASEFNS stuff") + + (DB + (FILESLOAD 'DATABASEFNS) + (CL:FORMAT T + "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" + SAVEDBFLG LOADBFLG)) + (DBFILE + (FILESLOAD 'DATABASEFNS) + (CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE + (GETPROP FILE 'DATABASE)) + (CL:FORMAT T + "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" + SAVEDBFLG LOADBFLG)) + (DBON + (FILESLOAD 'DATABASEFNS) + (SETQ LOADBFLG 'ON) + (SETQ SAVEDBFLG 'ON)) + (DBOFF + (FILESLOAD 'DATABASEFNS) + (SETQ LOADBFLG 'OFF) + (SETQ SAVEDBFLG 'OFF)) + (DBASK + (FILESLOAD 'DATABASEFNS) + (SETQ LOADBFLG 'ASK) + (SETQ SAVEDBFLG 'ASK)) + (DBLOADON + (FILESLOAD 'DATABASEFNS) + (SETQ LOADBFLG 'ON)) + (DBSAVEON + (FILESLOAD 'DATABASEFNS) + (SETQ SAVEDBFLG 'ON)) + (DBLOADOFF + (FILESLOAD 'DATABASEFNS) + (SETQ LOADBFLG 'OFF)) + (DBSAVEOFF + (FILESLOAD 'DATABASEFNS) + (SETQ SAVEDBFLG 'OFF)) + (DBLOADASK + (FILESLOAD 'DATABASEFNS) + (SETQ LOADBFLG 'ASK)) + (DBSAVEASK + (FILESLOAD 'DATABASEFNS) + (SETQ SAVEDBFLG 'ASK)) + (DBFILEON + (FILESLOAD 'DATABASEFNS) + (PUTPROP FILE 'DATABASE 'ON)) + (DBFILEOFF + (FILESLOAD 'DATABASEFNS) + (PUTPROP FILE 'DATABASE 'OFF)) + (DBFILEASK + (FILESLOAD 'DATABASEFNS) + (PUTPROP FILE 'DATABASE 'ASK)) + (DUMPDB + (printout T .FONT LAMBDAFONT + "Dumping the Masterscope Database for file " FILE + .FONT DEFAULTFONT T) + (FILESLOAD 'DATABASEFNS) + (DUMPDB FILE)) + (LOADDB + (printout T .FONT LAMBDAFONT + "Loading the Masterscope Database for file " FILE + .FONT DEFAULTFONT T) + (FILESLOAD 'DATABASEFNS) + (LOADDB FILE)) + (COMPILE + (printout T .FONT LAMBDAFONT "Compiling..." .FONT + DEFAULTFONT T) + (if (EQ COMSTYPE 'FILES) + then (APPLY* (FUNCTION COMPILEFILES) + FILE) + (Manager.REMOVE.DUPLICATE.ADVICE FILE) + else (PRINT (CL:COMPILE ITEM) + T))) + (CL:COMPILE-FILE + (printout T .FONT LAMBDAFONT + "Compiling using compile-file..." .FONT + DEFAULTFONT T) + (CL:COMPILE-FILE FILE) + (Manager.REMOVE.DUPLICATE.ADVICE FILE)) + (REMOVE (DELDEF FILE 'FILE)) + (CHANGES (* ; "FILE is NIL from main menu") + (Manager.CHANGED? FILE)) + (FILES? + (printout T .FONT LAMBDAFONT "Files and their changes:" + .FONT DEFAULTFONT T) + (FILES?))) + + (* ;; "Relase the window now, but get ready to shrink it back down unless another manager command comes along and need the window.") + + (if [NOT (FMEMB COMMAND + '(BREAK TRACE UNBREAK CHANGED DELETED DEFINED + UNMARK SEE LIST HARDCOPY REMOVE QUIT + RESET RENAME COPY NIL] + then (CL:FORMAT T "~&------")))) + + (* ;; + "Shink the dialog window after ten seconds so long as its not in use by another manager command.") + + (if ACTIVITY-WINDOW-WAS-SHRUNK + then (if (FMEMB COMMAND + '(SHOWDEF SHOWADVICE PV PF PL CLDESCRIBE CLDOC + FIELDS ARGS DB DBFILE MAKEFILE NEW FAST + COMMON-MAKEFILE CLEANUPT CLEANUPC CLEANUP + ANALYZE CHECK DESCRIBE CHANGES FILES? + COMPILE CL:COMPILE NIL)) + then (DISMISS 10000) + else (DISMISS NIL)) + (if (EQ ACTIVITY-WINDOW (CAR MANAGER-WINDOWS)) + then (SHRINKW T])] + '(,COMMAND ,ITEM ,COMSTYPE ,FILE ,MENU] + 'NAME + 'MANAGER-COMMAND)) + NIL]) (Manager.HIGHLIGHT [LAMBDA (ITEM MENU ON) (* ; "Edited 31-Jul-87 17:33 by raf") - - (SHADEITEM (SASSOC ITEM (fetch ITEMS of MENU)) + (SHADEITEM (SASSOC ITEM (fetch ITEMS of MENU)) MENU - (if ON then MANAGER-MARKED-SHADE else 0]) + (if ON + then MANAGER-MARKED-SHADE + else 0]) (Manager.PROMPT [LAMBDA (PROMPT) (* ; "Edited 17-Aug-87 14:31 by raf") - (LET (W (Manager.WINDOW)) (RESETFORM (TTY.PROCESS (THIS.PROCESS)) (PROG1 (MKATOM (PROMPTFORWORD PROMPT NIL NIL W)) @@ -300,12 +962,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "Make a window for manager activity, and set TTYDISPLAYSTREAM into it.") - (LET [(W (OR (pop MANAGER-WINDOWS) + (LET [(W (OR (pop MANAGER-WINDOWS) (CREATEW NIL MANAGER-ACTIVITY-WINDOW-TITLE] (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (W) (AND (OPENWP W) (TERPRI W)) - (push MANAGER-WINDOWS W] + (push MANAGER-WINDOWS W] W)) (TTYDISPLAYSTREAM W) W]) @@ -314,35 +976,23 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu [LAMBDA (FILE) (* ; "Edited 26-Jun-87 16:30 by andyiii") (* ;  "insures open menus of a file are correctly highlighted") - (SETQ FILE (ROOTFILENAME FILE)) - (for WINDOW in MANAGER-OPEN-WINDOWS bind MENU when - (AND (OPENWP WINDOW) - (EQ [CAR (GETDATUM (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] - FILE)) - do - [if (EQUAL (Manager.COLLECTCOMS FILE (CDR (GETDATUM MENU))) - (fetch (MENU ITEMS) - of MENU)) - then - (Manager.COMSUPDATE WINDOW) (* ; "no change in contents") - - else - (Manager.COMSOPEN FILE (CDR (GETDATUM MENU] (* ; "contents changed") - - ]) + (for WINDOW in MANAGER-OPEN-WINDOWS bind MENU + when (AND (OPENWP WINDOW) + (EQ [CAR (GETDATUM (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] + FILE)) do [if (EQUAL (Manager.COLLECTCOMS FILE (CDR (GETDATUM MENU))) + (fetch (MENU ITEMS) of MENU)) + then (Manager.COMSUPDATE WINDOW) + (* ; "no change in contents") + else (Manager.COMSOPEN FILE (CDR (GETDATUM MENU] + (* ; "contents changed")]) (Manager.CHANGED? [LAMBDA (FILES) (* ; "Edited 26-Jun-87 03:42 by andyiii") - - (bind CHANGES for FILE inside (OR FILES FILELST) - first - (TERPRI T) - when - [SETQ CHANGES (CDR (GETPROP FILE 'FILE] - do - (printout T .FONT LAMBDAFONT "Changes to " FILE .FONT DEFAULTFONT T) - (for CHANGE in CHANGES do (printout T (CAR CHANGE) + (bind CHANGES for FILE inside (OR FILES FILELST) first (TERPRI T) + when [SETQ CHANGES (CDR (GETPROP FILE 'FILE] + do (printout T .FONT LAMBDAFONT "Changes to " FILE .FONT DEFAULTFONT T) + (for CHANGE in CHANGES do (printout T (CAR CHANGE) ":" 10 .PARA 10 0 (CDR CHANGE) T]) @@ -351,22 +1001,18 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "If called from ADDTOFILES? (special flag indicates this) and the file being checked is on the main menu, checks all of a particular FILE's submenus, otherwise rebuilds the main (FILELST) menu. Called from advice on ADDFILE, ADDTOFILES? and LOAD.") - (if (AND (NULL MANAGER-ADDTOFILES?) + (if (AND (NULL MANAGER-ADDTOFILES?) (Manager.MENUHASITEM FILE MANAGER-FILE-MENU)) - then - (SETQ FILE (ROOTFILENAME FILE)) - [for WINDOW in MANAGER-OPEN-WINDOWS bind MENU when - [AND (OPENWP WINDOW) - (EQ [CAR (GETDATUM (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] - FILE) - (NOT (EQUAL (Manager.COLLECTCOMS FILE (CDR (GETDATUM MENU))) - (fetch (MENU ITEMS) - of MENU] - do - (Manager.COMSOPEN FILE (CDR (GETDATUM MENU] - else - (MANAGER) - (Manager.RESETSUBITEMS FILE]) + then (SETQ FILE (ROOTFILENAME FILE)) + [for WINDOW in MANAGER-OPEN-WINDOWS bind MENU + when [AND (OPENWP WINDOW) + (EQ [CAR (GETDATUM (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] + FILE) + (NOT (EQUAL (Manager.COLLECTCOMS FILE (CDR (GETDATUM MENU))) + (fetch (MENU ITEMS) of MENU] + do (Manager.COMSOPEN FILE (CDR (GETDATUM MENU] + else (MANAGER) + (Manager.RESETSUBITEMS FILE]) (Manager.COLLECTCOMS [LAMBDA (FILE TYPE) (* ; "Edited 16-Aug-87 22:13 by raf") @@ -379,36 +1025,31 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu ((NULL COMSLST) (RETURN)) ((EQ TYPE 'VARS) - (for VAR in COMSLST bind (FILEVARS _ (FILECOMSLST - FILE - 'FILEVARS)) - when - (NOT (FMEMB VAR FILEVARS)) - collect - - (* ;; "List of item to get around menu feature that list's first item is used for display.") + (for VAR in COMSLST + bind (FILEVARS _ (FILECOMSLST FILE 'FILEVARS)) + when (NOT (FMEMB VAR FILEVARS)) + collect - (LIST VAR))) + (* ;; + "List of item to get around menu feature that list's first item is used for display.") + + (LIST VAR))) (T - - (* ;; "List of item to get around menu feature that list's first item is used for display.") + (* ;; + "List of item to get around menu feature that list's first item is used for display.") (MAPCAR (INTERSECTION COMSLST COMSLST) (FUNCTION LIST]) (Manager.COMS.WSF [LAMBDA (ITEM MENU KEY) (* ; "Edited 25-Jun-87 02:00 by andyiii") - (SETQ ITEM (CAR ITEM)) (* ; "Menu items handed in are list of item to get around menu feature that list has first item used to display!") - (PROG (FILE COMSTYPE COMSLST FILECOMS COMMAND) - (DECLARE (SPECVARS ITEM COMSTYPE)) - (if (NULL ITEM) - then - (RETURN)) - (if (.COPYKEYDOWNP.) - then - (RETURN (BKSYSBUF.GENERAL ITEM))) + (DECLARE (SPECVARS ITEM COMSTYPE)) + (if (NULL ITEM) + then (RETURN)) + (if (.COPYKEYDOWNP.) + then (RETURN (BKSYSBUF.GENERAL ITEM))) (SETQ COMSLST (GETDATUM MENU)) (SETQ FILE (CAR COMSLST)) (SETQ COMSTYPE (CDR COMSLST)) @@ -417,24 +1058,31 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (LEFT [OR (GETPROP COMSTYPE 'MANAGER-ITEM-OPERATION-MENU) [AND (GETPROP COMSTYPE 'MANAGER-DEFINITION-TYPE-COMMANDS) (PUTPROP COMSTYPE 'MANAGER-ITEM-OPERATION-MENU - (create MENU ITEMS _ (APPEND - MANAGER-ITEM-OPERATION-COMMANDS - (GETPROP COMSTYPE ' + (create MENU + ITEMS _ (APPEND MANAGER-ITEM-OPERATION-COMMANDS + (GETPROP COMSTYPE + ' MANAGER-DEFINITION-TYPE-COMMANDS - )) - CENTERFLG _ T TITLE _ (CONCAT COMSTYPE - " operations") + )) + CENTERFLG _ T + TITLE _ (CONCAT COMSTYPE " operations") CHANGEOFFSETFLG _ 'Y] MANAGER-ITEM-OPERATION-MENU (SETQ MANAGER-ITEM-OPERATION-MENU - (create MENU ITEMS _ MANAGER-ITEM-OPERATION-COMMANDS CENTERFLG _ T + (create MENU + ITEMS _ MANAGER-ITEM-OPERATION-COMMANDS + CENTERFLG _ T TITLE _ (CONCAT COMSTYPE " operations") CHANGEOFFSETFLG _ 'Y]) (MIDDLE (OR MANAGER-ITEM-FILE-RELATION-MENU - (create MENU ITEMS _ MANAGER-ITEM-FILE-RELATION-COMMANDS CENTERFLG _ - T TITLE _ "Other operations" CHANGEOFFSETFLG _ 'Y))) + (create MENU + ITEMS _ MANAGER-ITEM-FILE-RELATION-COMMANDS + CENTERFLG _ T + TITLE _ "Other operations" + CHANGEOFFSETFLG _ 'Y))) (SHOULDNT] - (if COMMAND then (Manager.DO.COMMAND COMMAND ITEM COMSTYPE FILE]) + (if COMMAND + then (Manager.DO.COMMAND COMMAND ITEM COMSTYPE FILE]) (Manager.COMSOPEN [LAMBDA (FILE TYPE FLASHFLG) (* ; "Edited 16-Aug-87 22:30 by raf") @@ -447,41 +1095,44 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (COND [COMSLST (COND ([AND (SETQ MENU (GETDATUM COMSTYPE)) - (EQUAL (fetch (MENU ITEMS) - of MENU) + (EQUAL (fetch (MENU ITEMS) of MENU) COMSLST) (SETQ WINDOW (OR (WFROMMENU MENU) - (for W in MANAGER-OPEN-WINDOWS thereis - (EQ (WINDOWPROP W 'COMSTYPE) - COMSTYPE] + (for W in MANAGER-OPEN-WINDOWS + thereis (EQ (WINDOWPROP W 'COMSTYPE) + COMSTYPE] (COND (FLASHFLG (FLASHWINDOW WINDOW 2)) (T (TOTOPW WINDOW))) (Manager.INSUREHIGHLIGHTS MENU (Manager.FILECHANGES FILE TYPE))) (T - - (* ;; "make sure all the title is visible. This is hard since the menu does not exist yet.") + (* ;; + "make sure all the title is visible. This is hard since the menu does not exist yet.") - (SETQ MENU (create MENU ITEMS _ COMSLST MENUCOLUMNS _ ( - Manager.MENUCOLUMNS - COMSLST) + (SETQ MENU (create MENU + ITEMS _ COMSLST + MENUCOLUMNS _ (Manager.MENUCOLUMNS COMSLST) WHENSELECTEDFN _ (FUNCTION Manager.COMS.WSF) MENUOUTLINESIZE _ 0)) (COND ((SETQ WINDOW (WFROMMENU (GETDATUM COMSTYPE))) - (SETQ POSITION (with REGION (WINDOWPROP WINDOW 'REGION) - (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM)) - ) + (SETQ POSITION (with REGION (WINDOWPROP WINDOW 'REGION) + (create POSITION + XCOORD _ LEFT + YCOORD _ BOTTOM))) (CLOSEW WINDOW))) [ADDMENU MENU (SETQ WINDOW - (CREATEW [with MENU MENU + (CREATEW [with MENU MENU (LET ((IW (WIDTHIFWINDOW IMAGEWIDTH)) (IH (HEIGHTIFWINDOW IMAGEHEIGHT T))) - (with POSITION (OR POSITION (GETBOXPOSITION + (with POSITION (OR POSITION (GETBOXPOSITION IW IH)) - (create REGION LEFT _ XCOORD WIDTH _ IW - BOTTOM _ YCOORD HEIGHT _ IH] + (create REGION + LEFT _ XCOORD + WIDTH _ IW + BOTTOM _ YCOORD + HEIGHT _ IH] (CONCAT TYPE " on " FILE] [WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW) [PUTDATUM @@ -493,12 +1144,11 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (SETQ MANAGER-OPEN-WINDOWS (DREMOVE WINDOW MANAGER-OPEN-WINDOWS] - (for ITEM in (Manager.FILECHANGES FILE TYPE) - do - (Manager.HIGHLIGHT ITEM MENU T)) + (for ITEM in (Manager.FILECHANGES FILE TYPE) + do (Manager.HIGHLIGHT ITEM MENU T)) (PUTDATUM COMSTYPE MENU) (PUTDATUM MENU (CONS FILE TYPE)) - (push MANAGER-OPEN-WINDOWS WINDOW) + (push MANAGER-OPEN-WINDOWS WINDOW) (WINDOWPROP WINDOW 'COMSTYPE COMSTYPE] ((SETQ WINDOW (WFROMMENU (GETDATUM COMSTYPE))) (CLOSEW WINDOW]) @@ -515,56 +1165,45 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (SETQ CHANGELST (Manager.FILECHANGES FILE TYPE)) [COND [(NULL (OPENWP WINDOW)) - (if (OPENWP (WINDOWPROP WINDOW 'ICONWINDOW)) - then - (EXPANDW (WINDOWPROP WINDOW 'ICONWINDOW] - (T (if FLASHFLG then (FLASHWINDOW WINDOW 2) - else - (TOTOPW WINDOW] + (if (OPENWP (WINDOWPROP WINDOW 'ICONWINDOW)) + then (EXPANDW (WINDOWPROP WINDOW 'ICONWINDOW] + (T (if FLASHFLG + then (FLASHWINDOW WINDOW 2) + else (TOTOPW WINDOW] (COND - ((EQUAL (fetch (MENU ITEMS) - of MENU) + ((EQUAL (fetch (MENU ITEMS) of MENU) (Manager.COLLECTCOMS FILE TYPE)) (Manager.INSUREHIGHLIGHTS MENU CHANGELST)) (T (Manager.COMSOPEN FILE TYPE]) (Manager.HIGHLIGHTED [LAMBDA (MENU) (* ; "Edited 9-Jul-87 13:57 by raf") - - (for X in (fetch (MENU SHADEDITEMS) - of MENU) - collect - (CAR (CAR (NTH (fetch (MENU ITEMS) - of MENU) - (CAR X]) + (for X in (fetch (MENU SHADEDITEMS) of MENU) + collect (CAR (CAR (NTH (fetch (MENU ITEMS) of MENU) + (CAR X]) (Manager.INSUREHIGHLIGHTS [LAMBDA (MENU SHOULD-BE-HIGHLIGHTED) (* ; "Edited 26-Jun-87 18:10 by andyiii") - (LET ((HIGH (Manager.HIGHLIGHTED MENU))) - (if (WFROMMENU MENU) - then - (REDISPLAYW (WFROMMENU MENU))) - (for ITEM in HIGH when (NOT (FMEMB ITEM SHOULD-BE-HIGHLIGHTED)) - do - (Manager.HIGHLIGHT ITEM MENU NIL)) - (for ITEM in SHOULD-BE-HIGHLIGHTED when (NOT (FMEMB ITEM HIGH)) - do - (Manager.HIGHLIGHT ITEM MENU T]) + (if (WFROMMENU MENU) + then (REDISPLAYW (WFROMMENU MENU))) + (for ITEM in HIGH when (NOT (FMEMB ITEM SHOULD-BE-HIGHLIGHTED)) + do (Manager.HIGHLIGHT ITEM MENU NIL)) + (for ITEM in SHOULD-BE-HIGHLIGHTED when (NOT (FMEMB ITEM HIGH)) + do (Manager.HIGHLIGHT ITEM MENU T]) (Manager.FILECHANGES [LAMBDA (FILE COMSTYPE) (* ; "Edited 26-Jun-87 04:35 by andyiii") - - (CDR (FASSOC (if (EQ COMSTYPE 'FILEVARS) - then - 'VARS else COMSTYPE) + (CDR (FASSOC (if (EQ COMSTYPE 'FILEVARS) + then 'VARS + else COMSTYPE) (CDR (GETPROP FILE 'FILE]) (Manager.FILELSTCHANGED? [LAMBDA NIL (* ; "Edited 17-Aug-87 14:16 by raf") - - (NOT (EQUAL (if Manager.SORTFILELSTFLG then (SORT (COPY FILELST)) - else FILELST) + (NOT (EQUAL (if Manager.SORTFILELSTFLG + then (SORT (COPY FILELST)) + else FILELST) (Manager.MENUITEMS MANAGER-FILE-MENU]) (Manager.FILESUBTYPES @@ -572,69 +1211,63 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "Gather the names of all subtypes in a file's coms.") - (for TYPE in FILEPKGTYPES bind COMSLST when - (AND (NOT (FMEMB TYPE *UNMANAGED-TYPES*)) - (SETQ COMSLST (FILECOMSLST FILE TYPE)) - (if (EQ TYPE 'VARS) - then - (for VAR in COMSLST bind (FILEVARS _ (FILECOMSLST FILE 'FILEVARS)) - thereis - (NOT (FMEMB VAR FILEVARS))) - else T)) - collect TYPE]) + (for TYPE in FILEPKGTYPES bind COMSLST + when (AND (NOT (FMEMB TYPE *UNMANAGED-TYPES*)) + (SETQ COMSLST (FILECOMSLST FILE TYPE)) + (if (EQ TYPE 'VARS) + then (for VAR in COMSLST bind (FILEVARS _ (FILECOMSLST FILE 'FILEVARS)) + thereis (NOT (FMEMB VAR FILEVARS))) + else T)) collect TYPE]) (Manager.GET.ENVIRONMENT [LAMBDA (FILE) (* ; "Edited 26-Jun-87 18:53 by andyiii") - - (* ;; "Get's a file's environment, either from the cache in the makefile-environment property (which we initialize here if it hasn't been already) or as per the defaulting described in the Lyric release notes:") - - (* ;; "cache property exists? use it,") - - (* ;; "new file? use *DEFAULT-MAKEFILE-ENVIRONMENT*,") - - (* ;; "old file which has environment in it? use environment from old file,") - - (* ;; "otherwise use an interlisp style environment.") + + (* ;; "Get's a file's environment, either from the cache in the makefile-environment property (which we initialize here if it hasn't been already) or as per the defaulting described in the Lyric release notes:") + + (* ;; "cache property exists? use it,") + + (* ;; "new file? use *DEFAULT-MAKEFILE-ENVIRONMENT*,") + + (* ;; "old file which has environment in it? use environment from old file,") + + (* ;; "otherwise use an interlisp style environment.") (LET [(ENVIRONMENT (OR (GETPROP FILE 'MAKEFILE-ENVIRONMENT) (PUTPROP FILE 'MAKEFILE-ENVIRONMENT (LET ((DATE (FILEDATE FILE))) - (if (NULL DATE) - then *DEFAULT-MAKEFILE-ENVIRONMENT* else - (LET [(FORM (CL:WITH-OPEN-FILE (STREAM (OR (FINDFILE FILE) - (CL:ERROR - "Can't find file ~s to get its environment" - FILE))) - (LET ((*READTABLE* (FIND-READTABLE "OLD-INTERLISP-FILE" - )) - (*PACKAGE* (CL:FIND-PACKAGE "INTERLISP"))) - (CL:READ STREAM] - (if (EQ 'DEFINE-FILE-INFO (CAR FORM)) - then - (CDR FORM) - else - '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10] + (if (NULL DATE) + then *DEFAULT-MAKEFILE-ENVIRONMENT* + else (LET [(FORM (CL:WITH-OPEN-FILE (STREAM (OR (FINDFILE FILE) + (CL:ERROR + "Can't find file ~s to get its environment" + FILE))) + (LET ((*READTABLE* (FIND-READTABLE + "OLD-INTERLISP-FILE")) + (*PACKAGE* (CL:FIND-PACKAGE "INTERLISP"))) + (CL:READ STREAM] + (if (EQ 'DEFINE-FILE-INFO (CAR FORM)) + then (CDR FORM) + else '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10] (APPLY #'MAKE-READER-ENVIRONMENT (CL:MAPCAR #'[LAMBDA (KEY TYPE COERCE) (LET [(VALUE (EVAL (CL:GETF ENVIRONMENT KEY] - (if (TYPEP VALUE TYPE) - then VALUE else (CL:FUNCALL COERCE - VALUE] + (if (TYPEP VALUE TYPE) + then VALUE + else (CL:FUNCALL COERCE VALUE] '(:PACKAGE :READTABLE :BASE) '(PACKAGE CL:READTABLE INTEGER) '(CL:FIND-PACKAGE FIND-READTABLE CL:IDENTITY]) (Manager.GETFILE [LAMBDA (PROMPT PASSED-IN-FILE-LIST) (* ; "Edited 17-Aug-87 14:32 by raf") - (LET ((FILE-LIST (OR PASSED-IN-FILE-LIST FILELST))) [COND ((OR (NULL (CAR MANAGER-FILELST-MENU)) (Manager.FILELSTCHANGED?)) (* ; "what is this doing ???") - - (SETQ MANAGER-FILELST-MENU (create MENU TITLE _ PROMPT ITEMS _ (CONS '*newfile* - FILE-LIST) + (SETQ MANAGER-FILELST-MENU (create MENU + TITLE _ PROMPT + ITEMS _ (CONS '*newfile* FILE-LIST) WHENSELECTEDFN _ (FUNCTION (LAMBDA (ITEM MENU KEY) (PROG (ANSWER FILECOMS) (COND @@ -656,36 +1289,34 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (MENU MANAGER-FILELST-MENU]) (Manager.INTITLE? - [LAMBDA (WINDOW) (* edited%: "31-Dec-00 16:40") + [LAMBDA (WINDOW) (* edited%: "31-Dec-00 16:40") (PROG (INTERIOR.HEIGHT REGION MENU) [SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] - (SETQ INTERIOR.HEIGHT (FONTPROP (OR (fetch MENUTITLEFONT of MENU) - (fetch MENUFONT of MENU)) + (SETQ INTERIOR.HEIGHT (FONTPROP (OR (fetch MENUTITLEFONT of MENU) + (fetch MENUFONT of MENU)) 'HEIGHT)) - (with REGION (WINDOWPROP WINDOW 'REGION) + (with REGION (WINDOWPROP WINDOW 'REGION) (SETQ REGION (CREATEREGION LEFT (IDIFFERENCE TOP INTERIOR.HEIGHT) WIDTH INTERIOR.HEIGHT))) (RETURN (INSIDEP REGION LASTMOUSEX LASTMOUSEY]) (Manager.MAIN.WSF [LAMBDA (ITEM MENU KEY) - (DECLARE (SPECVARS ITEM)) (* ; "Edited 31-Jul-87 18:25 by raf") - + (DECLARE (SPECVARS ITEM)) (* ; "Edited 31-Jul-87 18:25 by raf") (PROG NIL - [if (.COPYKEYDOWNP.) - then - (RETURN (COPYINSERT (CAR ITEM] + [if (.COPYKEYDOWNP.) + then (RETURN (COPYINSERT (CAR ITEM] (LET ((SLIDEOFFITEM (EQLENGTH ITEM 3))) (* ; "A slideoff subitem was selected.") - (SETQ ITEM (CADR ITEM)) (SELECTQ KEY (MIDDLE (COND ((NOT SLIDEOFFITEM) (Manager.DO.COMMAND [MENU (OR MANAGER-FILE-FILE-RELATION-MENU - (create MENU ITEMS _ - MANAGER-FILE-FILE-RELATION-COMMANDS - CENTERFLG _ T TITLE _ - "Other operations" + (create MENU + ITEMS _ + MANAGER-FILE-FILE-RELATION-COMMANDS + CENTERFLG _ T + TITLE _ "Other operations" CHANGEOFFSETFLG _ 'Y] (CAR ITEM) 'FILES @@ -698,13 +1329,13 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (CDR ITEM) T)) (T (* ; "Standard selection.") - (Manager.DO.COMMAND [MENU (OR MANAGER-FILE-OPERATIONS-MENU (SETQ MANAGER-FILE-OPERATIONS-MENU - (create MENU ITEMS _ - MANAGER-FILE-OPERATIONS-COMMANDS - CENTERFLG _ T TITLE _ - "File operations"] + (create MENU + ITEMS _ + MANAGER-FILE-OPERATIONS-COMMANDS + CENTERFLG _ T + TITLE _ "File operations"] (CAR ITEM) 'FILES (CAR ITEM) @@ -714,108 +1345,108 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (Manager.MAINCLOSE [LAMBDA (SHUTDOWNFLG) (* ; "Edited 20-Aug-87 16:18 by raf") - (PROG (MENU ICON.WINDOW) - (for WINDOW in (APPEND MANAGER-OPEN-WINDOWS) - when - (OR SHUTDOWNFLG (NOT (FMEMB [CAR (GETDATUM (CAR (WINDOWPROP WINDOW 'MENU] - FILELST))) - do - (CLOSEW WINDOW)) - (if (SETQ ICON.WINDOW (WINDOWPROP MANAGER-MAIN-WINDOW 'ICON)) - then - (CLOSEW ICON.WINDOW)) - (if SHUTDOWNFLG then (if (SETQ ICON.WINDOW (WINDOWPROP MANAGER-MAIN-WINDOW 'ICON)) - then - (CLOSEW ICON.WINDOW)) - (AND MANAGER-MAIN-WINDOW (CLOSEW MANAGER-MAIN-WINDOW)) - (SETQ MANAGER-MAIN-WINDOW NIL)) - (for WINDOW in MANAGER-WINDOWS do (if SHUTDOWNFLG then (EXPANDW WINDOW)) - (CLOSEW WINDOW)) - (if SHUTDOWNFLG then (SETQ MANAGER-WINDOWS NIL]) + (for WINDOW in (APPEND MANAGER-OPEN-WINDOWS) + when (OR SHUTDOWNFLG (NOT (FMEMB [CAR (GETDATUM (CAR (WINDOWPROP WINDOW 'MENU] + FILELST))) do (CLOSEW WINDOW)) + (if (SETQ ICON.WINDOW (WINDOWPROP MANAGER-MAIN-WINDOW 'ICON)) + then (CLOSEW ICON.WINDOW)) + (if SHUTDOWNFLG + then (if (SETQ ICON.WINDOW (WINDOWPROP MANAGER-MAIN-WINDOW 'ICON)) + then (CLOSEW ICON.WINDOW)) + (AND MANAGER-MAIN-WINDOW (CLOSEW MANAGER-MAIN-WINDOW)) + (SETQ MANAGER-MAIN-WINDOW NIL)) + (for WINDOW in MANAGER-WINDOWS do (if SHUTDOWNFLG + then (EXPANDW WINDOW)) + (CLOSEW WINDOW)) + (if SHUTDOWNFLG + then (SETQ MANAGER-WINDOWS NIL]) (Manager.MAINMENUITEMS [LAMBDA NIL (* ; "Edited 17-Aug-87 14:14 by raf") (* ;;; "Returns the menu 'items' for the main manager file menu. This is, for each file, the menu element and the subitems which contain all of the 'types' . If there is already a file menu, we reuse the subitems rather than recomputing them.") - (for FILE in (if Manager.SORTFILELSTFLG then (SORT (COPY FILELST)) - else FILELST) - collect - `(%, FILE (%, FILE . FILEVARS) - %, - (CONCAT "Brings up a File Operations menu for the file " FILE) - (SUBITEMS %,@ (for TYPE in (SORT (Manager.FILESUBTYPES FILE)) - collect - `(%, TYPE (%, FILE %,@ TYPE) - %, - (CONCAT "Creates a " TYPE " submenu for the file " FILE]) + (for FILE in (if Manager.SORTFILELSTFLG + then (SORT (COPY FILELST)) + else FILELST) + collect `(%, FILE (%, FILE . FILEVARS) + %, + (CONCAT "Brings up a File Operations menu for the file " FILE) + (SUBITEMS %,@ (for TYPE in (SORT (Manager.FILESUBTYPES FILE)) + collect `(%, TYPE (%, FILE %,@ TYPE) + %, + (CONCAT "Creates a " TYPE " submenu for the file " + FILE]) (Manager.MAINOPEN [LAMBDA (POSITION) (* ; "Edited 17-Aug-87 13:59 by raf") (* ;;; "Builds the manager main (FILELST) menu at the indicated position.") - (SETQ MANAGER-FILE-MENU (create MENU ITEMS _ (Manager.MAINMENUITEMS) + (SETQ MANAGER-FILE-MENU (create MENU + ITEMS _ (Manager.MAINMENUITEMS) WHENSELECTEDFN _ (FUNCTION Manager.MAIN.WSF) - MENUCOLUMNS _ 1 MENUOUTLINESIZE _ 0)) + MENUCOLUMNS _ 1 + MENUOUTLINESIZE _ 0)) (LET (IW IH) - - (* ;; "some of the complexity here is so that, in the odd case that there are more files than will fit on the screen, the result will be a scrollable window") + + (* ;; "some of the complexity here is so that, in the odd case that there are more files than will fit on the screen, the result will be a scrollable window") (ADDMENU MANAGER-FILE-MENU (SETQ MANAGER-MAIN-WINDOW - (CREATEW (with POSITION - (with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW IMAGEWIDTH) + (CREATEW (with POSITION + (with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW IMAGEWIDTH) SCREENWIDTH)) (* ;  "width of file menu. Actually unlikely to be wider than screenwidth (!)") - (SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T) SCREENHEIGHT)) (* ;  "height of window; could possibly be higher than screen if lots of files") - - (if (POSITIONP POSITION) - then (* ; + (if (POSITIONP POSITION) + then (* ;  "gave an initial position for the manager file menu") - - POSITION elseif (WINDOWP MANAGER-MAIN-WINDOW) - then (* ; + POSITION + elseif (WINDOWP MANAGER-MAIN-WINDOW) + then (* ;  "if there was a window, put the new one in the same place (and close the old one)") - - (PROG1 (with REGION (WINDOWPROP MANAGER-MAIN-WINDOW - 'REGION) - (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM - )) - (CLOSEW MANAGER-MAIN-WINDOW)) - else (* ; + (PROG1 (with REGION (WINDOWPROP MANAGER-MAIN-WINDOW + 'REGION) + (create POSITION + XCOORD _ LEFT + YCOORD _ BOTTOM)) + (CLOSEW MANAGER-MAIN-WINDOW)) + else (* ;  "let user say where to put the menu") - - (GETBOXPOSITION IW IH))) - (create REGION LEFT _ XCOORD WIDTH _ IW BOTTOM _ YCOORD HEIGHT _ IH)) + (GETBOXPOSITION IW IH))) + (create REGION + LEFT _ XCOORD + WIDTH _ IW + BOTTOM _ YCOORD + HEIGHT _ IH)) "Manager"))) [WINDOWPROP MANAGER-MAIN-WINDOW 'BUTTONEVENTFN (FUNCTION (LAMBDA (WINDOW) - (if (Manager.INTITLE? WINDOW) - then - [Manager.DO.COMMAND (MENU (OR MANAGER-MAIN-MENU - (SETQ MANAGER-MAIN-MENU - (create MENU TITLE _ - "Manager operations" ITEMS _ - MANAGER-MAIN-MENU-ITEMS - CENTERFLG _ T] - else - (MENUBUTTONFN WINDOW] - - (* ;; "Shrink to the manager icon, and remember to update when the expanding") + (if (Manager.INTITLE? WINDOW) + then [Manager.DO.COMMAND (MENU (OR MANAGER-MAIN-MENU + (SETQ MANAGER-MAIN-MENU + (create MENU + TITLE _ + "Manager operations" + ITEMS _ + MANAGER-MAIN-MENU-ITEMS + CENTERFLG _ T] + else (MENUBUTTONFN WINDOW] + + (* ;; "Shrink to the manager icon, and remember to update when the expanding") [WINDOWPROP MANAGER-MAIN-WINDOW 'ICONFN (FUNCTION (LAMBDA (WIN OICON) - (LET ((IW (if (NULL OICON) - then - (ICONW MANAGER.BM - MANAGER.BM.MASK) - else OICON))) + (LET ((IW (if (NULL OICON) + then (ICONW MANAGER.BM + MANAGER.BM.MASK + ) + else OICON))) [WINDOWPROP IW 'EXPANDFN (FUNCTION (LAMBDA NIL ( @@ -830,14 +1461,11 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "Updates the highlighting of the main (FILELST) menu. Does not handle adding or removing of names from FILELST. Typically called after Manager.ALTERMARKING.") - (if (NOT FROMUPDATE) - then - (LET ((Manager.ACTIVEFLG NIL)) - (UPDATEFILES))) - (Manager.INSUREHIGHLIGHTS MANAGER-FILE-MENU (for ITEM in (Manager.MENUITEMS MANAGER-FILE-MENU) - when - (CDR (GETPROP ITEM 'FILE)) - collect ITEM]) + (if (NOT FROMUPDATE) + then (LET ((Manager.ACTIVEFLG NIL)) + (UPDATEFILES))) + (Manager.INSUREHIGHLIGHTS MANAGER-FILE-MENU (for ITEM in (Manager.MENUITEMS MANAGER-FILE-MENU) + when (CDR (GETPROP ITEM 'FILE)) collect ITEM]) (Manager.MAKEFILE.ADV [LAMBDA (FILE OPTIONS) (* ; "Edited 20-Aug-87 15:04 by raf") @@ -845,82 +1473,64 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (* ;;; "After MAKEFILE(FILE), clear out all of file's marks") (LET ((OPTIONS (OR OPTIONS CLEANUPOPTIONS))) - (if [if (LISTP OPTIONS) - then - (INTERSECTION '(ST STF) OPTIONS) - else - (FMEMB OPTIONS '(ST STF] - then (* ; + (if [if (LISTP OPTIONS) + then (INTERSECTION '(ST STF) + OPTIONS) + else (FMEMB OPTIONS '(ST STF] + then (* ;  "If we stored definitions (I.E. advice) remove duplicate advice.") - - (Manager.REMOVE.DUPLICATE.ADVICE FILE))) - (bind MENU (FILENAME _ (ROOTFILENAME FILE)) - for WINDOW in MANAGER-OPEN-WINDOWS when - (AND (OPENWP WINDOW) - (EQ [CAR (GETDATUM (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] - FILENAME)) - do - (Manager.INSUREHIGHLIGHTS MENU NIL) - finally - (Manager.HIGHLIGHT FILENAME MANAGER-FILE-MENU NIL]) + (Manager.REMOVE.DUPLICATE.ADVICE FILE))) + (bind MENU (FILENAME _ (ROOTFILENAME FILE)) for WINDOW in MANAGER-OPEN-WINDOWS + when (AND (OPENWP WINDOW) + (EQ [CAR (GETDATUM (SETQ MENU (CAR (WINDOWPROP WINDOW 'MENU] + FILENAME)) do (Manager.INSUREHIGHLIGHTS MENU NIL) + finally (Manager.HIGHLIGHT FILENAME MANAGER-FILE-MENU NIL]) (Manager.MENUCOLUMNS [LAMBDA (ITEMSLST) (* ; "Edited 27-May-87 17:26 by raf") - (PROG (NUMBER.COLUMNS MAX.ROW.WIDTH (BORDER 1)) - [SETQ MAX.ROW.WIDTH (IPLUS BORDER BORDER (for NAME in ITEMSLST largest (STRINGWIDTH NAME - MENUFONT) - finally - (RETURN $$EXTREME] + [SETQ MAX.ROW.WIDTH (IPLUS BORDER BORDER (for NAME in ITEMSLST + largest (STRINGWIDTH NAME MENUFONT) + finally (RETURN $$EXTREME] (SETQ NUMBER.COLUMNS (ADD1 (IQUOTIENT (SUB1 (LENGTH ITEMSLST)) Manager.MENUROWS))) - [if (IGREATERP (ITIMES NUMBER.COLUMNS MAX.ROW.WIDTH) + [if (IGREATERP (ITIMES NUMBER.COLUMNS MAX.ROW.WIDTH) SCREENWIDTH) - then - (SETQ NUMBER.COLUMNS (MAX 1 (QUOTIENT SCREENWIDTH MAX.ROW.WIDTH] + then (SETQ NUMBER.COLUMNS (MAX 1 (QUOTIENT SCREENWIDTH MAX.ROW.WIDTH] (RETURN NUMBER.COLUMNS]) (Manager.MENUHASITEM [LAMBDA (ITEM MENU) (* ; "Edited 31-Jul-87 17:33 by raf") (* ;  "Elaborate member check, since menu items are nested in an extra list to display properly.") - - (SASSOC ITEM (fetch ITEMS of MENU]) + (SASSOC ITEM (fetch ITEMS of MENU]) (Manager.MENUITEMS [LAMBDA (MENU) (* ; "Edited 9-Jul-87 14:06 by raf") - - (for ITEM in (fetch (MENU ITEMS) - MANAGER-FILE-MENU) - collect - (CAR ITEM]) + (for ITEM in (fetch (MENU ITEMS) + MANAGER-FILE-MENU) collect (CAR ITEM]) (Manager.REMOVE.DUPLICATE.ADVICE [LAMBDA (FILE) (* ; "Edited 20-Aug-87 13:45 by raf") (* ;;; "Removes (some) duplicated advice when a source file is loaded. A patch to the behavior of advice loading. This is here mostly for the convenience of the Manager implementors, since its not fully general.") - (for ADVICE in (FILECOMSLST FILE 'ADVICE) - do - (LET [(DEFINITIONS (GETDEF ADVICE 'ADVICE 'CURRENT] - (bind (CHANGED _ NIL) - while - (AND (GREATERP (LENGTH DEFINITIONS) - 1) - (EQUAL (CAR DEFINITIONS) - (CADR DEFINITIONS))) - do (* ; + (for ADVICE in (FILECOMSLST FILE 'ADVICE) + do (LET [(DEFINITIONS (GETDEF ADVICE 'ADVICE 'CURRENT] + (bind (CHANGED _ NIL) while (AND (GREATERP (LENGTH DEFINITIONS) + 1) + (EQUAL (CAR DEFINITIONS) + (CADR DEFINITIONS))) do + (* ;  "Note that this only checks duplications at the front of the list of advice.") - - (pop DEFINITIONS) - (SETQ CHANGED T) - finally - (if CHANGED then (LET ((Manager.ACTIVEFLG NIL)) + (pop DEFINITIONS) + (SETQ CHANGED T) + finally (if CHANGED + then (LET ((Manager.ACTIVEFLG NIL)) (* ;  "Turn this off so we don't see the updates animate.") - - (PUTDEF ADVICE 'ADVICE DEFINITIONS) - (UNMARKASCHANGED ADVICE 'ADVICE]) + (PUTDEF ADVICE 'ADVICE DEFINITIONS) + (UNMARKASCHANGED ADVICE 'ADVICE]) (Manager.RESETSUBITEMS [LAMBDA (FILE COMSTYPE) (* ; "Edited 16-Aug-87 22:06 by raf") @@ -929,96 +1539,213 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (AND FILE (PROG (ITEMS MENU.ITEMS SUBTYPES) - (SETQ MENU.ITEMS (FASSOC FILE (fetch (MENU ITEMS) - of MANAGER-FILE-MENU))) + (SETQ MENU.ITEMS (FASSOC FILE (fetch (MENU ITEMS) of MANAGER-FILE-MENU))) (SETQ ITEMS (NTH MENU.ITEMS 4)) (SETQ SUBTYPES (Manager.FILESUBTYPES FILE)) - (if [AND ITEMS (OR (NULL COMSTYPE) - (if (FASSOC COMSTYPE (CDAR ITEMS)) - then - (NULL (FMEMB COMSTYPE SUBTYPES)) - else - (FMEMB COMSTYPE SUBTYPES] - then - (RPLACA ITEMS `(SUBITEMS %,@ (for TYPE in SUBTYPES collect - `(%, TYPE (%, FILE %,@ TYPE) - %, - (CONCAT "Creates a " TYPE - " submenu for the file " FILE]) + (if [AND ITEMS (OR (NULL COMSTYPE) + (if (FASSOC COMSTYPE (CDAR ITEMS)) + then (NULL (FMEMB COMSTYPE SUBTYPES)) + else (FMEMB COMSTYPE SUBTYPES] + then (RPLACA ITEMS + `(SUBITEMS %,@ (for TYPE in SUBTYPES + collect `(%, TYPE (%, FILE %,@ TYPE) + %, + (CONCAT "Creates a " TYPE + " submenu for the file " FILE]) -(Manager.SORT.COMS -(LAMBDA (A B) (* ; "Edited 18-Nov-87 15:12 by raf") (* ;;; "This allows CLOS method definitions to display in a sorted fashion.") (* ;;; "They are stored on the fileCOMS variable as:") (* ;;; "(method-name (required-arg-type-specifiers))") (ALPHORDER (COND ((LITATOM A) A) (T (CONCAT A))) (COND ((LITATOM B) B) (T (CONCAT B))))) -) +(Manager.SORT.COMS + [LAMBDA (A B) (* ; "Edited 18-Nov-87 15:12 by raf") + +(* ;;; "This allows CLOS method definitions to display in a sorted fashion.") + +(* ;;; "They are stored on the fileCOMS variable as:") + +(* ;;; "(method-name (required-arg-type-specifiers))") + + (ALPHORDER (COND + ((LITATOM A) + A) + (T (CONCAT A))) + (COND + ((LITATOM B) + B) + (T (CONCAT B]) (Manager.SORTBYCOLUMN [LAMBDA (ITEMS) (* ; "Edited 19-Jun-87 20:58 by andyiii") - (PROG ((LNGTH (FLENGTH ITEMS)) COLUMNCOUNT COLUMNLENGTH EXTRAITEMCOLUMNS RESULT) - (if (NULL ITEMS) - then - (RETURN)) + (if (NULL ITEMS) + then (RETURN)) (SORT ITEMS 'Manager.SORT.COMS) (SETQ COLUMNCOUNT (Manager.MENUCOLUMNS ITEMS)) (SETQ COLUMNLENGTH (IQUOTIENT LNGTH COLUMNCOUNT)) (SETQ EXTRAITEMCOLUMNS (IREMAINDER LNGTH COLUMNCOUNT)) - [SETQ RESULT (for I to COLUMNCOUNT collect (for J to (COND + [SETQ RESULT (for I to COLUMNCOUNT collect (for J to (COND ((ILEQ I EXTRAITEMCOLUMNS) (ADD1 COLUMNLENGTH)) (COLUMNLENGTH)) - collect - (pop ITEMS] - (RETURN (while (CAR RESULT) - join - (DREMOVE NIL (for LST on RESULT collect (PROG1 (CAAR LST) - (RPLACA LST (CDAR LST]) + collect (pop ITEMS] + (RETURN (while (CAR RESULT) join (DREMOVE NIL (for LST on RESULT + collect (PROG1 (CAAR LST) + (RPLACA LST (CDAR LST)))]) ) -(XCL:REINSTALL-ADVICE (QUOTE ADDFILE) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (AND Manager.ACTIVEFLG (Manager.CHECKFILE FILE))))))) -(XCL:REINSTALL-ADVICE (QUOTE ADDTOFILES?) :AROUND (QUOTE ((:LAST (PROG1 (LET ((MANAGER-ADDTOFILES? T)) *) (AND Manager.ACTIVEFLG (Manager.ADDTOFILES?))))))) -(XCL:REINSTALL-ADVICE (QUOTE MAKEFILE) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (AND Manager.ACTIVEFLG (Manager.MAKEFILE.ADV FILE OPTIONS))))))) -(XCL:REINSTALL-ADVICE (QUOTE MARKASCHANGED) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (AND Manager.ACTIVEFLG (Manager.ALTERMARKING NAME TYPE (OR REASON T)))))))) -(XCL:REINSTALL-ADVICE (QUOTE UNMARKASCHANGED) :AROUND (QUOTE ((:LAST (LET (!VALUE) (PROG1 (LET ((Manager.ACTIVEFLG NIL)) (SETQ !VALUE *)) (AND Manager.ACTIVEFLG !VALUE (Manager.ALTERMARKING NAME TYPE NIL)))))))) -(XCL:REINSTALL-ADVICE (QUOTE UPDATEFILES) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (AND Manager.ACTIVEFLG (Manager.MAINUPDATE T))))))) -(XCL:REINSTALL-ADVICE (QUOTE ADDTOCOMS) :AROUND (QUOTE ((:LAST (LET (!VALUE) (PROG1 (LET ((Manager.ACTIVEFLG NIL)) (SETQ !VALUE *)) (AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))))))) -(XCL:REINSTALL-ADVICE (QUOTE DELFROMCOMS) :AROUND (QUOTE ((:LAST (LET (!VALUE) (PROG1 (LET ((Manager.ACTIVEFLG NIL)) (SETQ !VALUE *)) (AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))))))) -(XCL:REINSTALL-ADVICE (QUOTE \ADDTOFILEBLOCK/ADDNEWCOM) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (AND Manager.ACTIVEFLG (Manager.RESETSUBITEMS FILE TYPE))))))) -(XCL:REINSTALL-ADVICE (QUOTE LOAD) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (if Manager.ACTIVEFLG then (Manager.REMOVE.DUPLICATE.ADVICE FILE) (Manager.CHECKFILE FILE))))))) -(XCL:REINSTALL-ADVICE (QUOTE LOADFNS) :AROUND (QUOTE ((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) *) (if Manager.ACTIVEFLG then (Manager.REMOVE.DUPLICATE.ADVICE FILE) (Manager.CHECKFILE FILE))))))) -(XCL:REINSTALL-ADVICE (QUOTE (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)) :AROUND (QUOTE ((:LAST (AND (AND (EQ NAME (QUOTE FILELST)) (EQ TYPE (QUOTE VARS))) *))))) -(READVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)) + +[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (AND Manager.ACTIVEFLG (Manager.CHECKFILE FILE))) + ] + +[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (PROG1 (LET ((MANAGER-ADDTOFILES? T)) + *) + (AND Manager.ACTIVEFLG (Manager.ADDTOFILES?))) + ] + +[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (AND Manager.ACTIVEFLG (Manager.MAKEFILE.ADV + FILE OPTIONS)))] + +[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (AND Manager.ACTIVEFLG + (Manager.ALTERMARKING NAME TYPE + (OR REASON T))))] + +[XCL:REINSTALL-ADVICE 'UNMARKASCHANGED :AROUND + '((:LAST (LET (!VALUE) + (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + (SETQ !VALUE *)) + (AND Manager.ACTIVEFLG !VALUE (Manager.ALTERMARKING NAME TYPE NIL)))] + +[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (AND Manager.ACTIVEFLG (Manager.MAINUPDATE + T)))] + +[XCL:REINSTALL-ADVICE 'ADDTOCOMS :AROUND + '((:LAST (LET (!VALUE) + (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + (SETQ !VALUE *)) + (AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))] + +[XCL:REINSTALL-ADVICE 'DELFROMCOMS :AROUND + '((:LAST (LET (!VALUE) + (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + (SETQ !VALUE *)) + (AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))] + +[XCL:REINSTALL-ADVICE '\ADDTOFILEBLOCK/ADDNEWCOM :AROUND + '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (AND Manager.ACTIVEFLG (Manager.RESETSUBITEMS FILE TYPE)))] + +[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (if Manager.ACTIVEFLG + then (Manager.REMOVE.DUPLICATE.ADVICE FILE) + (Manager.CHECKFILE FILE)))] + +[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL)) + *) + (if Manager.ACTIVEFLG + then (Manager.REMOVE.DUPLICATE.ADVICE FILE) + (Manager.CHECKFILE FILE)))] + +[XCL:REINSTALL-ADVICE '(MARKASCHANGED :IN DEFAULT.EDITDEFA0001) + :AROUND + '((:LAST (AND (AND (EQ NAME 'FILELST) + (EQ TYPE 'VARS)) + *] + +(READVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS + DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)) (DECLARE%: EVAL@COMPILE -(PUTPROPS GETDATUM MACRO ((KEY) (CDR (FASSOC KEY Manager.DATASPACE)))) -(PUTPROPS PUTDATUM MACRO ((KEY VALUE) (PUTASSOC KEY VALUE Manager.DATASPACE))) -(PUTPROPS Manager.TTYCOMMAND MACRO ((X . Y) (PROGN (ALLOW.BUTTON.EVENTS) X . Y))) + +(PUTPROPS GETDATUM MACRO ((KEY) + (CDR (FASSOC KEY Manager.DATASPACE)))) + +(PUTPROPS PUTDATUM MACRO ((KEY VALUE) + (PUTASSOC KEY VALUE Manager.DATASPACE))) + +(PUTPROPS Manager.TTYCOMMAND MACRO ((X . Y) + (PROGN (ALLOW.BUTTON.EVENTS) + X . Y))) ) -(PUTPROPS ADVICE MANAGER-DEFINITION-TYPE-COMMANDS (("ReAdvise" (QUOTE READVISE) "Enable all advice under this name") ("UnAdvise" (QUOTE UNADVISE) "Disable all advice under this name")) -) +(PUTPROPS ADVICE MANAGER-DEFINITION-TYPE-COMMANDS (("ReAdvise" 'READVISE + "Enable all advice under this name") + ("UnAdvise" 'UNADVISE + "Disable all advice under this name"))) -(PUTPROPS FNS MANAGER-DEFINITION-TYPE-COMMANDS (("Break" (QUOTE BREAK) "Break this function") ("Trace" (QUOTE TRACE) "Trace this function") ("UNBreak" (QUOTE UNBREAK) "UnBreak this function") ("Compile" (QUOTE COMPILE) "Compile this function" (SUBITEMS ("Compile" (QUOTE COMPILE) "Compile this function") (DISASSEMBLE (QUOTE DISASSEMBLE) " Print the compiled code of the function"))) (" MasterScope " (QUOTE DESCRIBE) "Invoke MasterScope to DESCRIBE the function" (SUBITEMS (" Describe " (QUOTE DESCRIBE) "Invoke MasterScope to describe this function") ("Show Paths" (QUOTE SHOWPATHTO) "Invoke MasterScope to show who calls this function" (SUBITEMS ("To" (QUOTE SHOWPATHTO) "Invoke MasterScope to show who calls this function") (" From " (QUOTE SHOWPATHFROM) "Invoke MasterScope to show who is called by this function"))))) ("?=" (QUOTE ARGS) "The function's argument list")) -) +(PUTPROPS FNS MANAGER-DEFINITION-TYPE-COMMANDS (("Break" 'BREAK "Break this function") + ("Trace" 'TRACE "Trace this function") + ("UNBreak" 'UNBREAK "UnBreak this function") + ("Compile" 'COMPILE "Compile this function" + (SUBITEMS ("Compile" 'COMPILE + "Compile this function") + (DISASSEMBLE 'DISASSEMBLE + " Print the compiled code of the function" + ))) + [" MasterScope " + 'DESCRIBE + "Invoke MasterScope to DESCRIBE the function" + (SUBITEMS (" Describe " 'DESCRIBE + "Invoke MasterScope to describe this function" + ) + ("Show Paths" 'SHOWPATHTO + "Invoke MasterScope to show who calls this function" + (SUBITEMS ("To" 'SHOWPATHTO + "Invoke MasterScope to show who calls this function" + ) + (" From " 'SHOWPATHFROM + "Invoke MasterScope to show who is called by this function" + ] + ("?=" 'ARGS "The function's argument list"))) -(PUTPROPS RECORDS MANAGER-DEFINITION-TYPE-COMMANDS (("Fields" (QUOTE FIELDS) "List the field names")) -) +(PUTPROPS RECORDS MANAGER-DEFINITION-TYPE-COMMANDS (("Fields" 'FIELDS "List the field names"))) -(PUTPROPS VARS MANAGER-DEFINITION-TYPE-COMMANDS ((" MasterScope " (QUOTE DESCRIBE) "Who uses this?" (SUBITEMS ("Who uses?" (QUOTE DESCRIBE) "Who uses this?")))) -) +(PUTPROPS VARS MANAGER-DEFINITION-TYPE-COMMANDS [(" MasterScope " 'DESCRIBE "Who uses this?" + (SUBITEMS ("Who uses?" 'DESCRIBE + "Who uses this?"]) -(PUTPROPS FUNCTIONS MANAGER-DEFINITION-TYPE-COMMANDS (("Break" (QUOTE BREAK) "Break this function") ("Trace" (QUOTE TRACE) "Trace this function") ("UNBreak" (QUOTE UNBREAK) "UnBreak this function") ("Compile" (QUOTE COMPILE) "Compile this function" (SUBITEMS ("Compile" (QUOTE COMPILE) "Compile this function") ("Disassemble" (QUOTE DISASSEMBLE) " Print the compiled code of the function"))) ("?=" (QUOTE ARGS) "The function's argument list")) -) +(PUTPROPS FUNCTIONS MANAGER-DEFINITION-TYPE-COMMANDS (("Break" 'BREAK "Break this function") + ("Trace" 'TRACE "Trace this function") + ("UNBreak" 'UNBREAK "UnBreak this function") + ("Compile" 'COMPILE "Compile this function" + (SUBITEMS ("Compile" 'COMPILE + "Compile this function" + ) + ("Disassemble" 'DISASSEMBLE + " Print the compiled code of the function" + ))) + ("?=" 'ARGS "The function's argument list"))) + +(ADDTOVAR BackgroundMenuCommands (File% Manager (MANAGER) + "Starts the menu driven file manager")) + +(LSUBST 'Manager NIL BackgroundMenuCommands) + + (* ; + "remove old manager entry if it exists") -(ADDTOVAR BackgroundMenuCommands (File% Manager (MANAGER) "Starts the menu driven file manager")) -(LSUBST (QUOTE Manager) NIL BackgroundMenuCommands) -(* ; "remove old manager entry if it exists") (SETQ BackgroundMenu NIL) -(* ; " cause the backGround menu to be rebuilt") -(MANAGER.RESET (CL:SYMBOL-VALUE (QUOTE Manager.ACTIVEFLG))) -(* ; "Shutdown any old manager windows and restart if we're already running.") -(if (STREQUAL MANAGER-ACTIVITY-WINDOW-TITLE (WINDOWPROP NIL (QUOTE TITLE))) then (* ; "If we're in the manager activity window, close it, since we dropped the pointer to it in MANAGER.RESET.") (CLOSEW NIL)) -(PUTPROPS MANAGER MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) + (* ; + " cause the backGround menu to be rebuilt") -(PUTPROPS MANAGER FILETYPE :COMPILE-FILE) +(MANAGER.RESET (CL:SYMBOL-VALUE 'Manager.ACTIVEFLG)) + + (* ; + "Shutdown any old manager windows and restart if we're already running.") + +(if (STREQUAL MANAGER-ACTIVITY-WINDOW-TITLE (WINDOWPROP NIL 'TITLE)) + then (* ; "If we're in the manager activity window, close it, since we dropped the pointer to it in MANAGER.RESET.") + (CLOSEW NIL)) + +(PUTPROPS MANAGER MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) + +(PUTPROPS MANAGER FILETYPE :COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -1027,20 +1754,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" (QUOTE DB) "Displays the cu (ADDTOVAR LAMA ) ) -(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900)) +(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (16604 71487 (MANAGER 16614 . 17353) (MANAGER.RESET 17355 . 18950) (Manager.ADDADV 18952 - . 20130) (Manager.ADDTOFILES? 20132 . 20402) (Manager.ALTERMARKING 20404 . 21943) (Manager.DO.COMMAND - 21945 . 33442) (Manager.HIGHLIGHT 33444 . 33694) (Manager.PROMPT 33696 . 34010) (Manager.WINDOW 34012 - . 34637) (Manager.insurefilehighlights 34639 . 35586) (Manager.CHANGED? 35588 . 36148) ( -Manager.CHECKFILE 36150 . 37231) (Manager.COLLECTCOMS 37233 . 38716) (Manager.COMS.WSF 38718 . 41158) -(Manager.COMSOPEN 41160 . 45672) (Manager.COMSUPDATE 45674 . 46786) (Manager.HIGHLIGHTED 46788 . 47124 -) (Manager.INSUREHIGHLIGHTS 47126 . 47690) (Manager.FILECHANGES 47692 . 47982) ( -Manager.FILELSTCHANGED? 47984 . 48283) (Manager.FILESUBTYPES 48285 . 48911) (Manager.GET.ENVIRONMENT -48913 . 51571) (Manager.GETFILE 51573 . 53874) (Manager.INTITLE? 53876 . 54538) (Manager.MAIN.WSF -54540 . 57049) (Manager.MAINCLOSE 57051 . 58084) (Manager.MAINMENUITEMS 58086 . 59049) ( -Manager.MAINOPEN 59051 . 63894) (Manager.MAINUPDATE 63896 . 64619) (Manager.MAKEFILE.ADV 64621 . 65658 -) (Manager.MENUCOLUMNS 65660 . 66548) (Manager.MENUHASITEM 66550 . 66900) (Manager.MENUITEMS 66902 . -67150) (Manager.REMOVE.DUPLICATE.ADVICE 67152 . 68575) (Manager.RESETSUBITEMS 68577 . 69884) ( -Manager.SORT.COMS 69886 . 70239) (Manager.SORTBYCOLUMN 70241 . 71485))))) + (FILEMAP (NIL (25538 101851 (MANAGER 25548 . 26347) (MANAGER.RESET 26349 . 27863) (Manager.ADDADV +27865 . 29218) (Manager.ADDTOFILES? 29220 . 29498) (Manager.ALTERMARKING 29500 . 31110) ( +Manager.DO.COMMAND 31112 . 62332) (Manager.HIGHLIGHT 62334 . 62631) (Manager.PROMPT 62633 . 62946) ( +Manager.WINDOW 62948 . 63581) (Manager.insurefilehighlights 63583 . 64654) (Manager.CHANGED? 64656 . +65205) (Manager.CHECKFILE 65207 . 66306) (Manager.COLLECTCOMS 66308 . 67746) (Manager.COMS.WSF 67748 + . 70418) (Manager.COMSOPEN 70420 . 75158) (Manager.COMSUPDATE 75160 . 76252) (Manager.HIGHLIGHTED +76254 . 76560) (Manager.INSUREHIGHLIGHTS 76562 . 77120) (Manager.FILECHANGES 77122 . 77421) ( +Manager.FILELSTCHANGED? 77423 . 77751) (Manager.FILESUBTYPES 77753 . 78391) (Manager.GET.ENVIRONMENT +78393 . 80931) (Manager.GETFILE 80933 . 83247) (Manager.INTITLE? 83249 . 83927) (Manager.MAIN.WSF +83929 . 86573) (Manager.MAINCLOSE 86575 . 87685) (Manager.MAINMENUITEMS 87687 . 88764) ( +Manager.MAINOPEN 88766 . 94142) (Manager.MAINUPDATE 94144 . 94780) (Manager.MAKEFILE.ADV 94782 . 95818 +) (Manager.MENUCOLUMNS 95820 . 96624) (Manager.MENUHASITEM 96626 . 96983) (Manager.MENUITEMS 96985 . +97230) (Manager.REMOVE.DUPLICATE.ADVICE 97232 . 98838) (Manager.RESETSUBITEMS 98840 . 100077) ( +Manager.SORT.COMS 100079 . 100611) (Manager.SORTBYCOLUMN 100613 . 101849))))) STOP diff --git a/lispusers/MANAGER.DFASL b/lispusers/MANAGER.DFASL new file mode 100644 index 00000000..3114016f Binary files /dev/null and b/lispusers/MANAGER.DFASL differ diff --git a/lispusers/MANAGER.HISTORY b/lispusers/MANAGER.HISTORY deleted file mode 100644 index 8b2000e2..00000000 --- a/lispusers/MANAGER.HISTORY +++ /dev/null @@ -1 +0,0 @@ -This is a history of edits made to the Manager. Please add your initials and a short description of what you changed to the END of the file. Be sure to include the name of the definition you modified. andyiii- All menus are sorted now. andyiii - Appropiate sub-menu update when something is changed that they contain. andyiii- un-marking a file in the main menu now works and updates all the sub-menus of that file. andyiii - added option to MAKEFILE menu item for files to write CommonLisp source using common-makefile. andyiii - added commonlisp DESCRIBE for items andyiii - Added a way to add files to the file managers main menu andyiii - Can edit files property list from CHANGES menu andyiii - Can now mark a whole file from main menu andyiii - Can chose between TCOMPL (.LCOM files) and compile-file (.dfasl files) This is awkard since is uses the global variable *default-cleanup-compiler* andyiii - Can get CommonLisp documentation string and descriptons andyiii - Can now PrettyPrint a value, function def, or prop list and also show how the item would be written to a file andyiii - Cleaned up specialized menus for FNS, FUNCTIONS, VARS and PROPS andyiii - All dialog now goes through the MANAGER ACTIVITY WINDOW RAF 7/31/87 - Fixed the rename option to not specify a source file, uses the ? search (core then file). RAF 7/31/87 - Added an "edit all occurances of item's name" option to file relations menu. RAF 7/31/87 - Manager.ACTIVEFLG is now a special that is bound by all advice to avoid redundant updates inside of themselves. This is a big speed improvement! RAF 7/31/87 - Fixed Manager.HASITEM and Manager.HIGHLIGHT to use SASSOC, so that list items in menus get highlighted properly. RAF 7/31/87 - Middle button on Manager file menu now brings up rename, etc. Used to bring up coms to edit (inconsistent). RAF 7/31/87 - Main menu flashes if bad button/command is given. RAF 8/4/87 - MANAGER-ADDTOFILES? now initialized to NIL, reducing redundant updates. RAF 8/14/87 - In Manager.ALTERMARKING: removed extra code which tracked the files containing updated menus. Removed call to Manager.CHECKFILE. Made call to Manager.MAINUPDATE pass T if the reason for marking was DEFINED or DELETED; these cases also call Manager.COMSOPEN. RAF 8/15/87 - In Manager.DO.COMMAND: moved binding of ACTIVITY-WINDOW-WAS-SHRUNK into the form eval'ed in the process where references are made. Moved setting of ACTIVITY-WINDOW-WAS-SHRUNK after the spot where its referent ACTIVITY-WINDOW is initialized. RAF 8/16/87 - Advice for LOAD and LOADFNS now call Manager.CHECKFILE instead of Manager.MAINUPDATE (latter only does highlight updating, former can rebuild main menu). Advice for ADDTOFILES? now doesn't disable manager inside of its advised form, so that the ADDTOCOMS and DELFROMCOMS advice will work. RAF 8/17/87 - Added Manager.FILELSTCHANGED? (which is tricky, since sorting in the main menu changes its order). Manager.CHECKFILE now tests whether the file being checked is in the main menu. If not the main menu is rebuilt. MANAGER fns disables manager around its call to UPDATEFILES. Manager.GETFILE takes a prompt argument (which is now passed in by Manager.DO.COMMAND). RAF 8/18/87 - Manager.REMOVE.DUPLICATE.ADVICE now disables the manager when it manipulates the advice (to avoid animating the changes in the menus). The advice on LOAD and LOADFNS now call Manager.REMOVE.DUPLICATE.ADVICE. RAF 8/20/87 - Fixed Manager.MAKEFILE.ADV to handle atomic cleanup options. Also made the top level Manager.RESET call take Manager.ACTIVEFLG, so that manager stays on when reloaded if it was on already. Manager.REMOVE.DUPLICATE.ADVICE now removes *all* duplicates of the first piece of advice (rather than only the second). RAF 8/21/87 - Made MANAGER-WINDOWS be an initvar so that Manager.RESET from top level sees the right thing on first startup. RAF 9/2/87 - Changed the manager shrunken bitmap to something more respectable. Added ADVISE and UNADVISE menu options for the ADVICE definer. Added a "Show all advice in effect" option to the manager main window middle button menu. Changed the messages printed out by Manager.DO.COMMAND to all use printout and lambdafont for highlighting. RAF 9/3/87 - Added a clause in the startup fns MANAGER which reports when FILELST is empty and manager can't start. Also fixed a bug in where marking a file didn't bold the main menu entry (added an updatefiles in Manager.ALTERMARKING). Also caused the advice on the "redundant" call to (MARKASCHANGED :IN DEFAULT.EDITDEFA0001) to fire when FILELST is being edited (seems it was the only way to call markaschanged in that one case). RAF 11/18/87 - Changed the call to EDITDEF in Manager.DO.COMMAND to include a :DONTWAIT option. The tracks a change in SEdit for the Mototwn release. RAF 11/18/87 - Added some type checking to the sort testing function Manager.SORT.COMS so that it doesn't convert its arguments to strings unless they're not LITATOMS. This should make menu generation alot faster. \ No newline at end of file diff --git a/lispusers/MANAGER.TEDIT b/lispusers/MANAGER.TEDIT index d5391516..ee71c27e 100644 Binary files a/lispusers/MANAGER.TEDIT and b/lispusers/MANAGER.TEDIT differ diff --git a/lispusers/MIGRATION/SEDIT-DECLS b/lispusers/MIGRATION/SEDIT-DECLS deleted file mode 100644 index 1b026c3e..00000000 --- a/lispusers/MIGRATION/SEDIT-DECLS +++ /dev/null @@ -1,242 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL))) -(il:filecreated "18-Apr-88 13:01:03" il:{eris}sources>sedit-decls.\;21 32113 - - il:|changes| il:|to:| (il:vars il:sedit-declscoms) - - il:|previous| il:|date:| "13-Apr-88 17:22:16" il:{eris}sources>sedit-decls.\;20) - - -; Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved. - -(il:prettycomprint il:sedit-declscoms) - -(il:rpaqq il:sedit-declscoms ((il:prop il:filetype il:sedit-decls) (il:prop il:makefile-environment il:sedit-decls) (il:* il:|;;;| "This file is for declaring things which are shared among sedit files. This file is loaded at compile time by each sedit file, but the contents of this file are not copied into any of the compiled files. The RECORDS declarations are here, and they are INITRECORDed and SYSRECORDed in SEDIT-ACCESS. If you change a record, make sure sedit-access gets remade NEW. All GLOBALVARS declarations are done here, because they're needed at compile time, but the actual variable declarations are done in the appropriate file. Constants and Macros are declared here only if they are shared among files; otherwise they can remain in the appropriate file. ") (il:records broken-atom edit-context edit-env edit-node edit-node-type edit-point edit-selection gap line-block line-start list-format open-string string-item weak-link) (il:* il:|;;| "interface globalvars") (il:globalvars convert-upgrade keep-window-region contexts lisp-edit-environment list-formats-table pretty-print-env regions) (il:* il:|;;| "shared globalvars") (il:globalvars il:boldfont il:clispfont il:commentflg il:commentfont il:defaultfont il:promptwindow il:italicfont args-gap atom-caret basic-gap body-gap button-string button-string-node structure-caret clisp-indent-words clisp-program-words command-table-spec list-parse-info terminal-table temp-point temp-selection type-clisp type-comment type-comment-word type-dotlist type-gap type-list type-litatom type-quote type-root type-string type-unknown types args-bitmap body-bitmap gap-bitmap) (il:* il:|;;| "window file globalvars") (il:globalvars titled-icon selection-pending? pending-selection initial-selection scratch-selection pending-caret pending-last-x pending-last-y pending-type pending-shift last-move-clock button-string-node) (il:* il:|;;| "command file globalvars") (il:globalvars menus menu-description mutate-candidate package-candidate printbase-candidate find-candidate substitute-candidate) (il:* il:|;;| "random constants") (il:constants (editor-name "SEdit") (il:micasperpt 35.27778) (quote-wrapper-list (quote (quote quote il:bquote il:bquote il:comma il:\\\, comma-at il:\\\,@ comma-dot il:\\\,. function function)))) (il:* il:|;;| "random macros") (il:macros get-prompt-window eval-in-process lookup-command quote-wrapper quote-wrapper-name repaint-new-line reset-control-variables select-comment-indent set-comment-positions set-selection-nowhere) (il:* il:|;;| "kernel macros") (il:functions create-weak-link) (il:macros advance close-open-node dead-node? end-undo-block escape-char eq-point-type next-linear set-linear start-undo-block step-linear subnode undo-by zap-clisp-translation smash-using il:half) (il:* il:|;;| "the symbols that come from interlisp, divided into those that conflict with CL symbols and those that don't. The SEDIT package declaration in the makefile-environment for all these files need not actually import any of these symbols, it just makes the functions easier to edit if you do cause then you don't need so many IL: prefixes.") (il:variables *il-cl-conflicts* *il-imports*) (il:* il:|;;| "and a little reminder:") (il:p (il:|printout| t t "EXPORTS.ALL must be loaded to compile SEdit" t) (il:|printout| t t "SEDIT-ACCESS must be REMADE NEW if you change a record" t)))) - -(il:putprops il:sedit-decls il:filetype :compile-file) - -(il:putprops il:sedit-decls il:makefile-environment (:readtable "XCL" :package (defpackage il:sedit (:use il:lisp il:xcl)))) - - - -(il:* il:|;;;| -"This file is for declaring things which are shared among sedit files. This file is loaded at compile time by each sedit file, but the contents of this file are not copied into any of the compiled files. The RECORDS declarations are here, and they are INITRECORDed and SYSRECORDed in SEDIT-ACCESS. If you change a record, make sure sedit-access gets remade NEW. All GLOBALVARS declarations are done here, because they're needed at compile time, but the actual variable declarations are done in the appropriate file. Constants and Macros are declared here only if they are shared among files; otherwise they can remain in the appropriate file. " -) - -(il:declare\: il:eval@compile - -(il:datatype broken-atom (atom-chars)) - -(il:datatype edit-context (environment profile eval-fn eval-in-process context-lock completion-event edit-type icon-title edit-options comment-width comment-separation find-candidate substitute-candidate display-window window-left window-bottom window-right window-top root root-changed-fn completion-fn changed-structure? (dont-collect-changes? il:flag) changed-nodes open-node-changed? open-node open-node-info atom-started atom-started-undo-pointer undo-list undo-undo-list caret caret-point selection selection-displayed? (current-node il:fullxpointer) current-x (current-line il:fullxpointer) (last-linearized-sub-node-index il:word) (linear-pointer il:fullxpointer) (linear-prev il:fullxpointer) last-mouse-x last-mouse-y last-mouse-type \\x \\y \\z \\t first-block current-block matching? below? visible? (repaint-start il:fullxpointer) (repaint-line il:fullxpointer) repaint-x relinearization-time-stamp shift-y shift-down shift-right) - changed-nodes il:_ (cons)) - -(il:datatype edit-env (parse-info parse-info-unknown user-data default-font italic-font keyword-font comment-font broken-atom-font space-width default-line-skip em-width indent-base indent-step max-width comment-width-percent init-comment-separation lparen-string rparen-string dot-string quote-string comment-string command-table default-char-handler help-menu) -) - -(il:datatype edit-node ((node-type il:fullxpointer) format unassigned (super-node il:fullxpointer) (depth il:word) (sub-node-index il:word) structure sub-nodes (linear-thread il:fullxpointer) linear-form (start-x il:word) (right-margin il:word) (preferred-width il:word) (actual-width il:word) (changed? il:flag) inline-width actual-llength first-line last-line) - (il:accessfns (inline? (eq (il:|fetch| first-line il:|of| il:datum) (il:|fetch| last-line il:|of| il:datum)))) - format il:_ (quote not-yet-assigned)) - -(il:datatype edit-node-type (name assign-format compute-format-values linearize sub-node-changed set-point compute-point-position compute-selection-position set-selection grow-selection select-segment insert delete copy-structure copy-selection stringify back-space close-node) -) - -(il:datatype edit-point ((point-node il:fullxpointer) point-index point-type point-x (point-line il:fullxpointer) point-string point-offset) -) - -(il:datatype edit-selection ((select-node il:fullxpointer) select-start select-end select-type delete-ok? pending-delete? select-start-x (select-start-line il:fullxpointer) select-end-x (select-end-line il:fullxpointer) select-string select-start-offset select-end-offset) -) - -(il:datatype gap (linear-item)) - -(il:datatype line-block ((block-start il:fullxpointer) block-new-x block-width next-block bits? block-x block-base-line block-ascent block-descent) -) - -(il:datatype line-start ((next-line il:fullxpointer) (prev-line il:fullxpointer) (node il:fullxpointer) (line-ascent il:word) (line-descent il:word) (line-skip il:word) (line-length il:word) (indent il:word) ycoord (cache-time il:word) cached-y (cached-ascent il:word) (cached-descent il:word)) - (il:accessfns (line-height (il:iplus (il:fetch line-skip il:of il:datum) (il:fetch line-ascent il:of il:datum) (il:fetch line-descent il:of il:datum)))) - (il:accessfns (base-line-y (il:idifference (il:add1 (il:fetch ycoord il:of il:datum)) (il:iplus (il:fetch line-skip il:of il:datum) (il:fetch line-ascent il:of il:datum))))) - (il:accessfns (next-line-y (il:idifference (il:fetch ycoord il:of il:datum) (il:fetch line-height il:of il:datum)))) - (il:accessfns (old-top (if (eq (il:fetch cache-time il:of il:datum) (il:|fetch| relinearization-time-stamp il:|of| context)) (il:sub1 (il:iplus (il:fetch cached-y il:of il:datum) (il:fetch cached-ascent il:of il:datum))) (il:fetch ycoord il:of il:datum)))) - (il:accessfns (old-bottom (if (eq (il:fetch cache-time il:of il:datum) (il:|fetch| relinearization-time-stamp il:|of| context)) (il:idifference (il:fetch cached-y il:of il:datum) (il:fetch cached-descent il:of il:datum)) (il:add1 (il:fetch next-line-y il:of il:datum))))) -) - -(il:datatype list-format (list-formats list-inline? list-pformat list-mformat list-sublists) (il:accessfns (non-standard? (null (il:|fetch| list-formats il:|of| il:datum)))) - (il:accessfns (set-format-list (il:|fetch| list-inline? il:|of| il:datum))) (il:accessfns (cfvlist (il:|fetch| list-pformat il:|of| il:datum))) - (il:accessfns (linearize-list (il:|fetch| list-mformat il:|of| il:datum))) list-sublists il:_ nil) - -(il:record open-string (real-length substring . buffer-string)) - -(il:datatype string-item (string (width il:word) (font il:fullxpointer) (prin-2? il:flag))) - -(il:datatype weak-link ((destination il:fullxpointer))) -) - -(il:/declaredatatype (quote broken-atom) (quote (il:pointer)) (quote ((broken-atom 0 il:pointer))) (quote 2)) - -(il:/declaredatatype (quote edit-context) (quote (il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:flag il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:fullxpointer il:pointer il:fullxpointer il:word il:fullxpointer il:fullxpointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:fullxpointer il:fullxpointer il:pointer il:pointer il:pointer il:pointer il:pointer)) (quote ((edit-context 0 il:pointer) (edit-context 2 il:pointer) (edit-context 4 il:pointer) (edit-context 6 il:pointer) (edit-context 8 il:pointer) (edit-context 10 il:pointer) (edit-context 12 il:pointer) (edit-context 14 il:pointer) (edit-context 16 il:pointer) (edit-context 18 il:pointer) (edit-context 20 il:pointer) (edit-context 22 il:pointer) (edit-context 24 il:pointer) (edit-context 26 il:pointer) (edit-context 28 il:pointer) (edit-context 30 il:pointer) (edit-context 32 il:pointer) (edit-context 34 il:pointer) (edit-context 36 il:pointer) (edit-context 38 il:pointer) (edit-context 40 il:pointer) (edit-context 42 il:pointer) (edit-context 42 (il:flagbits . 0)) (edit-context 44 il:pointer) (edit-context 46 il:pointer) (edit-context 48 il:pointer) (edit-context 50 il:pointer) (edit-context 52 il:pointer) (edit-context 54 il:pointer) (edit-context 56 il:pointer) (edit-context 58 il:pointer) (edit-context 60 il:pointer) (edit-context 62 il:pointer) (edit-context 64 il:pointer) (edit-context 66 il:pointer) (edit-context 68 il:fullxpointer) (edit-context 70 il:pointer) (edit-context 72 il:fullxpointer) (edit-context 74 (il:bits . 15)) (edit-context 76 il:fullxpointer) (edit-context 78 il:fullxpointer) (edit-context 80 il:pointer) (edit-context 82 il:pointer) (edit-context 84 il:pointer) (edit-context 86 il:pointer) (edit-context 88 il:pointer) (edit-context 90 il:pointer) (edit-context 92 il:pointer) (edit-context 94 il:pointer) (edit-context 96 il:pointer) (edit-context 98 il:pointer) (edit-context 100 il:pointer) (edit-context 102 il:pointer) (edit-context 104 il:fullxpointer) (edit-context 106 il:fullxpointer) (edit-context 108 il:pointer) (edit-context 110 il:pointer) (edit-context 112 il:pointer) (edit-context 114 il:pointer) (edit-context 116 il:pointer))) (quote 118)) - -(il:/declaredatatype (quote edit-env) (quote (il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer)) (quote ((edit-env 0 il:pointer) (edit-env 2 il:pointer) (edit-env 4 il:pointer) (edit-env 6 il:pointer) (edit-env 8 il:pointer) (edit-env 10 il:pointer) (edit-env 12 il:pointer) (edit-env 14 il:pointer) (edit-env 16 il:pointer) (edit-env 18 il:pointer) (edit-env 20 il:pointer) (edit-env 22 il:pointer) (edit-env 24 il:pointer) (edit-env 26 il:pointer) (edit-env 28 il:pointer) (edit-env 30 il:pointer) (edit-env 32 il:pointer) (edit-env 34 il:pointer) (edit-env 36 il:pointer) (edit-env 38 il:pointer) (edit-env 40 il:pointer) (edit-env 42 il:pointer) (edit-env 44 il:pointer) (edit-env 46 il:pointer))) (quote 48)) - -(il:/declaredatatype (quote edit-node) (quote (il:fullxpointer il:pointer il:pointer il:fullxpointer il:word il:word il:pointer il:pointer il:fullxpointer il:pointer il:word il:word il:word il:word il:flag il:pointer il:pointer il:pointer il:pointer)) (quote ((edit-node 0 il:fullxpointer) (edit-node 2 il:pointer) (edit-node 4 il:pointer) (edit-node 6 il:fullxpointer) (edit-node 8 (il:bits . 15)) (edit-node 9 (il:bits . 15)) (edit-node 10 il:pointer) (edit-node 12 il:pointer) (edit-node 14 il:fullxpointer) (edit-node 16 il:pointer) (edit-node 18 (il:bits . 15)) (edit-node 19 (il:bits . 15)) (edit-node 20 (il:bits . 15)) (edit-node 21 (il:bits . 15)) (edit-node 16 (il:flagbits . 0)) (edit-node 22 il:pointer) (edit-node 24 il:pointer) (edit-node 26 il:pointer) (edit-node 28 il:pointer))) (quote 30)) - -(il:/declaredatatype (quote edit-node-type) (quote (il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer)) (quote ((edit-node-type 0 il:pointer) (edit-node-type 2 il:pointer) (edit-node-type 4 il:pointer) (edit-node-type 6 il:pointer) (edit-node-type 8 il:pointer) (edit-node-type 10 il:pointer) (edit-node-type 12 il:pointer) (edit-node-type 14 il:pointer) (edit-node-type 16 il:pointer) (edit-node-type 18 il:pointer) (edit-node-type 20 il:pointer) (edit-node-type 22 il:pointer) (edit-node-type 24 il:pointer) (edit-node-type 26 il:pointer) (edit-node-type 28 il:pointer) (edit-node-type 30 il:pointer) (edit-node-type 32 il:pointer) (edit-node-type 34 il:pointer))) (quote 36)) - -(il:/declaredatatype (quote edit-point) (quote (il:fullxpointer il:pointer il:pointer il:pointer il:fullxpointer il:pointer il:pointer)) (quote ((edit-point 0 il:fullxpointer) (edit-point 2 il:pointer) (edit-point 4 il:pointer) (edit-point 6 il:pointer) (edit-point 8 il:fullxpointer) (edit-point 10 il:pointer) (edit-point 12 il:pointer))) (quote 14)) - -(il:/declaredatatype (quote edit-selection) (quote (il:fullxpointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:fullxpointer il:pointer il:fullxpointer il:pointer il:pointer il:pointer)) (quote ((edit-selection 0 il:fullxpointer) (edit-selection 2 il:pointer) (edit-selection 4 il:pointer) (edit-selection 6 il:pointer) (edit-selection 8 il:pointer) (edit-selection 10 il:pointer) (edit-selection 12 il:pointer) (edit-selection 14 il:fullxpointer) (edit-selection 16 il:pointer) (edit-selection 18 il:fullxpointer) (edit-selection 20 il:pointer) (edit-selection 22 il:pointer) (edit-selection 24 il:pointer))) (quote 26)) - -(il:/declaredatatype (quote gap) (quote (il:pointer)) (quote ((gap 0 il:pointer))) (quote 2)) - -(il:/declaredatatype (quote line-block) (quote (il:fullxpointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer il:pointer)) (quote ((line-block 0 il:fullxpointer) (line-block 2 il:pointer) (line-block 4 il:pointer) (line-block 6 il:pointer) (line-block 8 il:pointer) (line-block 10 il:pointer) (line-block 12 il:pointer) (line-block 14 il:pointer) (line-block 16 il:pointer))) (quote 18)) - -(il:/declaredatatype (quote line-start) (quote (il:fullxpointer il:fullxpointer il:fullxpointer il:word il:word il:word il:word il:word il:pointer il:word il:pointer il:word il:word)) (quote ((line-start 0 il:fullxpointer) (line-start 2 il:fullxpointer) (line-start 4 il:fullxpointer) (line-start 6 (il:bits . 15)) (line-start 7 (il:bits . 15)) (line-start 8 (il:bits . 15)) (line-start 9 (il:bits . 15)) (line-start 10 (il:bits . 15)) (line-start 12 il:pointer) (line-start 11 (il:bits . 15)) (line-start 14 il:pointer) (line-start 16 (il:bits . 15)) (line-start 17 (il:bits . 15)))) (quote 18)) - -(il:/declaredatatype (quote list-format) (quote (il:pointer il:pointer il:pointer il:pointer il:pointer)) (quote ((list-format 0 il:pointer) (list-format 2 il:pointer) (list-format 4 il:pointer) (list-format 6 il:pointer) (list-format 8 il:pointer))) (quote 10)) - -(il:/declaredatatype (quote string-item) (quote (il:pointer il:word il:fullxpointer il:flag)) (quote ((string-item 0 il:pointer) (string-item 2 (il:bits . 15)) (string-item 4 il:fullxpointer) (string-item 3 (il:flagbits . 0)))) (quote 6)) - -(il:/declaredatatype (quote weak-link) (quote (il:fullxpointer)) (quote ((weak-link 0 il:fullxpointer))) (quote 2)) - - - -(il:* il:|;;| "interface globalvars") - -(il:declare\: il:doeval@compile il:dontcopy - - -(il:globalvars convert-upgrade keep-window-region contexts lisp-edit-environment list-formats-table pretty-print-env regions) -) - - - -(il:* il:|;;| "shared globalvars") - -(il:declare\: il:doeval@compile il:dontcopy - - -(il:globalvars il:boldfont il:clispfont il:commentflg il:commentfont il:defaultfont il:promptwindow il:italicfont args-gap atom-caret basic-gap body-gap button-string button-string-node structure-caret clisp-indent-words clisp-program-words command-table-spec list-parse-info terminal-table temp-point temp-selection type-clisp type-comment type-comment-word type-dotlist type-gap type-list type-litatom type-quote type-root type-string type-unknown types args-bitmap body-bitmap gap-bitmap) -) - - - -(il:* il:|;;| "window file globalvars") - -(il:declare\: il:doeval@compile il:dontcopy - - -(il:globalvars titled-icon selection-pending? pending-selection initial-selection scratch-selection pending-caret pending-last-x pending-last-y pending-type pending-shift last-move-clock button-string-node) -) - - - -(il:* il:|;;| "command file globalvars") - -(il:declare\: il:doeval@compile il:dontcopy - - -(il:globalvars menus menu-description mutate-candidate package-candidate printbase-candidate find-candidate substitute-candidate) -) - - - -(il:* il:|;;| "random constants") - -(il:declare\: il:eval@compile - -(il:rpaq editor-name "SEdit") - -(il:rpaqq il:micasperpt 35.27778) - -(il:rpaqq quote-wrapper-list (quote quote il:bquote il:bquote il:comma il:\\\, comma-at il:\\\,@ comma-dot il:\\\,. function function)) - - -(il:constants (editor-name "SEdit") (il:micasperpt 35.27778) (quote-wrapper-list (quote (quote quote il:bquote il:bquote il:comma il:\\\, comma-at il:\\\,@ comma-dot il:\\\,. function function)))) -) - - - -(il:* il:|;;| "random macros") - -(il:declare\: il:eval@compile - -(il:putprops get-prompt-window il:macro ((context) (il:getpromptwindow (il:|fetch| display-window il:|of| context)))) - -(il:putprops eval-in-process il:macro (nil (let* ((process (if (eq (il:processprop (il:this.process) (quote il:name)) (quote il:mouse)) (il:tty.process) (il:this.process))) (procform (il:processprop process (quote il:form)))) (cond ((eq (car procform) (quote edit1)) (il:|fetch| eval-in-process il:|of| (cadadr procform))) (t process))))) - -(il:putprops lookup-command il:macro ((char table) (gethash char table))) - -(il:putprops quote-wrapper il:macro (type (cond ((and (il:listp (car type)) (eq (caar type) (quote quote))) (if (il:listp (cadar type)) (il:kwote (il:|for| w il:|in| (cadar type) il:|collect| (il:listget quote-wrapper-list w))) (il:kwote (il:listget quote-wrapper-list (cadar type))))) (t (il:bquote (il:listget quote-wrapper-list (il:\\\, (car type)))))))) - -(il:putprops quote-wrapper-name il:macro ((type) (il:listget (il:constant (il:reverse quote-wrapper-list)) type))) - -(il:putprops repaint-new-line il:macro (il:openlambda (line) (when (il:ilessp (il:|fetch| next-line-y il:|of| (car line)) (il:|fetch| window-top il:|of| context)) (repaint context (il:|fetch| indent il:|of| (car line)) (il:|fetch| base-line-y il:|of| (car line)) (cdr line) (il:|fetch| linear-pointer il:|of| context)) (when (il:ilessp (il:|fetch| next-line-y il:|of| (car line)) (il:|fetch| window-bottom il:|of| context)) (il:|replace| below? il:|of| context il:|with| t))))) - -(il:putprops reset-control-variables il:macro ((context) (when (compiling-post-koto) (il:setq *package* (il:fetch package il:of context)) (il:setq *print-array* nil) (il:setq *print-base* (il:fetch print-base il:of context)) (il:setq *print-case* (il:fetch print-case il:of context)) (il:setq *print-escape* t) (il:setq *print-gensym* t) (il:setq *print-radix* nil)))) - -(il:putprops select-comment-indent il:macro ((key level-1-indent level-2-indent level-3-indent) (il:selectq key (1 level-1-indent) (2 level-2-indent) ((3 4 5) level-3-indent) (il:shouldnt "unexpected comment level")))) - -(il:putprops set-comment-positions il:macro ((comment-start-x comment-indent form-indent paren-width node context) (cond ((il:igeq (il:iplus form-indent (il:|fetch| comment-width il:|of| context)) (il:|fetch| right-margin il:|of| node)) (il:setq comment-start-x (il:iplus (il:|fetch| start-x il:|of| node) paren-width)) (il:setq comment-indent comment-start-x)) (t (il:setq comment-start-x (il:idifference (il:|fetch| right-margin il:|of| node) (il:|fetch| comment-width il:|of| context))) (il:setq comment-indent (il:iplus comment-start-x (il:|fetch| comment-separation il:|of| context))))))) - -(il:putprops set-selection-nowhere il:macro ((selection) (il:|replace| select-node il:|of| selection il:|with| nil))) -) - - - -(il:* il:|;;| "kernel macros") - - -(defmacro create-weak-link (dest) (il:bquote (il:|create| weak-link destination il:_ (il:\\\, dest)))) -(il:declare\: il:eval@compile - -(il:putprops advance il:macro ((width) (il:|add| (il:|fetch| current-x il:|of| context) width))) - -(il:putprops close-open-node il:macro ((context) (when (il:|fetch| open-node-changed? il:|of| context) (close-node context)))) - -(il:putprops dead-node? il:macro ((node) (eq 0 (il:|fetch| depth il:|of| node)))) - -(il:putprops end-undo-block il:macro (nil (collect-undo-block context))) - -(il:putprops escape-char il:macro ((read-table) (il:|fetch| (readtablep il:escapechar) il:|of| (or read-table *readtable*)))) - -(il:putprops eq-point-type il:macro ((point type) (let ((pointnode (il:|fetch| point-node il:|of| point))) (if (il:|type?| edit-selection pointnode) (eq (il:|fetch| node-type il:|of| (il:|fetch| select-node il:|of| pointnode)) type) (eq (il:|fetch| node-type il:|of| pointnode) type))))) - -(il:putprops next-linear il:macro ((context item) (and (il:listp (il:|fetch| linear-pointer il:|of| context)) (eq (car (il:|fetch| linear-pointer il:|of| context)) item)))) - -(il:putprops set-linear il:macro (il:openlambda (context new-lptr) (il:|replace| linear-pointer il:|of| context il:|with| new-lptr) (if (il:listp (il:|fetch| linear-prev il:|of| context)) (rplacd (il:|fetch| linear-prev il:|of| context) new-lptr) (il:|replace| linear-form il:|of| (il:|fetch| linear-prev il:|of| context) il:|with| new-lptr)))) - -(il:putprops start-undo-block il:macro (nil (il:|push| (il:|fetch| undo-list il:|of| context) nil))) - -(il:putprops step-linear il:macro ((context) (il:|replace| linear-pointer il:|of| context il:|with| (cdr (il:|replace| linear-prev il:|of| context il:|with| (il:|fetch| linear-pointer il:|of| context)))))) - -(il:putprops subnode il:macro (x (if (eq (car x) 1) (list (quote cadr) (list (quote il:fetch) (quote sub-nodes) (cadr x))) (list (quote cadr) (list (quote il:nth) (list (quote il:fetch) (quote sub-nodes) (cadr x)) (car x)))))) - -(il:putprops undo-by il:macro (info (list (quote il:push) (quote (il:|fetch| undo-list il:|of| context)) (list* (quote list) (il:kwote (car info)) (cdr info))))) - -(il:putprops zap-clisp-translation il:macro ((x) (and il:clisparray (il:puthash x nil il:clisparray)))) - -(il:putprops smash-using il:macro (x (il:|bind| (src il:_ (if (il:atom (caddr x)) (caddr x) (quote $$source))) dest (descr il:_ (il:getdescriptors (car x))) il:|first| (il:setq dest (list (quote il:replacefieldval) (list (quote quote) (car descr)) (cadr x) (list (quote il:fetchfield) (list (quote quote) (car descr)) src))) (il:setq descr (cdr descr)) il:|while| descr il:|do| (il:setq dest (list (quote il:freplacefieldval) (list (quote quote) (car descr)) dest (list (quote il:fetchfield) (list (quote quote) (car descr)) src))) (il:setq descr (cdr descr)) il:|finally| (when (not (il:atom (caddr x))) (il:setq dest (list (quote let) (list (list (quote $$source) (caddr x))) dest))) (return dest)))) - -(il:putprops il:half il:macro ((il:x) (il:lrsh il:x 1))) -) - - - -(il:* il:|;;| -"the symbols that come from interlisp, divided into those that conflict with CL symbols and those that don't. The SEDIT package declaration in the makefile-environment for all these files need not actually import any of these symbols, it just makes the functions easier to edit if you do cause then you don't need so many IL: prefixes." -) - - -(defparameter *il-cl-conflicts* (quote (il:*print-structure* il:* il:append il:apply il:assoc il:atom il:block il:character il:equal il:error il:floatp il:format il:function il:gethash il:if il:lambda il:length il:listp il:mapcar il:nth il:number il:numberp il:prin1 il:read il:reverse il:setq il:space il:stringp il:terpri))) - -(defparameter *il-imports* (quote (il:\" il:$$iterate il:$$lst1 il:$$out il:\( il:*display-editor* il:\, il:\. il:|.P2| il:/declaredatatype il:\; il:|;;| il:|;;;| il:? il:accessfns il:add.process il:add1 il:addspell il:addspellflg il:addtovar il:alist il:alists il:allocstring il:apply* il:ascent il:atm il:attachwindow il:await.event il:base il:bitblt il:bitmapheight il:bitmaps il:bitmapwidth il:bits il:bksysbuf il:blackshade il:bltshade il:bold il:boldfont il:bottom il:box il:bquote il:bs il:buttoneventfn il:buttons il:c il:caseinsensitive il:ccodep il:changename il:changeoffsetflg il:charcode il:chardelete il:charwidth il:chcon1 il:clearbuf il:clearw il:clisp\: il:clisparray il:clispfont il:clisptran il:clispword il:clock il:closefn il:closew il:column il:columnspace il:comma il:commentflg il:commentfont il:coms il:comtail il:concat il:concatlist il:constant il:constants il:control il:copy il:copyall il:copyright il:copytermtable il:cr il:create il:create.event il:create.monitorlock il:createregion il:createw il:ctrl il:ctrlv il:cursorcreate il:datatype il:date il:datum il:declarations\: il:declare\: il:defaultfont il:defineq il:del il:descent il:docopy il:doeval@compile il:don\'t il:dontcopy il:donteval@load il:dontwait il:dowindowcom il:dremove il:dreverse il:dsp il:dspclippingregion il:dspfont il:dsplinefeed il:dsprightmargin il:dspxoffset il:dspxposition il:dspyoffset il:|Definition-for-EDITDATE| il:|Definition-for-EDITE| il:|Definition-for-EDITL| il:e il:echomode il:edit il:editchanges il:editferror il:editgetd il:editmacros il:editmode il:environment il:eol il:eqmemb il:ersetq il:esc il:escape il:escapechar il:eval@compile il:evalv il:expandfn il:expandregionfn il:expandw il:expr il:extent il:fcharacter il:fetchfield il:filecreated il:filemap il:filepkgflg il:files il:filesload il:filetype il:find.process il:fixeditdate il:fixp il:fixr il:flag il:flagbits il:flashwindow il:flength il:fm.changelabel il:fm.changestate il:fm.dontreshape il:fm.edititem il:fm.getitem il:fm.itemprop il:fm.resetmenu il:fmemb il:fn il:fns il:font il:fontcreate il:fontprop il:form il:forword il:freemenu il:freplacefieldval il:fullxpointer il:functions il:gacha il:getd il:getdef il:getdescriptors il:getpromptwindow il:getprop il:getproplist il:getregion il:getsyntax il:globalvars il:group il:half il:height il:heightifwindow il:helvetica il:icon il:iconwindow il:id il:idifference il:ifword il:igeq il:igreaterp il:ileq il:ilessp il:imax il:imin il:iminus il:in/scroll/bar? il:innerescquote il:infohook il:initrecords il:initvars il:input il:insidep il:interpress il:invert il:iplus il:iquotient il:italicfont il:item il:items il:itemwidth il:itimes il:keyaction il:keyactiontable il:keyboardstream il:keydownp il:kwote il:l il:l-case il:label il:lastmousestate il:lastmousex il:lastmousey il:lconc il:left il:leftbracket il:leftparen il:leq il:linedelete il:links il:listget il:listput il:litatom il:localclose il:localvars il:lrsh il:macro il:macros il:mainwindow il:makefile-environment il:markaschanged il:markaschangedfns il:mask il:maxwidth il:memb il:menu il:menufont il:menuoffset il:mess il:micasperpt il:middle il:mkstring il:mouse il:mouseconfirm il:mousestate il:move il:moveto il:multescapechar il:multiple-escape il:name il:nchars il:nconc1 il:neq il:nill il:nlambda il:nlistp il:nlsetq il:nobind il:none il:notify.event il:nthcharcode il:obtain.monitorlock il:offst il:openlambda il:openstringstream il:openwp il:p il:packagedelim il:paint il:pointer il:prettycomprint il:prin2 il:process il:process.apply il:process.eval il:process.evalv il:processp il:processprop il:proctypeahead il:promptforword il:promptwindow il:prop il:proplst il:props il:putd il:putdef il:puthash il:putprop il:putprops il:quotient il:readcode il:readp il:readsa il:record il:records il:recordtran il:redisplayw il:region il:rejectmaincoms il:release.monitorlock il:relmoveto il:repaintfn il:replacefieldval il:repositionattachedwindows il:resetlst il:resetsave il:resetvar il:reshapefn il:restartable il:retfrom il:retype il:right il:rightbracket il:rightbuttonfn il:rightparen il:rowspace il:rpaq il:rpaq? il:rpaqq il:rplcharcode il:rplnode2 il:rplstring il:scroll.handler il:scrollbyrepaintfn il:scrollextentuse il:scrollfn il:scrollw il:selcharq il:selectedfn il:selectq il:seprchar il:setfs il:setinterrupt il:setproplist il:setsyntax il:settermtable il:shapew il:shift il:shiftdownp il:shouldnt il:shrinkfn il:smallp il:smartarglist il:sp il:specvars il:spellfile il:state il:stkpos il:strequal il:stringdelim il:stringwidth il:strpos il:sub1 il:substring il:sysrecords il:systemreclst il:tab il:table il:tail il:tconc il:tedit.insert il:tedit.paralooks il:this.process il:times il:title il:titledicon il:titlediconw il:titlereg il:top il:totopw il:tty.process il:tty.processp il:tty/editdate il:tty/edite il:tty/editl il:tty\: il:ttydisplaystream il:ttyexitfn il:typename il:u-case il:untilmousestate il:up il:usedfree il:variables il:vars il:vartype il:wait.for.tty il:whiteshade il:width il:window il:windowaddprop il:windowentryfn il:windowprop il:windowregion il:with.monitor il:word il:worddelete il:wxoffset il:wyoffset il:x il:y il:[ il:\\\, il:\\\,. il:\\\,@ il:\\addbase il:\\background il:\\blt il:\\bltchar il:\\caret.create il:\\caret.down il:\\caret.flash? il:\\defaultkeyaction il:\\dtest il:\\getbase il:\\getsysbuf il:\\keyboard.stream il:\\linebuf.ofd il:\\putbase il:\\savevmbackground il:\\syncode il:] il:^ il:_ il:add il:always il:as il:bind il:by il:change il:|changes| il:collect il:count il:create il:|date:| il:do il:eachtime il:else il:elseif il:fetch il:ffetch il:finally il:first il:for il:freplace il:from when il:in il:instring il:join il:largest il:never il:of il:old il:on il:outof il:pop il:|previous| il:|printout| il:push il:pushnew il:repeatuntil il:repeatwhile il:replace il:smallest il:sum il:then il:thereis il:to il:|to:| il:type? il:unless il:until il:using il:when il:where il:while il:with il:{ il:}))) - - - -(il:* il:|;;| "and a little reminder:") - - -(il:|printout| t t "EXPORTS.ALL must be loaded to compile SEdit" t) - -(il:|printout| t t "SEDIT-ACCESS must be REMADE NEW if you change a record" t) -(il:putprops il:sedit-decls il:copyright ("Xerox Corporation" 1987 1988)) -(il:declare\: il:dontcopy - (il:filemap (nil))) -il:stop diff --git a/lispusers/MIGRATION/SEDIT-DECLS.LCOM b/lispusers/MIGRATION/SEDIT-DECLS.LCOM deleted file mode 100644 index 79ec2279..00000000 --- a/lispusers/MIGRATION/SEDIT-DECLS.LCOM +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL))) (IL:FILECREATED "19-Jan-93 19:57:14" ("compiled on " IL:|{DSK}local>src>tape>MIGRATION>SEDIT-DECLS.;1|) "11-Jul-91 21:52:09" IL:|bcompl'd| IL:|in| "Lispcore 11-Jul-91 ..." IL:|dated| "11-Jul-91 21:57:45") (IL:FILECREATED "18-Apr-88 13:01:03" IL:{ERIS}SOURCES>SEDIT-DECLS.\;21 32113 IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-DECLSCOMS) IL:|previous| IL:|date:| "13-Apr-88 17:22:16" IL:{ERIS}SOURCES>SEDIT-DECLS.\;20) (IL:PRETTYCOMPRINT IL:SEDIT-DECLSCOMS) (IL:RPAQQ IL:SEDIT-DECLSCOMS ((IL:PROP IL:FILETYPE IL:SEDIT-DECLS) (IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-DECLS) (IL:* IL:|;;;| "This file is for declaring things which are shared among sedit files. This file is loaded at compile time by each sedit file, but the contents of this file are not copied into any of the compiled files. The RECORDS declarations are here, and they are INITRECORDed and SYSRECORDed in SEDIT-ACCESS. If you change a record, make sure sedit-access gets remade NEW. All GLOBALVARS declarations are done here, because they're needed at compile time, but the actual variable declarations are done in the appropriate file. Constants and Macros are declared here only if they are shared among files; otherwise they can remain in the appropriate file. " ) (IL:RECORDS BROKEN-ATOM EDIT-CONTEXT EDIT-ENV EDIT-NODE EDIT-NODE-TYPE EDIT-POINT EDIT-SELECTION GAP LINE-BLOCK LINE-START LIST-FORMAT OPEN-STRING STRING-ITEM WEAK-LINK) (IL:* IL:|;;| "interface globalvars") (IL:GLOBALVARS CONVERT-UPGRADE KEEP-WINDOW-REGION CONTEXTS LISP-EDIT-ENVIRONMENT LIST-FORMATS-TABLE PRETTY-PRINT-ENV REGIONS) (IL:* IL:|;;| "shared globalvars") (IL:GLOBALVARS IL:BOLDFONT IL:CLISPFONT IL:COMMENTFLG IL:COMMENTFONT IL:DEFAULTFONT IL:PROMPTWINDOW IL:ITALICFONT ARGS-GAP ATOM-CARET BASIC-GAP BODY-GAP BUTTON-STRING BUTTON-STRING-NODE STRUCTURE-CARET CLISP-INDENT-WORDS CLISP-PROGRAM-WORDS COMMAND-TABLE-SPEC LIST-PARSE-INFO TERMINAL-TABLE TEMP-POINT TEMP-SELECTION TYPE-CLISP TYPE-COMMENT TYPE-COMMENT-WORD TYPE-DOTLIST TYPE-GAP TYPE-LIST TYPE-LITATOM TYPE-QUOTE TYPE-ROOT TYPE-STRING TYPE-UNKNOWN TYPES ARGS-BITMAP BODY-BITMAP GAP-BITMAP) (IL:* IL:|;;| "window file globalvars") (IL:GLOBALVARS TITLED-ICON SELECTION-PENDING? PENDING-SELECTION INITIAL-SELECTION SCRATCH-SELECTION PENDING-CARET PENDING-LAST-X PENDING-LAST-Y PENDING-TYPE PENDING-SHIFT LAST-MOVE-CLOCK BUTTON-STRING-NODE) (IL:* IL:|;;| "command file globalvars") ( IL:GLOBALVARS MENUS MENU-DESCRIPTION MUTATE-CANDIDATE PACKAGE-CANDIDATE PRINTBASE-CANDIDATE FIND-CANDIDATE SUBSTITUTE-CANDIDATE) (IL:* IL:|;;| "random constants") (IL:CONSTANTS (EDITOR-NAME "SEdit") (IL:MICASPERPT 35.27778) (QUOTE-WRAPPER-LIST (QUOTE (QUOTE QUOTE IL:BQUOTE IL:BQUOTE IL:COMMA IL:\\\, COMMA-AT IL:\\\,@ COMMA-DOT IL:\\\,. FUNCTION FUNCTION)))) (IL:* IL:|;;| "random macros") ( IL:MACROS GET-PROMPT-WINDOW EVAL-IN-PROCESS LOOKUP-COMMAND QUOTE-WRAPPER QUOTE-WRAPPER-NAME REPAINT-NEW-LINE RESET-CONTROL-VARIABLES SELECT-COMMENT-INDENT SET-COMMENT-POSITIONS SET-SELECTION-NOWHERE) (IL:* IL:|;;| "kernel macros") (IL:FUNCTIONS CREATE-WEAK-LINK) (IL:MACROS ADVANCE CLOSE-OPEN-NODE DEAD-NODE? END-UNDO-BLOCK ESCAPE-CHAR EQ-POINT-TYPE NEXT-LINEAR SET-LINEAR START-UNDO-BLOCK STEP-LINEAR SUBNODE UNDO-BY ZAP-CLISP-TRANSLATION SMASH-USING IL:HALF) (IL:* IL:|;;| "the symbols that come from interlisp, divided into those that conflict with CL symbols and those that don't. The SEDIT package declaration in the makefile-environment for all these files need not actually import any of these symbols, it just makes the functions easier to edit if you do cause then you don't need so many IL: prefixes." ) (IL:VARIABLES *IL-CL-CONFLICTS* *IL-IMPORTS*) (IL:* IL:|;;| "and a little reminder:") (IL:P ( IL:|printout| T T "EXPORTS.ALL must be loaded to compile SEdit" T) (IL:|printout| T T "SEDIT-ACCESS must be REMADE NEW if you change a record" T)))) (IL:PUTPROPS IL:SEDIT-DECLS IL:FILETYPE :COMPILE-FILE) (IL:PUTPROPS IL:SEDIT-DECLS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (DEFPACKAGE IL:SEDIT ( :USE IL:LISP IL:XCL)))) (IL:DATATYPE BROKEN-ATOM (ATOM-CHARS)) (IL:DATATYPE EDIT-CONTEXT (ENVIRONMENT PROFILE EVAL-FN EVAL-IN-PROCESS CONTEXT-LOCK COMPLETION-EVENT EDIT-TYPE ICON-TITLE EDIT-OPTIONS COMMENT-WIDTH COMMENT-SEPARATION FIND-CANDIDATE SUBSTITUTE-CANDIDATE DISPLAY-WINDOW WINDOW-LEFT WINDOW-BOTTOM WINDOW-RIGHT WINDOW-TOP ROOT ROOT-CHANGED-FN COMPLETION-FN CHANGED-STRUCTURE? (DONT-COLLECT-CHANGES? IL:FLAG) CHANGED-NODES OPEN-NODE-CHANGED? OPEN-NODE OPEN-NODE-INFO ATOM-STARTED ATOM-STARTED-UNDO-POINTER UNDO-LIST UNDO-UNDO-LIST CARET CARET-POINT SELECTION SELECTION-DISPLAYED? (CURRENT-NODE IL:FULLXPOINTER) CURRENT-X (CURRENT-LINE IL:FULLXPOINTER) (LAST-LINEARIZED-SUB-NODE-INDEX IL:WORD) (LINEAR-POINTER IL:FULLXPOINTER) (LINEAR-PREV IL:FULLXPOINTER ) LAST-MOUSE-X LAST-MOUSE-Y LAST-MOUSE-TYPE \\X \\Y \\Z \\T FIRST-BLOCK CURRENT-BLOCK MATCHING? BELOW? VISIBLE? (REPAINT-START IL:FULLXPOINTER) (REPAINT-LINE IL:FULLXPOINTER) REPAINT-X RELINEARIZATION-TIME-STAMP SHIFT-Y SHIFT-DOWN SHIFT-RIGHT) CHANGED-NODES IL:_ (CONS)) (IL:DATATYPE EDIT-ENV (PARSE-INFO PARSE-INFO-UNKNOWN USER-DATA DEFAULT-FONT ITALIC-FONT KEYWORD-FONT COMMENT-FONT BROKEN-ATOM-FONT SPACE-WIDTH DEFAULT-LINE-SKIP EM-WIDTH INDENT-BASE INDENT-STEP MAX-WIDTH COMMENT-WIDTH-PERCENT INIT-COMMENT-SEPARATION LPAREN-STRING RPAREN-STRING DOT-STRING QUOTE-STRING COMMENT-STRING COMMAND-TABLE DEFAULT-CHAR-HANDLER HELP-MENU)) (IL:DATATYPE EDIT-NODE ((NODE-TYPE IL:FULLXPOINTER) FORMAT UNASSIGNED (SUPER-NODE IL:FULLXPOINTER) ( DEPTH IL:WORD) (SUB-NODE-INDEX IL:WORD) STRUCTURE SUB-NODES (LINEAR-THREAD IL:FULLXPOINTER) LINEAR-FORM (START-X IL:WORD) (RIGHT-MARGIN IL:WORD) (PREFERRED-WIDTH IL:WORD) (ACTUAL-WIDTH IL:WORD) (CHANGED? IL:FLAG) INLINE-WIDTH ACTUAL-LLENGTH FIRST-LINE LAST-LINE) (IL:ACCESSFNS (INLINE? (EQ ( IL:|fetch| FIRST-LINE IL:|of| IL:DATUM) (IL:|fetch| LAST-LINE IL:|of| IL:DATUM)))) FORMAT IL:_ (QUOTE NOT-YET-ASSIGNED)) (IL:DATATYPE EDIT-NODE-TYPE (NAME ASSIGN-FORMAT COMPUTE-FORMAT-VALUES LINEARIZE SUB-NODE-CHANGED SET-POINT COMPUTE-POINT-POSITION COMPUTE-SELECTION-POSITION SET-SELECTION GROW-SELECTION SELECT-SEGMENT INSERT DELETE COPY-STRUCTURE COPY-SELECTION STRINGIFY BACK-SPACE CLOSE-NODE)) (IL:DATATYPE EDIT-POINT ((POINT-NODE IL:FULLXPOINTER) POINT-INDEX POINT-TYPE POINT-X (POINT-LINE IL:FULLXPOINTER) POINT-STRING POINT-OFFSET)) (IL:DATATYPE EDIT-SELECTION ((SELECT-NODE IL:FULLXPOINTER) SELECT-START SELECT-END SELECT-TYPE DELETE-OK? PENDING-DELETE? SELECT-START-X (SELECT-START-LINE IL:FULLXPOINTER) SELECT-END-X ( SELECT-END-LINE IL:FULLXPOINTER) SELECT-STRING SELECT-START-OFFSET SELECT-END-OFFSET)) (IL:DATATYPE GAP (LINEAR-ITEM)) (IL:DATATYPE LINE-BLOCK ((BLOCK-START IL:FULLXPOINTER) BLOCK-NEW-X BLOCK-WIDTH NEXT-BLOCK BITS? BLOCK-X BLOCK-BASE-LINE BLOCK-ASCENT BLOCK-DESCENT)) (IL:DATATYPE LINE-START ((NEXT-LINE IL:FULLXPOINTER) (PREV-LINE IL:FULLXPOINTER) (NODE IL:FULLXPOINTER ) (LINE-ASCENT IL:WORD) (LINE-DESCENT IL:WORD) (LINE-SKIP IL:WORD) (LINE-LENGTH IL:WORD) (INDENT IL:WORD ) YCOORD (CACHE-TIME IL:WORD) CACHED-Y (CACHED-ASCENT IL:WORD) (CACHED-DESCENT IL:WORD)) (IL:ACCESSFNS (LINE-HEIGHT (IL:IPLUS (IL:FETCH LINE-SKIP IL:OF IL:DATUM) (IL:FETCH LINE-ASCENT IL:OF IL:DATUM) ( IL:FETCH LINE-DESCENT IL:OF IL:DATUM)))) (IL:ACCESSFNS (BASE-LINE-Y (IL:IDIFFERENCE (IL:ADD1 (IL:FETCH YCOORD IL:OF IL:DATUM)) (IL:IPLUS (IL:FETCH LINE-SKIP IL:OF IL:DATUM) (IL:FETCH LINE-ASCENT IL:OF IL:DATUM))))) (IL:ACCESSFNS (NEXT-LINE-Y (IL:IDIFFERENCE (IL:FETCH YCOORD IL:OF IL:DATUM) (IL:FETCH LINE-HEIGHT IL:OF IL:DATUM)))) (IL:ACCESSFNS (OLD-TOP (IF (EQ (IL:FETCH CACHE-TIME IL:OF IL:DATUM) ( IL:|fetch| RELINEARIZATION-TIME-STAMP IL:|of| CONTEXT)) (IL:SUB1 (IL:IPLUS (IL:FETCH CACHED-Y IL:OF IL:DATUM) (IL:FETCH CACHED-ASCENT IL:OF IL:DATUM))) (IL:FETCH YCOORD IL:OF IL:DATUM)))) (IL:ACCESSFNS (OLD-BOTTOM (IF (EQ (IL:FETCH CACHE-TIME IL:OF IL:DATUM) (IL:|fetch| RELINEARIZATION-TIME-STAMP IL:|of| CONTEXT)) (IL:IDIFFERENCE (IL:FETCH CACHED-Y IL:OF IL:DATUM) (IL:FETCH CACHED-DESCENT IL:OF IL:DATUM) ) (IL:ADD1 (IL:FETCH NEXT-LINE-Y IL:OF IL:DATUM)))))) (IL:DATATYPE LIST-FORMAT (LIST-FORMATS LIST-INLINE? LIST-PFORMAT LIST-MFORMAT LIST-SUBLISTS) ( IL:ACCESSFNS (NON-STANDARD? (NULL (IL:|fetch| LIST-FORMATS IL:|of| IL:DATUM)))) (IL:ACCESSFNS ( SET-FORMAT-LIST (IL:|fetch| LIST-INLINE? IL:|of| IL:DATUM))) (IL:ACCESSFNS (CFVLIST (IL:|fetch| LIST-PFORMAT IL:|of| IL:DATUM))) (IL:ACCESSFNS (LINEARIZE-LIST (IL:|fetch| LIST-MFORMAT IL:|of| IL:DATUM ))) LIST-SUBLISTS IL:_ NIL) (IL:RECORD OPEN-STRING (REAL-LENGTH SUBSTRING . BUFFER-STRING)) (IL:DATATYPE STRING-ITEM (STRING (WIDTH IL:WORD) (FONT IL:FULLXPOINTER) (PRIN-2? IL:FLAG))) (IL:DATATYPE WEAK-LINK ((DESTINATION IL:FULLXPOINTER))) (IL:/DECLAREDATATYPE (QUOTE BROKEN-ATOM) (QUOTE (IL:POINTER)) (QUOTE ((BROKEN-ATOM 0 IL:POINTER))) ( QUOTE 2)) (IL:/DECLAREDATATYPE (QUOTE EDIT-CONTEXT) (QUOTE (IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:FLAG IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:POINTER IL:FULLXPOINTER IL:WORD IL:FULLXPOINTER IL:FULLXPOINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:FULLXPOINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER)) (QUOTE ((EDIT-CONTEXT 0 IL:POINTER) (EDIT-CONTEXT 2 IL:POINTER) ( EDIT-CONTEXT 4 IL:POINTER) (EDIT-CONTEXT 6 IL:POINTER) (EDIT-CONTEXT 8 IL:POINTER) (EDIT-CONTEXT 10 IL:POINTER) (EDIT-CONTEXT 12 IL:POINTER) (EDIT-CONTEXT 14 IL:POINTER) (EDIT-CONTEXT 16 IL:POINTER) ( EDIT-CONTEXT 18 IL:POINTER) (EDIT-CONTEXT 20 IL:POINTER) (EDIT-CONTEXT 22 IL:POINTER) (EDIT-CONTEXT 24 IL:POINTER) (EDIT-CONTEXT 26 IL:POINTER) (EDIT-CONTEXT 28 IL:POINTER) (EDIT-CONTEXT 30 IL:POINTER) ( EDIT-CONTEXT 32 IL:POINTER) (EDIT-CONTEXT 34 IL:POINTER) (EDIT-CONTEXT 36 IL:POINTER) (EDIT-CONTEXT 38 IL:POINTER) (EDIT-CONTEXT 40 IL:POINTER) (EDIT-CONTEXT 42 IL:POINTER) (EDIT-CONTEXT 42 (IL:FLAGBITS . 0)) (EDIT-CONTEXT 44 IL:POINTER) (EDIT-CONTEXT 46 IL:POINTER) (EDIT-CONTEXT 48 IL:POINTER) ( EDIT-CONTEXT 50 IL:POINTER) (EDIT-CONTEXT 52 IL:POINTER) (EDIT-CONTEXT 54 IL:POINTER) (EDIT-CONTEXT 56 IL:POINTER) (EDIT-CONTEXT 58 IL:POINTER) (EDIT-CONTEXT 60 IL:POINTER) (EDIT-CONTEXT 62 IL:POINTER) ( EDIT-CONTEXT 64 IL:POINTER) (EDIT-CONTEXT 66 IL:POINTER) (EDIT-CONTEXT 68 IL:FULLXPOINTER) ( EDIT-CONTEXT 70 IL:POINTER) (EDIT-CONTEXT 72 IL:FULLXPOINTER) (EDIT-CONTEXT 74 (IL:BITS . 15)) ( EDIT-CONTEXT 76 IL:FULLXPOINTER) (EDIT-CONTEXT 78 IL:FULLXPOINTER) (EDIT-CONTEXT 80 IL:POINTER) ( EDIT-CONTEXT 82 IL:POINTER) (EDIT-CONTEXT 84 IL:POINTER) (EDIT-CONTEXT 86 IL:POINTER) (EDIT-CONTEXT 88 IL:POINTER) (EDIT-CONTEXT 90 IL:POINTER) (EDIT-CONTEXT 92 IL:POINTER) (EDIT-CONTEXT 94 IL:POINTER) ( EDIT-CONTEXT 96 IL:POINTER) (EDIT-CONTEXT 98 IL:POINTER) (EDIT-CONTEXT 100 IL:POINTER) (EDIT-CONTEXT 102 IL:POINTER) (EDIT-CONTEXT 104 IL:FULLXPOINTER) (EDIT-CONTEXT 106 IL:FULLXPOINTER) (EDIT-CONTEXT 108 IL:POINTER) (EDIT-CONTEXT 110 IL:POINTER) (EDIT-CONTEXT 112 IL:POINTER) (EDIT-CONTEXT 114 IL:POINTER ) (EDIT-CONTEXT 116 IL:POINTER))) (QUOTE 118)) (IL:/DECLAREDATATYPE (QUOTE EDIT-ENV) (QUOTE (IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER)) (QUOTE ((EDIT-ENV 0 IL:POINTER) (EDIT-ENV 2 IL:POINTER) (EDIT-ENV 4 IL:POINTER) (EDIT-ENV 6 IL:POINTER) (EDIT-ENV 8 IL:POINTER) (EDIT-ENV 10 IL:POINTER) (EDIT-ENV 12 IL:POINTER) (EDIT-ENV 14 IL:POINTER) (EDIT-ENV 16 IL:POINTER) (EDIT-ENV 18 IL:POINTER) (EDIT-ENV 20 IL:POINTER) (EDIT-ENV 22 IL:POINTER) (EDIT-ENV 24 IL:POINTER) (EDIT-ENV 26 IL:POINTER) (EDIT-ENV 28 IL:POINTER) (EDIT-ENV 30 IL:POINTER) (EDIT-ENV 32 IL:POINTER) (EDIT-ENV 34 IL:POINTER) (EDIT-ENV 36 IL:POINTER) (EDIT-ENV 38 IL:POINTER) (EDIT-ENV 40 IL:POINTER) (EDIT-ENV 42 IL:POINTER) (EDIT-ENV 44 IL:POINTER) (EDIT-ENV 46 IL:POINTER))) (QUOTE 48)) (IL:/DECLAREDATATYPE (QUOTE EDIT-NODE) (QUOTE (IL:FULLXPOINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:WORD IL:WORD IL:POINTER IL:POINTER IL:FULLXPOINTER IL:POINTER IL:WORD IL:WORD IL:WORD IL:WORD IL:FLAG IL:POINTER IL:POINTER IL:POINTER IL:POINTER)) (QUOTE ((EDIT-NODE 0 IL:FULLXPOINTER) (EDIT-NODE 2 IL:POINTER) (EDIT-NODE 4 IL:POINTER) (EDIT-NODE 6 IL:FULLXPOINTER) (EDIT-NODE 8 (IL:BITS . 15)) ( EDIT-NODE 9 (IL:BITS . 15)) (EDIT-NODE 10 IL:POINTER) (EDIT-NODE 12 IL:POINTER) (EDIT-NODE 14 IL:FULLXPOINTER) (EDIT-NODE 16 IL:POINTER) (EDIT-NODE 18 (IL:BITS . 15)) (EDIT-NODE 19 (IL:BITS . 15)) (EDIT-NODE 20 (IL:BITS . 15)) (EDIT-NODE 21 (IL:BITS . 15)) (EDIT-NODE 16 (IL:FLAGBITS . 0)) ( EDIT-NODE 22 IL:POINTER) (EDIT-NODE 24 IL:POINTER) (EDIT-NODE 26 IL:POINTER) (EDIT-NODE 28 IL:POINTER) )) (QUOTE 30)) (IL:/DECLAREDATATYPE (QUOTE EDIT-NODE-TYPE) (QUOTE (IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER)) (QUOTE ((EDIT-NODE-TYPE 0 IL:POINTER) ( EDIT-NODE-TYPE 2 IL:POINTER) (EDIT-NODE-TYPE 4 IL:POINTER) (EDIT-NODE-TYPE 6 IL:POINTER) ( EDIT-NODE-TYPE 8 IL:POINTER) (EDIT-NODE-TYPE 10 IL:POINTER) (EDIT-NODE-TYPE 12 IL:POINTER) ( EDIT-NODE-TYPE 14 IL:POINTER) (EDIT-NODE-TYPE 16 IL:POINTER) (EDIT-NODE-TYPE 18 IL:POINTER) ( EDIT-NODE-TYPE 20 IL:POINTER) (EDIT-NODE-TYPE 22 IL:POINTER) (EDIT-NODE-TYPE 24 IL:POINTER) ( EDIT-NODE-TYPE 26 IL:POINTER) (EDIT-NODE-TYPE 28 IL:POINTER) (EDIT-NODE-TYPE 30 IL:POINTER) ( EDIT-NODE-TYPE 32 IL:POINTER) (EDIT-NODE-TYPE 34 IL:POINTER))) (QUOTE 36)) (IL:/DECLAREDATATYPE (QUOTE EDIT-POINT) (QUOTE (IL:FULLXPOINTER IL:POINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:POINTER IL:POINTER)) (QUOTE ((EDIT-POINT 0 IL:FULLXPOINTER) (EDIT-POINT 2 IL:POINTER ) (EDIT-POINT 4 IL:POINTER) (EDIT-POINT 6 IL:POINTER) (EDIT-POINT 8 IL:FULLXPOINTER) (EDIT-POINT 10 IL:POINTER) (EDIT-POINT 12 IL:POINTER))) (QUOTE 14)) (IL:/DECLAREDATATYPE (QUOTE EDIT-SELECTION) (QUOTE (IL:FULLXPOINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:POINTER IL:FULLXPOINTER IL:POINTER IL:POINTER IL:POINTER)) (QUOTE ((EDIT-SELECTION 0 IL:FULLXPOINTER) (EDIT-SELECTION 2 IL:POINTER) (EDIT-SELECTION 4 IL:POINTER) (EDIT-SELECTION 6 IL:POINTER) (EDIT-SELECTION 8 IL:POINTER) (EDIT-SELECTION 10 IL:POINTER ) (EDIT-SELECTION 12 IL:POINTER) (EDIT-SELECTION 14 IL:FULLXPOINTER) (EDIT-SELECTION 16 IL:POINTER) ( EDIT-SELECTION 18 IL:FULLXPOINTER) (EDIT-SELECTION 20 IL:POINTER) (EDIT-SELECTION 22 IL:POINTER) ( EDIT-SELECTION 24 IL:POINTER))) (QUOTE 26)) (IL:/DECLAREDATATYPE (QUOTE GAP) (QUOTE (IL:POINTER)) (QUOTE ((GAP 0 IL:POINTER))) (QUOTE 2)) (IL:/DECLAREDATATYPE (QUOTE LINE-BLOCK) (QUOTE (IL:FULLXPOINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER)) (QUOTE ((LINE-BLOCK 0 IL:FULLXPOINTER) ( LINE-BLOCK 2 IL:POINTER) (LINE-BLOCK 4 IL:POINTER) (LINE-BLOCK 6 IL:POINTER) (LINE-BLOCK 8 IL:POINTER) (LINE-BLOCK 10 IL:POINTER) (LINE-BLOCK 12 IL:POINTER) (LINE-BLOCK 14 IL:POINTER) (LINE-BLOCK 16 IL:POINTER))) (QUOTE 18)) (IL:/DECLAREDATATYPE (QUOTE LINE-START) (QUOTE (IL:FULLXPOINTER IL:FULLXPOINTER IL:FULLXPOINTER IL:WORD IL:WORD IL:WORD IL:WORD IL:WORD IL:POINTER IL:WORD IL:POINTER IL:WORD IL:WORD)) (QUOTE ((LINE-START 0 IL:FULLXPOINTER) (LINE-START 2 IL:FULLXPOINTER) (LINE-START 4 IL:FULLXPOINTER) (LINE-START 6 (IL:BITS . 15)) (LINE-START 7 (IL:BITS . 15)) (LINE-START 8 (IL:BITS . 15)) (LINE-START 9 (IL:BITS . 15)) ( LINE-START 10 (IL:BITS . 15)) (LINE-START 12 IL:POINTER) (LINE-START 11 (IL:BITS . 15)) (LINE-START 14 IL:POINTER) (LINE-START 16 (IL:BITS . 15)) (LINE-START 17 (IL:BITS . 15)))) (QUOTE 18)) (IL:/DECLAREDATATYPE (QUOTE LIST-FORMAT) (QUOTE (IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER )) (QUOTE ((LIST-FORMAT 0 IL:POINTER) (LIST-FORMAT 2 IL:POINTER) (LIST-FORMAT 4 IL:POINTER) ( LIST-FORMAT 6 IL:POINTER) (LIST-FORMAT 8 IL:POINTER))) (QUOTE 10)) (IL:/DECLAREDATATYPE (QUOTE STRING-ITEM) (QUOTE (IL:POINTER IL:WORD IL:FULLXPOINTER IL:FLAG)) (QUOTE ( (STRING-ITEM 0 IL:POINTER) (STRING-ITEM 2 (IL:BITS . 15)) (STRING-ITEM 4 IL:FULLXPOINTER) (STRING-ITEM 3 (IL:FLAGBITS . 0)))) (QUOTE 6)) (IL:/DECLAREDATATYPE (QUOTE WEAK-LINK) (QUOTE (IL:FULLXPOINTER)) (QUOTE ((WEAK-LINK 0 IL:FULLXPOINTER) )) (QUOTE 2)) (IL:RPAQ EDITOR-NAME "SEdit") (IL:RPAQQ IL:MICASPERPT 35.27778) (IL:RPAQQ QUOTE-WRAPPER-LIST (QUOTE QUOTE IL:BQUOTE IL:BQUOTE IL:COMMA IL:\\\, COMMA-AT IL:\\\,@ COMMA-DOT IL:\\\,. FUNCTION FUNCTION)) (IL:CONSTANTS (EDITOR-NAME "SEdit") (IL:MICASPERPT 35.27778) (QUOTE-WRAPPER-LIST (QUOTE (QUOTE QUOTE IL:BQUOTE IL:BQUOTE IL:COMMA IL:\\\, COMMA-AT IL:\\\,@ COMMA-DOT IL:\\\,. FUNCTION FUNCTION)))) (IL:PUTPROPS GET-PROMPT-WINDOW IL:MACRO ((CONTEXT) (IL:GETPROMPTWINDOW (IL:|fetch| DISPLAY-WINDOW IL:|of| CONTEXT)))) (IL:PUTPROPS EVAL-IN-PROCESS IL:MACRO (NIL (LET* ((PROCESS (IF (EQ (IL:PROCESSPROP (IL:THIS.PROCESS) ( QUOTE IL:NAME)) (QUOTE IL:MOUSE)) (IL:TTY.PROCESS) (IL:THIS.PROCESS))) (PROCFORM (IL:PROCESSPROP PROCESS (QUOTE IL:FORM)))) (COND ((EQ (CAR PROCFORM) (QUOTE EDIT1)) (IL:|fetch| EVAL-IN-PROCESS IL:|of| (CADADR PROCFORM))) (T PROCESS))))) (IL:PUTPROPS LOOKUP-COMMAND IL:MACRO ((CHAR TABLE) (GETHASH CHAR TABLE))) (IL:PUTPROPS QUOTE-WRAPPER IL:MACRO (TYPE (COND ((AND (IL:LISTP (CAR TYPE)) (EQ (CAAR TYPE) (QUOTE QUOTE))) (IF (IL:LISTP (CADAR TYPE)) (IL:KWOTE (IL:|for| W IL:|in| (CADAR TYPE) IL:|collect| (IL:LISTGET QUOTE-WRAPPER-LIST W))) (IL:KWOTE (IL:LISTGET QUOTE-WRAPPER-LIST (CADAR TYPE))))) (T (IL:BQUOTE ( IL:LISTGET QUOTE-WRAPPER-LIST (IL:\\\, (CAR TYPE)))))))) (IL:PUTPROPS QUOTE-WRAPPER-NAME IL:MACRO ((TYPE) (IL:LISTGET (IL:CONSTANT (IL:REVERSE QUOTE-WRAPPER-LIST)) TYPE))) (IL:PUTPROPS REPAINT-NEW-LINE IL:MACRO (IL:OPENLAMBDA (LINE) (WHEN (IL:ILESSP (IL:|fetch| NEXT-LINE-Y IL:|of| (CAR LINE)) (IL:|fetch| WINDOW-TOP IL:|of| CONTEXT)) (REPAINT CONTEXT (IL:|fetch| INDENT IL:|of| (CAR LINE)) (IL:|fetch| BASE-LINE-Y IL:|of| (CAR LINE)) (CDR LINE) (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT)) (WHEN (IL:ILESSP (IL:|fetch| NEXT-LINE-Y IL:|of| (CAR LINE)) (IL:|fetch| WINDOW-BOTTOM IL:|of| CONTEXT)) (IL:|replace| BELOW? IL:|of| CONTEXT IL:|with| T))))) (IL:PUTPROPS RESET-CONTROL-VARIABLES IL:MACRO ((CONTEXT) (WHEN (COMPILING-POST-KOTO) (IL:SETQ *PACKAGE* (IL:FETCH PACKAGE IL:OF CONTEXT)) (IL:SETQ *PRINT-ARRAY* NIL) (IL:SETQ *PRINT-BASE* (IL:FETCH PRINT-BASE IL:OF CONTEXT)) (IL:SETQ *PRINT-CASE* (IL:FETCH PRINT-CASE IL:OF CONTEXT)) (IL:SETQ *PRINT-ESCAPE* T) (IL:SETQ *PRINT-GENSYM* T) (IL:SETQ *PRINT-RADIX* NIL)))) (IL:PUTPROPS SELECT-COMMENT-INDENT IL:MACRO ((KEY LEVEL-1-INDENT LEVEL-2-INDENT LEVEL-3-INDENT) ( IL:SELECTQ KEY (1 LEVEL-1-INDENT) (2 LEVEL-2-INDENT) ((3 4 5) LEVEL-3-INDENT) (IL:SHOULDNT "unexpected comment level")))) (IL:PUTPROPS SET-COMMENT-POSITIONS IL:MACRO ((COMMENT-START-X COMMENT-INDENT FORM-INDENT PAREN-WIDTH NODE CONTEXT) (COND ((IL:IGEQ (IL:IPLUS FORM-INDENT (IL:|fetch| COMMENT-WIDTH IL:|of| CONTEXT)) ( IL:|fetch| RIGHT-MARGIN IL:|of| NODE)) (IL:SETQ COMMENT-START-X (IL:IPLUS (IL:|fetch| START-X IL:|of| NODE) PAREN-WIDTH)) (IL:SETQ COMMENT-INDENT COMMENT-START-X)) (T (IL:SETQ COMMENT-START-X ( IL:IDIFFERENCE (IL:|fetch| RIGHT-MARGIN IL:|of| NODE) (IL:|fetch| COMMENT-WIDTH IL:|of| CONTEXT))) ( IL:SETQ COMMENT-INDENT (IL:IPLUS COMMENT-START-X (IL:|fetch| COMMENT-SEPARATION IL:|of| CONTEXT))))))) (IL:PUTPROPS SET-SELECTION-NOWHERE IL:MACRO ((SELECTION) (IL:|replace| SELECT-NODE IL:|of| SELECTION IL:|with| NIL))) (DEFMACRO CREATE-WEAK-LINK (DEST) (IL:BQUOTE (IL:|create| WEAK-LINK DESTINATION IL:_ (IL:\\\, DEST)))) (IL:PUTPROPS ADVANCE IL:MACRO ((WIDTH) (IL:|add| (IL:|fetch| CURRENT-X IL:|of| CONTEXT) WIDTH))) (IL:PUTPROPS CLOSE-OPEN-NODE IL:MACRO ((CONTEXT) (WHEN (IL:|fetch| OPEN-NODE-CHANGED? IL:|of| CONTEXT) (CLOSE-NODE CONTEXT)))) (IL:PUTPROPS DEAD-NODE? IL:MACRO ((NODE) (EQ 0 (IL:|fetch| DEPTH IL:|of| NODE)))) (IL:PUTPROPS END-UNDO-BLOCK IL:MACRO (NIL (COLLECT-UNDO-BLOCK CONTEXT))) (IL:PUTPROPS ESCAPE-CHAR IL:MACRO ((READ-TABLE) (IL:|fetch| (READTABLEP IL:ESCAPECHAR) IL:|of| (OR READ-TABLE *READTABLE*)))) (IL:PUTPROPS EQ-POINT-TYPE IL:MACRO ((POINT TYPE) (LET ((POINTNODE (IL:|fetch| POINT-NODE IL:|of| POINT))) (IF (IL:|type?| EDIT-SELECTION POINTNODE) (EQ (IL:|fetch| NODE-TYPE IL:|of| (IL:|fetch| SELECT-NODE IL:|of| POINTNODE)) TYPE) (EQ (IL:|fetch| NODE-TYPE IL:|of| POINTNODE) TYPE))))) (IL:PUTPROPS NEXT-LINEAR IL:MACRO ((CONTEXT ITEM) (AND (IL:LISTP (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT)) (EQ (CAR (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT)) ITEM)))) (IL:PUTPROPS SET-LINEAR IL:MACRO (IL:OPENLAMBDA (CONTEXT NEW-LPTR) (IL:|replace| LINEAR-POINTER IL:|of| CONTEXT IL:|with| NEW-LPTR) (IF (IL:LISTP (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT)) (RPLACD (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT) NEW-LPTR) (IL:|replace| LINEAR-FORM IL:|of| (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT) IL:|with| NEW-LPTR)))) (IL:PUTPROPS START-UNDO-BLOCK IL:MACRO (NIL (IL:|push| (IL:|fetch| UNDO-LIST IL:|of| CONTEXT) NIL))) (IL:PUTPROPS STEP-LINEAR IL:MACRO ((CONTEXT) (IL:|replace| LINEAR-POINTER IL:|of| CONTEXT IL:|with| ( CDR (IL:|replace| LINEAR-PREV IL:|of| CONTEXT IL:|with| (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT)))) )) (IL:PUTPROPS SUBNODE IL:MACRO (X (IF (EQ (CAR X) 1) (LIST (QUOTE CADR) (LIST (QUOTE IL:FETCH) (QUOTE SUB-NODES) (CADR X))) (LIST (QUOTE CADR) (LIST (QUOTE IL:NTH) (LIST (QUOTE IL:FETCH) (QUOTE SUB-NODES) (CADR X)) (CAR X)))))) (IL:PUTPROPS UNDO-BY IL:MACRO (INFO (LIST (QUOTE IL:PUSH) (QUOTE (IL:|fetch| UNDO-LIST IL:|of| CONTEXT )) (LIST* (QUOTE LIST) (IL:KWOTE (CAR INFO)) (CDR INFO))))) (IL:PUTPROPS ZAP-CLISP-TRANSLATION IL:MACRO ((X) (AND IL:CLISPARRAY (IL:PUTHASH X NIL IL:CLISPARRAY))) ) (IL:PUTPROPS SMASH-USING IL:MACRO (X (IL:|bind| (SRC IL:_ (IF (IL:ATOM (CADDR X)) (CADDR X) (QUOTE $$SOURCE))) DEST (DESCR IL:_ (IL:GETDESCRIPTORS (CAR X))) IL:|first| (IL:SETQ DEST (LIST (QUOTE IL:REPLACEFIELDVAL) (LIST (QUOTE QUOTE) (CAR DESCR)) (CADR X) (LIST (QUOTE IL:FETCHFIELD) (LIST (QUOTE QUOTE) (CAR DESCR)) SRC))) (IL:SETQ DESCR (CDR DESCR)) IL:|while| DESCR IL:|do| (IL:SETQ DEST (LIST ( QUOTE IL:FREPLACEFIELDVAL) (LIST (QUOTE QUOTE) (CAR DESCR)) DEST (LIST (QUOTE IL:FETCHFIELD) (LIST ( QUOTE QUOTE) (CAR DESCR)) SRC))) (IL:SETQ DESCR (CDR DESCR)) IL:|finally| (WHEN (NOT (IL:ATOM (CADDR X ))) (IL:SETQ DEST (LIST (QUOTE LET) (LIST (LIST (QUOTE $$SOURCE) (CADDR X))) DEST))) (RETURN DEST)))) (IL:PUTPROPS IL:HALF IL:MACRO ((IL:X) (IL:LRSH IL:X 1))) (DEFPARAMETER *IL-CL-CONFLICTS* (QUOTE (IL:*PRINT-STRUCTURE* IL:* IL:APPEND IL:APPLY IL:ASSOC IL:ATOM IL:BLOCK IL:CHARACTER IL:EQUAL IL:ERROR IL:FLOATP IL:FORMAT IL:FUNCTION IL:GETHASH IL:IF IL:LAMBDA IL:LENGTH IL:LISTP IL:MAPCAR IL:NTH IL:NUMBER IL:NUMBERP IL:PRIN1 IL:READ IL:REVERSE IL:SETQ IL:SPACE IL:STRINGP IL:TERPRI))) (DEFPARAMETER *IL-IMPORTS* (QUOTE (IL:\" IL:$$ITERATE IL:$$LST1 IL:$$OUT IL:\( IL:*DISPLAY-EDITOR* IL:\, IL:\. IL:.P2 IL:/DECLAREDATATYPE IL:\; IL:|;;| IL:|;;;| IL:? IL:ACCESSFNS IL:ADD.PROCESS IL:ADD1 IL:ADDSPELL IL:ADDSPELLFLG IL:ADDTOVAR IL:ALIST IL:ALISTS IL:ALLOCSTRING IL:APPLY* IL:ASCENT IL:ATM IL:ATTACHWINDOW IL:AWAIT.EVENT IL:BASE IL:BITBLT IL:BITMAPHEIGHT IL:BITMAPS IL:BITMAPWIDTH IL:BITS IL:BKSYSBUF IL:BLACKSHADE IL:BLTSHADE IL:BOLD IL:BOLDFONT IL:BOTTOM IL:BOX IL:BQUOTE IL:BS IL:BUTTONEVENTFN IL:BUTTONS IL:C IL:CASEINSENSITIVE IL:CCODEP IL:CHANGENAME IL:CHANGEOFFSETFLG IL:CHARCODE IL:CHARDELETE IL:CHARWIDTH IL:CHCON1 IL:CLEARBUF IL:CLEARW IL:CLISP\: IL:CLISPARRAY IL:CLISPFONT IL:CLISPTRAN IL:CLISPWORD IL:CLOCK IL:CLOSEFN IL:CLOSEW IL:COLUMN IL:COLUMNSPACE IL:COMMA IL:COMMENTFLG IL:COMMENTFONT IL:COMS IL:COMTAIL IL:CONCAT IL:CONCATLIST IL:CONSTANT IL:CONSTANTS IL:CONTROL IL:COPY IL:COPYALL IL:COPYRIGHT IL:COPYTERMTABLE IL:CR IL:CREATE IL:CREATE.EVENT IL:CREATE.MONITORLOCK IL:CREATEREGION IL:CREATEW IL:CTRL IL:CTRLV IL:CURSORCREATE IL:DATATYPE IL:DATE IL:DATUM IL:DECLARATIONS\: IL:DECLARE\: IL:DEFAULTFONT IL:DEFINEQ IL:DEL IL:DESCENT IL:DOCOPY IL:DOEVAL@COMPILE IL:DON\'T IL:DONTCOPY IL:DONTEVAL@LOAD IL:DONTWAIT IL:DOWINDOWCOM IL:DREMOVE IL:DREVERSE IL:DSP IL:DSPCLIPPINGREGION IL:DSPFONT IL:DSPLINEFEED IL:DSPRIGHTMARGIN IL:DSPXOFFSET IL:DSPXPOSITION IL:DSPYOFFSET IL:|Definition-for-EDITDATE| IL:|Definition-for-EDITE| IL:|Definition-for-EDITL| IL:E IL:ECHOMODE IL:EDIT IL:EDITCHANGES IL:EDITFERROR IL:EDITGETD IL:EDITMACROS IL:EDITMODE IL:ENVIRONMENT IL:EOL IL:EQMEMB IL:ERSETQ IL:ESC IL:ESCAPE IL:ESCAPECHAR IL:EVAL@COMPILE IL:EVALV IL:EXPANDFN IL:EXPANDREGIONFN IL:EXPANDW IL:EXPR IL:EXTENT IL:FCHARACTER IL:FETCHFIELD IL:FILECREATED IL:FILEMAP IL:FILEPKGFLG IL:FILES IL:FILESLOAD IL:FILETYPE IL:FIND.PROCESS IL:FIXEDITDATE IL:FIXP IL:FIXR IL:FLAG IL:FLAGBITS IL:FLASHWINDOW IL:FLENGTH IL:FM.CHANGELABEL IL:FM.CHANGESTATE IL:FM.DONTRESHAPE IL:FM.EDITITEM IL:FM.GETITEM IL:FM.ITEMPROP IL:FM.RESETMENU IL:FMEMB IL:FN IL:FNS IL:FONT IL:FONTCREATE IL:FONTPROP IL:FORM IL:FORWORD IL:FREEMENU IL:FREPLACEFIELDVAL IL:FULLXPOINTER IL:FUNCTIONS IL:GACHA IL:GETD IL:GETDEF IL:GETDESCRIPTORS IL:GETPROMPTWINDOW IL:GETPROP IL:GETPROPLIST IL:GETREGION IL:GETSYNTAX IL:GLOBALVARS IL:GROUP IL:HALF IL:HEIGHT IL:HEIGHTIFWINDOW IL:HELVETICA IL:ICON IL:ICONWINDOW IL:ID IL:IDIFFERENCE IL:IFWORD IL:IGEQ IL:IGREATERP IL:ILEQ IL:ILESSP IL:IMAX IL:IMIN IL:IMINUS IL:IN/SCROLL/BAR? IL:INNERESCQUOTE IL:INFOHOOK IL:INITRECORDS IL:INITVARS IL:INPUT IL:INSIDEP IL:INTERPRESS IL:INVERT IL:IPLUS IL:IQUOTIENT IL:ITALICFONT IL:ITEM IL:ITEMS IL:ITEMWIDTH IL:ITIMES IL:KEYACTION IL:KEYACTIONTABLE IL:KEYBOARDSTREAM IL:KEYDOWNP IL:KWOTE IL:L IL:L-CASE IL:LABEL IL:LASTMOUSESTATE IL:LASTMOUSEX IL:LASTMOUSEY IL:LCONC IL:LEFT IL:LEFTBRACKET IL:LEFTPAREN IL:LEQ IL:LINEDELETE IL:LINKS IL:LISTGET IL:LISTPUT IL:LITATOM IL:LOCALCLOSE IL:LOCALVARS IL:LRSH IL:MACRO IL:MACROS IL:MAINWINDOW IL:MAKEFILE-ENVIRONMENT IL:MARKASCHANGED IL:MARKASCHANGEDFNS IL:MASK IL:MAXWIDTH IL:MEMB IL:MENU IL:MENUFONT IL:MENUOFFSET IL:MESS IL:MICASPERPT IL:MIDDLE IL:MKSTRING IL:MOUSE IL:MOUSECONFIRM IL:MOUSESTATE IL:MOVE IL:MOVETO IL:MULTESCAPECHAR IL:MULTIPLE-ESCAPE IL:NAME IL:NCHARS IL:NCONC1 IL:NEQ IL:NILL IL:NLAMBDA IL:NLISTP IL:NLSETQ IL:NOBIND IL:NONE IL:NOTIFY.EVENT IL:NTHCHARCODE IL:OBTAIN.MONITORLOCK IL:OFFST IL:OPENLAMBDA IL:OPENSTRINGSTREAM IL:OPENWP IL:P IL:PACKAGEDELIM IL:PAINT IL:POINTER IL:PRETTYCOMPRINT IL:PRIN2 IL:PROCESS IL:PROCESS.APPLY IL:PROCESS.EVAL IL:PROCESS.EVALV IL:PROCESSP IL:PROCESSPROP IL:PROCTYPEAHEAD IL:PROMPTFORWORD IL:PROMPTWINDOW IL:PROP IL:PROPLST IL:PROPS IL:PUTD IL:PUTDEF IL:PUTHASH IL:PUTPROP IL:PUTPROPS IL:QUOTIENT IL:READCODE IL:READP IL:READSA IL:RECORD IL:RECORDS IL:RECORDTRAN IL:REDISPLAYW IL:REGION IL:REJECTMAINCOMS IL:RELEASE.MONITORLOCK IL:RELMOVETO IL:REPAINTFN IL:REPLACEFIELDVAL IL:REPOSITIONATTACHEDWINDOWS IL:RESETLST IL:RESETSAVE IL:RESETVAR IL:RESHAPEFN IL:RESTARTABLE IL:RETFROM IL:RETYPE IL:RIGHT IL:RIGHTBRACKET IL:RIGHTBUTTONFN IL:RIGHTPAREN IL:ROWSPACE IL:RPAQ IL:RPAQ? IL:RPAQQ IL:RPLCHARCODE IL:RPLNODE2 IL:RPLSTRING IL:SCROLL.HANDLER IL:SCROLLBYREPAINTFN IL:SCROLLEXTENTUSE IL:SCROLLFN IL:SCROLLW IL:SELCHARQ IL:SELECTEDFN IL:SELECTQ IL:SEPRCHAR IL:SETFS IL:SETINTERRUPT IL:SETPROPLIST IL:SETSYNTAX IL:SETTERMTABLE IL:SHAPEW IL:SHIFT IL:SHIFTDOWNP IL:SHOULDNT IL:SHRINKFN IL:SMALLP IL:SMARTARGLIST IL:SP IL:SPECVARS IL:SPELLFILE IL:STATE IL:STKPOS IL:STREQUAL IL:STRINGDELIM IL:STRINGWIDTH IL:STRPOS IL:SUB1 IL:SUBSTRING IL:SYSRECORDS IL:SYSTEMRECLST IL:TAB IL:TABLE IL:TAIL IL:TCONC IL:TEDIT.INSERT IL:TEDIT.PARALOOKS IL:THIS.PROCESS IL:TIMES IL:TITLE IL:TITLEDICON IL:TITLEDICONW IL:TITLEREG IL:TOP IL:TOTOPW IL:TTY.PROCESS IL:TTY.PROCESSP IL:TTY/EDITDATE IL:TTY/EDITE IL:TTY/EDITL IL:TTY\: IL:TTYDISPLAYSTREAM IL:TTYEXITFN IL:TYPENAME IL:U-CASE IL:UNTILMOUSESTATE IL:UP IL:USEDFREE IL:VARIABLES IL:VARS IL:VARTYPE IL:WAIT.FOR.TTY IL:WHITESHADE IL:WIDTH IL:WINDOW IL:WINDOWADDPROP IL:WINDOWENTRYFN IL:WINDOWPROP IL:WINDOWREGION IL:WITH.MONITOR IL:WORD IL:WORDDELETE IL:WXOFFSET IL:WYOFFSET IL:X IL:Y IL:[ IL:\\\, IL:\\\,. IL:\\\,@ IL:\\ADDBASE IL:\\BACKGROUND IL:\\BLT IL:\\BLTCHAR IL:\\CARET.CREATE IL:\\CARET.DOWN IL:\\CARET.FLASH? IL:\\DEFAULTKEYACTION IL:\\DTEST IL:\\GETBASE IL:\\GETSYSBUF IL:\\KEYBOARD.STREAM IL:\\LINEBUF.OFD IL:\\PUTBASE IL:\\SAVEVMBACKGROUND IL:\\SYNCODE IL:] IL:^ IL:_ IL:ADD IL:ALWAYS IL:AS IL:BIND IL:BY IL:CHANGE IL:|changes| IL:COLLECT IL:COUNT IL:CREATE IL:|date:| IL:DO IL:EACHTIME IL:ELSE IL:ELSEIF IL:FETCH IL:FFETCH IL:FINALLY IL:FIRST IL:FOR IL:FREPLACE IL:FROM WHEN IL:IN IL:INSTRING IL:JOIN IL:LARGEST IL:NEVER IL:OF IL:OLD IL:ON IL:OUTOF IL:POP IL:|previous| IL:|printout| IL:PUSH IL:PUSHNEW IL:REPEATUNTIL IL:REPEATWHILE IL:REPLACE IL:SMALLEST IL:SUM IL:THEN IL:THEREIS IL:TO IL:|to:| IL:TYPE? IL:UNLESS IL:UNTIL IL:USING IL:WHEN IL:WHERE IL:WHILE IL:WITH IL:{ IL:}))) (IL:|printout| T T "EXPORTS.ALL must be loaded to compile SEdit" T) (IL:|printout| T T "SEDIT-ACCESS must be REMADE NEW if you change a record" T) (IL:PUTPROPS IL:SEDIT-DECLS IL:COPYRIGHT ("Xerox Corporation" 1987 1988)) NIL \ No newline at end of file diff --git a/lispusers/MIGRATION/TABLEBROWSERDECLS b/lispusers/MIGRATION/TABLEBROWSERDECLS deleted file mode 100644 index a8a265a1..00000000 --- a/lispusers/MIGRATION/TABLEBROWSERDECLS +++ /dev/null @@ -1,35 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "27-Jan-88 17:04:01" {ERIS}LIBRARY>TABLEBROWSERDECLS.;5 5052 - - changes to%: (RECORDS TABLEBROWSER) - - previous date%: "18-Oct-85 18:10:50" {ERIS}LIBRARY>TABLEBROWSERDECLS.;2) - - -(* " -Copyright (c) 1985, 1988 by Xerox Corporation. All rights reserved. -") - -(PRETTYCOMPRINT TABLEBROWSERDECLSCOMS) - -(RPAQQ TABLEBROWSERDECLSCOMS ((RECORDS TABLEBROWSER TABLEITEM) (CONSTANTS TB.LEFT.MARGIN))) -(DECLARE%: EVAL@COMPILE - -(DATATYPE TABLEBROWSER ((TBREADY FLAG) (TBHEIGHTEXPLICIT FLAG) (* ; "True if creator set explicit item height or baseline") (NIL 6 FLAG) (TBITEMS POINTER) (* ; "List of items in this browser") (TB#ITEMS WORD) (* ; "Number of items") (TB#DELETED WORD) (* ; "Number of items marked deleted") (TB#LINESPERITEM WORD) (* ; "Number of lines occupied by each item, normally 1 (dunno if any other values work)") (TBFIRSTSELECTEDITEM WORD) (* ; "Number of first selected item. If none selected, is > TB#ITEMS") (TBLASTSELECTEDITEM WORD) (* ; "Number of last selected item. If none selected, is 0") (TBITEMHEIGHT WORD) (* ; "Height of an item, i.e., fontheight*linesperitem") (TBMAXXPOS WORD) (* ; "The largest x-position a user printfn has printed to") (TBFONTHEIGHT WORD) (* ; "Height, ascent, descent of font") (TBFONTASCENT WORD) (TBBASELINE WORD) (TBWINDOW POINTER) (* ; "Pointer to the display window. Need to snap this link when browser is closed") (TBLOCK POINTER) (* ; "Monitor lock guarding some browser operations") (TBUSERDATA POINTER) (* ; "Arbitrary user storage") (TBFONT POINTER) (* ; "Pointer to font used by display") (TBEXTENT POINTER) (* ; "Window's extent, updated as items are added, deleted, or printfn prints farther to right") (TBUPDATEFROMHERE POINTER) (* ; "If changes have occurred while shrunk, this gives the # of first item that needs redisplay") (TBCOLUMNS POINTER) (* ; "Number of columns--not yet implemented") (TBPRINTFN POINTER) (* ; "(Browser Item Window) -- displays Item at current line position in window") (TBCOPYFN POINTER) (* ; "(Browser Item) -- copy selects Item") (TBFONTCHANGEFN POINTER) (* ; "(Browser Window) -- called when tb.set.font changes the font") (TBCLOSEFN POINTER) (* ; "(Browser Window Close/Shrink) -- called when you try to close or shrink window") (TBAFTERCLOSEFN POINTER) (* ; "(Browser Window) -- called to cleanup AFTER a closew") (TBTITLEEVENTFN POINTER) (* ; "(Window Browser) -- handles button event in browser's title") (TBLINETHICKNESS POINTER) (* ; "Thickness of line for deletions (normally 1)") (TBORIGIN POINTER) (* ; "Y position of the top of the first item") (TBTAILHINT POINTER) (* ; "A tail of TBITEMS, used to speed up TB.NTH.ITEM") (TBHEADINGWINDOW POINTER) (* ; "An optional %"header window%" that should be horizontally scrolled in synchrony with this one") (NIL POINTER)) -) - -(DATATYPE TABLEITEM ((TISELECTED FLAG) (TIDELETED FLAG) (TIUNDELETABLE FLAG) (TIUNSELECTABLE FLAG) (TIUNCOPYSELECTABLE FLAG) (NIL 3 FLAG) (TIDATA POINTER) (TI# WORD) (NIL WORD)) -) -) -(/DECLAREDATATYPE (QUOTE TABLEBROWSER) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((TABLEBROWSER 0 (FLAGBITS . 0)) (TABLEBROWSER 0 (FLAGBITS . 16)) (TABLEBROWSER 0 (FLAGBITS . 32)) (TABLEBROWSER 0 (FLAGBITS . 48)) (TABLEBROWSER 0 (FLAGBITS . 64)) (TABLEBROWSER 0 (FLAGBITS . 80)) (TABLEBROWSER 0 (FLAGBITS . 96)) (TABLEBROWSER 0 (FLAGBITS . 112)) (TABLEBROWSER 0 POINTER) (TABLEBROWSER 2 (BITS . 15)) (TABLEBROWSER 3 (BITS . 15)) (TABLEBROWSER 4 (BITS . 15)) (TABLEBROWSER 5 (BITS . 15)) (TABLEBROWSER 6 (BITS . 15)) (TABLEBROWSER 7 (BITS . 15)) (TABLEBROWSER 8 (BITS . 15)) (TABLEBROWSER 9 (BITS . 15)) (TABLEBROWSER 10 (BITS . 15)) (TABLEBROWSER 11 (BITS . 15)) (TABLEBROWSER 12 POINTER) (TABLEBROWSER 14 POINTER) (TABLEBROWSER 16 POINTER) (TABLEBROWSER 18 POINTER) (TABLEBROWSER 20 POINTER) (TABLEBROWSER 22 POINTER) (TABLEBROWSER 24 POINTER) (TABLEBROWSER 26 POINTER) (TABLEBROWSER 28 POINTER) (TABLEBROWSER 30 POINTER) (TABLEBROWSER 32 POINTER) (TABLEBROWSER 34 POINTER) (TABLEBROWSER 36 POINTER) (TABLEBROWSER 38 POINTER) (TABLEBROWSER 40 POINTER) (TABLEBROWSER 42 POINTER) (TABLEBROWSER 44 POINTER) (TABLEBROWSER 46 POINTER))) (QUOTE 48)) -(/DECLAREDATATYPE (QUOTE TABLEITEM) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD)) (QUOTE ((TABLEITEM 0 (FLAGBITS . 0)) (TABLEITEM 0 (FLAGBITS . 16)) (TABLEITEM 0 (FLAGBITS . 32)) (TABLEITEM 0 (FLAGBITS . 48)) (TABLEITEM 0 (FLAGBITS . 64)) (TABLEITEM 0 (FLAGBITS . 80)) (TABLEITEM 0 (FLAGBITS . 96)) (TABLEITEM 0 (FLAGBITS . 112)) (TABLEITEM 0 POINTER) (TABLEITEM 2 (BITS . 15)) (TABLEITEM 3 (BITS . 15)))) (QUOTE 4)) -(DECLARE%: EVAL@COMPILE - -(RPAQQ TB.LEFT.MARGIN 8) - -(CONSTANTS TB.LEFT.MARGIN) -) -(PUTPROPS TABLEBROWSERDECLS COPYRIGHT ("Xerox Corporation" 1985 1988)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL))) -STOP diff --git a/lispusers/MIGRATION/TABLEBROWSERDECLS.LCOM b/lispusers/MIGRATION/TABLEBROWSERDECLS.LCOM deleted file mode 100644 index 281ef3ae..00000000 --- a/lispusers/MIGRATION/TABLEBROWSERDECLS.LCOM +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "19-Jan-93 19:57:47" ("compiled on " {DSK}local>src>tape>MIGRATION>TABLEBROWSERDECLS.;1) "11-Jul-91 21:52:09" bcompl'd in "Lispcore 11-Jul-91 ..." dated "11-Jul-91 21:57:45") (FILECREATED "27-Jan-88 17:04:01" {ERIS}LIBRARY>TABLEBROWSERDECLS.;5 5052 changes to%: ( RECORDS TABLEBROWSER) previous date%: "18-Oct-85 18:10:50" {ERIS}LIBRARY>TABLEBROWSERDECLS.;2) (PRETTYCOMPRINT TABLEBROWSERDECLSCOMS) (RPAQQ TABLEBROWSERDECLSCOMS ((RECORDS TABLEBROWSER TABLEITEM) (CONSTANTS TB.LEFT.MARGIN))) (DATATYPE TABLEBROWSER ((TBREADY FLAG) (TBHEIGHTEXPLICIT FLAG) (* ; "True if creator set explicit item height or baseline") (NIL 6 FLAG) (TBITEMS POINTER) (* ; "List of items in this browser") (TB#ITEMS WORD) (* ; "Number of items") (TB#DELETED WORD) (* ; "Number of items marked deleted") (TB#LINESPERITEM WORD) (* ; "Number of lines occupied by each item, normally 1 (dunno if any other values work)") ( TBFIRSTSELECTEDITEM WORD) (* ; "Number of first selected item. If none selected, is > TB#ITEMS") ( TBLASTSELECTEDITEM WORD) (* ; "Number of last selected item. If none selected, is 0") (TBITEMHEIGHT WORD) (* ; "Height of an item, i.e., fontheight*linesperitem") (TBMAXXPOS WORD) (* ; "The largest x-position a user printfn has printed to") (TBFONTHEIGHT WORD) (* ; "Height, ascent, descent of font") (TBFONTASCENT WORD) (TBBASELINE WORD) (TBWINDOW POINTER) (* ; "Pointer to the display window. Need to snap this link when browser is closed") (TBLOCK POINTER) (* ; "Monitor lock guarding some browser operations") (TBUSERDATA POINTER) (* ; "Arbitrary user storage") (TBFONT POINTER) (* ; "Pointer to font used by display") (TBEXTENT POINTER) (* ; "Window's extent, updated as items are added, deleted, or printfn prints farther to right") ( TBUPDATEFROMHERE POINTER) (* ; "If changes have occurred while shrunk, this gives the # of first item that needs redisplay") ( TBCOLUMNS POINTER) (* ; "Number of columns--not yet implemented") (TBPRINTFN POINTER) (* ; "(Browser Item Window) -- displays Item at current line position in window") (TBCOPYFN POINTER) (* ; "(Browser Item) -- copy selects Item") (TBFONTCHANGEFN POINTER) (* ; "(Browser Window) -- called when tb.set.font changes the font") (TBCLOSEFN POINTER) (* ; "(Browser Window Close/Shrink) -- called when you try to close or shrink window") (TBAFTERCLOSEFN POINTER) (* ; "(Browser Window) -- called to cleanup AFTER a closew") (TBTITLEEVENTFN POINTER) (* ; "(Window Browser) -- handles button event in browser's title") (TBLINETHICKNESS POINTER) (* ; "Thickness of line for deletions (normally 1)") (TBORIGIN POINTER) (* ; "Y position of the top of the first item") (TBTAILHINT POINTER) (* ; "A tail of TBITEMS, used to speed up TB.NTH.ITEM") (TBHEADINGWINDOW POINTER) (* ; "An optional %"header window%" that should be horizontally scrolled in synchrony with this one") (NIL POINTER))) (DATATYPE TABLEITEM ((TISELECTED FLAG) (TIDELETED FLAG) (TIUNDELETABLE FLAG) (TIUNSELECTABLE FLAG) ( TIUNCOPYSELECTABLE FLAG) (NIL 3 FLAG) (TIDATA POINTER) (TI# WORD) (NIL WORD))) (/DECLAREDATATYPE (QUOTE TABLEBROWSER) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE (( TABLEBROWSER 0 (FLAGBITS . 0)) (TABLEBROWSER 0 (FLAGBITS . 16)) (TABLEBROWSER 0 (FLAGBITS . 32)) ( TABLEBROWSER 0 (FLAGBITS . 48)) (TABLEBROWSER 0 (FLAGBITS . 64)) (TABLEBROWSER 0 (FLAGBITS . 80)) ( TABLEBROWSER 0 (FLAGBITS . 96)) (TABLEBROWSER 0 (FLAGBITS . 112)) (TABLEBROWSER 0 POINTER) ( TABLEBROWSER 2 (BITS . 15)) (TABLEBROWSER 3 (BITS . 15)) (TABLEBROWSER 4 (BITS . 15)) (TABLEBROWSER 5 (BITS . 15)) (TABLEBROWSER 6 (BITS . 15)) (TABLEBROWSER 7 (BITS . 15)) (TABLEBROWSER 8 (BITS . 15)) ( TABLEBROWSER 9 (BITS . 15)) (TABLEBROWSER 10 (BITS . 15)) (TABLEBROWSER 11 (BITS . 15)) (TABLEBROWSER 12 POINTER) (TABLEBROWSER 14 POINTER) (TABLEBROWSER 16 POINTER) (TABLEBROWSER 18 POINTER) ( TABLEBROWSER 20 POINTER) (TABLEBROWSER 22 POINTER) (TABLEBROWSER 24 POINTER) (TABLEBROWSER 26 POINTER) (TABLEBROWSER 28 POINTER) (TABLEBROWSER 30 POINTER) (TABLEBROWSER 32 POINTER) (TABLEBROWSER 34 POINTER) (TABLEBROWSER 36 POINTER) (TABLEBROWSER 38 POINTER) (TABLEBROWSER 40 POINTER) (TABLEBROWSER 42 POINTER) (TABLEBROWSER 44 POINTER) (TABLEBROWSER 46 POINTER))) (QUOTE 48)) (/DECLAREDATATYPE (QUOTE TABLEITEM) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD) ) (QUOTE ((TABLEITEM 0 (FLAGBITS . 0)) (TABLEITEM 0 (FLAGBITS . 16)) (TABLEITEM 0 (FLAGBITS . 32)) ( TABLEITEM 0 (FLAGBITS . 48)) (TABLEITEM 0 (FLAGBITS . 64)) (TABLEITEM 0 (FLAGBITS . 80)) (TABLEITEM 0 (FLAGBITS . 96)) (TABLEITEM 0 (FLAGBITS . 112)) (TABLEITEM 0 POINTER) (TABLEITEM 2 (BITS . 15)) ( TABLEITEM 3 (BITS . 15)))) (QUOTE 4)) (RPAQQ TB.LEFT.MARGIN 8) (CONSTANTS TB.LEFT.MARGIN) (PUTPROPS TABLEBROWSERDECLS COPYRIGHT ("Xerox Corporation" 1985 1988)) NIL \ No newline at end of file diff --git a/lispusers/H-BLOCKS.HKB b/lispusers/h/H-BLOCKS.HKB similarity index 100% rename from lispusers/H-BLOCKS.HKB rename to lispusers/h/H-BLOCKS.HKB diff --git a/lispusers/H-CUT.HKB b/lispusers/h/H-CUT.HKB similarity index 100% rename from lispusers/H-CUT.HKB rename to lispusers/h/H-CUT.HKB diff --git a/lispusers/H-ENV b/lispusers/h/H-ENV similarity index 100% rename from lispusers/H-ENV rename to lispusers/h/H-ENV diff --git a/lispusers/H-ENV.LCOM b/lispusers/h/H-ENV.LCOM similarity index 100% rename from lispusers/H-ENV.LCOM rename to lispusers/h/H-ENV.LCOM diff --git a/lispusers/H-LOAD b/lispusers/h/H-LOAD similarity index 100% rename from lispusers/H-LOAD rename to lispusers/h/H-LOAD diff --git a/lispusers/H-LOAD.LCOM b/lispusers/h/H-LOAD.LCOM similarity index 100% rename from lispusers/H-LOAD.LCOM rename to lispusers/h/H-LOAD.LCOM diff --git a/lispusers/H-LOOPS.HKB b/lispusers/h/H-LOOPS.HKB similarity index 100% rename from lispusers/H-LOOPS.HKB rename to lispusers/h/H-LOOPS.HKB diff --git a/lispusers/H-MAZE.HKB b/lispusers/h/H-MAZE.HKB similarity index 100% rename from lispusers/H-MAZE.HKB rename to lispusers/h/H-MAZE.HKB diff --git a/lispusers/H-PATCHES b/lispusers/h/H-PATCHES similarity index 100% rename from lispusers/H-PATCHES rename to lispusers/h/H-PATCHES diff --git a/lispusers/H-PATCHES.LCOM b/lispusers/h/H-PATCHES.LCOM similarity index 100% rename from lispusers/H-PATCHES.LCOM rename to lispusers/h/H-PATCHES.LCOM diff --git a/lispusers/H-SOURCE b/lispusers/h/H-SOURCE similarity index 100% rename from lispusers/H-SOURCE rename to lispusers/h/H-SOURCE diff --git a/lispusers/H-SOURCE.LCOM b/lispusers/h/H-SOURCE.LCOM similarity index 100% rename from lispusers/H-SOURCE.LCOM rename to lispusers/h/H-SOURCE.LCOM diff --git a/lispusers/H.TEDIT b/lispusers/h/H.TEDIT similarity index 100% rename from lispusers/H.TEDIT rename to lispusers/h/H.TEDIT diff --git a/lispusers/EXAMPLES.LGC b/lispusers/logic/EXAMPLES.LGC similarity index 100% rename from lispusers/EXAMPLES.LGC rename to lispusers/logic/EXAMPLES.LGC diff --git a/lispusers/LOGIC b/lispusers/logic/LOGIC similarity index 100% rename from lispusers/LOGIC rename to lispusers/logic/LOGIC diff --git a/lispusers/LOGIC-DEVEL b/lispusers/logic/LOGIC-DEVEL similarity index 100% rename from lispusers/LOGIC-DEVEL rename to lispusers/logic/LOGIC-DEVEL diff --git a/lispusers/LOGIC-DEVEL.LCOM b/lispusers/logic/LOGIC-DEVEL.LCOM similarity index 100% rename from lispusers/LOGIC-DEVEL.LCOM rename to lispusers/logic/LOGIC-DEVEL.LCOM diff --git a/lispusers/LOGIC-EXAMPLES.LGC b/lispusers/logic/LOGIC-EXAMPLES.LGC similarity index 100% rename from lispusers/LOGIC-EXAMPLES.LGC rename to lispusers/logic/LOGIC-EXAMPLES.LGC diff --git a/lispusers/LOGIC-UNIFIER b/lispusers/logic/LOGIC-UNIFIER similarity index 100% rename from lispusers/LOGIC-UNIFIER rename to lispusers/logic/LOGIC-UNIFIER diff --git a/lispusers/LOGIC-UNIFIER.LCOM b/lispusers/logic/LOGIC-UNIFIER.LCOM similarity index 100% rename from lispusers/LOGIC-UNIFIER.LCOM rename to lispusers/logic/LOGIC-UNIFIER.LCOM diff --git a/lispusers/LOGIC.LCOM b/lispusers/logic/LOGIC.LCOM similarity index 100% rename from lispusers/LOGIC.LCOM rename to lispusers/logic/LOGIC.LCOM diff --git a/lispusers/LOGIC.LGC b/lispusers/logic/LOGIC.LGC similarity index 100% rename from lispusers/LOGIC.LGC rename to lispusers/logic/LOGIC.LGC diff --git a/lispusers/LOGIC.LISP b/lispusers/logic/LOGIC.LISP similarity index 100% rename from lispusers/LOGIC.LISP rename to lispusers/logic/LOGIC.LISP diff --git a/lispusers/LOGIC.TEDIT b/lispusers/logic/LOGIC.TEDIT similarity index 100% rename from lispusers/LOGIC.TEDIT rename to lispusers/logic/LOGIC.TEDIT diff --git a/lispusers/MAIN.LGC b/lispusers/logic/MAIN.LGC similarity index 100% rename from lispusers/MAIN.LGC rename to lispusers/logic/MAIN.LGC diff --git a/lispusers/MIGRATION/FILEPKGRECORDS b/lispusers/migration-tool/FILEPKGRECORDS similarity index 100% rename from lispusers/MIGRATION/FILEPKGRECORDS rename to lispusers/migration-tool/FILEPKGRECORDS diff --git a/lispusers/MIGRATION/FILEPKGRECORDS.LCOM b/lispusers/migration-tool/FILEPKGRECORDS.LCOM similarity index 100% rename from lispusers/MIGRATION/FILEPKGRECORDS.LCOM rename to lispusers/migration-tool/FILEPKGRECORDS.LCOM diff --git a/lispusers/MIGRATION/IL-CONVERT b/lispusers/migration-tool/IL-CONVERT similarity index 100% rename from lispusers/MIGRATION/IL-CONVERT rename to lispusers/migration-tool/IL-CONVERT diff --git a/lispusers/MIGRATION/IL-CONVERT.LCOM b/lispusers/migration-tool/IL-CONVERT.LCOM similarity index 100% rename from lispusers/MIGRATION/IL-CONVERT.LCOM rename to lispusers/migration-tool/IL-CONVERT.LCOM diff --git a/lispusers/MIGRATION/IL-LOOPS b/lispusers/migration-tool/IL-LOOPS similarity index 100% rename from lispusers/MIGRATION/IL-LOOPS rename to lispusers/migration-tool/IL-LOOPS diff --git a/lispusers/MIGRATION/IL-LOOPS.LCOM b/lispusers/migration-tool/IL-LOOPS.LCOM similarity index 100% rename from lispusers/MIGRATION/IL-LOOPS.LCOM rename to lispusers/migration-tool/IL-LOOPS.LCOM diff --git a/lispusers/MIGRATION/IL-RECORD b/lispusers/migration-tool/IL-RECORD similarity index 100% rename from lispusers/MIGRATION/IL-RECORD rename to lispusers/migration-tool/IL-RECORD diff --git a/lispusers/MIGRATION/IL-RECORD.LCOM b/lispusers/migration-tool/IL-RECORD.LCOM similarity index 100% rename from lispusers/MIGRATION/IL-RECORD.LCOM rename to lispusers/migration-tool/IL-RECORD.LCOM diff --git a/lispusers/MIGRATION/IL-SIM b/lispusers/migration-tool/IL-SIM similarity index 100% rename from lispusers/MIGRATION/IL-SIM rename to lispusers/migration-tool/IL-SIM diff --git a/lispusers/MIGRATION/IL-SIM.LCOM b/lispusers/migration-tool/IL-SIM.LCOM similarity index 100% rename from lispusers/MIGRATION/IL-SIM.LCOM rename to lispusers/migration-tool/IL-SIM.LCOM diff --git a/lispusers/MIGRATION/IL-STARTUP b/lispusers/migration-tool/IL-STARTUP similarity index 100% rename from lispusers/MIGRATION/IL-STARTUP rename to lispusers/migration-tool/IL-STARTUP diff --git a/lispusers/MIGRATION/IL-STARTUP.LCOM b/lispusers/migration-tool/IL-STARTUP.LCOM similarity index 100% rename from lispusers/MIGRATION/IL-STARTUP.LCOM rename to lispusers/migration-tool/IL-STARTUP.LCOM diff --git a/lispusers/MIGRATION/MIGRATION-TOOL b/lispusers/migration-tool/MIGRATION-TOOL similarity index 100% rename from lispusers/MIGRATION/MIGRATION-TOOL rename to lispusers/migration-tool/MIGRATION-TOOL diff --git a/lispusers/MIGRATION/MIGRATION-TOOL.LCOM b/lispusers/migration-tool/MIGRATION-TOOL.LCOM similarity index 100% rename from lispusers/MIGRATION/MIGRATION-TOOL.LCOM rename to lispusers/migration-tool/MIGRATION-TOOL.LCOM diff --git a/lispusers/MIGRATION/DIR.TXT b/lispusers/migration-tool/MIGRATION-TOOL.TXT similarity index 100% rename from lispusers/MIGRATION/DIR.TXT rename to lispusers/migration-tool/MIGRATION-TOOL.TXT diff --git a/lispusers/MIGRATION/TRANSLATOR-ASSISTANT b/lispusers/migration-tool/TRANSLATOR-ASSISTANT similarity index 100% rename from lispusers/MIGRATION/TRANSLATOR-ASSISTANT rename to lispusers/migration-tool/TRANSLATOR-ASSISTANT diff --git a/lispusers/LISPNERD b/obsolete/lispusers/LISPNERD similarity index 100% rename from lispusers/LISPNERD rename to obsolete/lispusers/LISPNERD diff --git a/lispusers/LISPNERD.TEDIT b/obsolete/lispusers/LISPNERD.TEDIT similarity index 100% rename from lispusers/LISPNERD.TEDIT rename to obsolete/lispusers/LISPNERD.TEDIT diff --git a/lispusers/PLOTANDNC-PATCH b/obsolete/lispusers/PLOTANDNC-PATCH similarity index 100% rename from lispusers/PLOTANDNC-PATCH rename to obsolete/lispusers/PLOTANDNC-PATCH diff --git a/lispusers/PS-PATCH b/obsolete/lispusers/PS-PATCH similarity index 100% rename from lispusers/PS-PATCH rename to obsolete/lispusers/PS-PATCH diff --git a/lispusers/microtek.tedit b/obsolete/lispusers/microtek.tedit similarity index 100% rename from lispusers/microtek.tedit rename to obsolete/lispusers/microtek.tedit