Fix issue #1719.
MANAGER called PF with function NAME in a variable. BUT PF is NLAMBDA so didn't eval its argument. Changed to use CL:APPLY*. Moved the process function from a local LAMBDA in Manager.DO.COMMAND to a separate named function. Tweaked prompt strings for the "CopyDef" and "Rename All" item menu commands.
This commit is contained in:
parent
9214a6335a
commit
1c2f9bc395
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-May-2024 09:44:49" {LU}MANAGER.;2 112772
|
||||
(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4 102968
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS Manager.DO.COMMAND)
|
||||
|
||||
:PREVIOUS-DATE "13-Oct-2023 16:41:52" {LU}MANAGER.;1)
|
||||
:PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MANAGERCOMS)
|
||||
@ -81,15 +81,15 @@
|
||||
COMMON-MAKE)
|
||||
(* ; "FILEBROWSER for SEE command")
|
||||
(FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING
|
||||
Manager.ANCHORED-SET-POSITION 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.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
|
||||
Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.DO.COMMAND.PROCFN
|
||||
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.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN)
|
||||
(ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS
|
||||
DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN
|
||||
DEFAULT.EDITDEFA0001))
|
||||
@ -562,7 +562,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
YCOORD _ YPOS])
|
||||
|
||||
(Manager.DO.COMMAND
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 17-May-2024 09:41 by mth")
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 21-May-2024 17:56 by mth")
|
||||
(* ; "Edited 17-May-2024 09:41 by mth")
|
||||
(* ; "Edited 13-Oct-2023 16:28 by mth")
|
||||
(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.")
|
||||
@ -573,386 +574,321 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
then (Manager.GET.ENVIRONMENT FILE)
|
||||
else (MAKE-READER-ENVIRONMENT *PACKAGE* *READTABLE*
|
||||
*READ-BASE*))
|
||||
(* ; "SEdit does not use *package*. ")
|
||||
|
||||
(* ;; "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 (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
|
||||
FILE)))
|
||||
(ADD.PROCESS `[CL:APPLY #'Manager.DO.COMMAND.PROCFN '(,COMMAND ,ITEM ,COMSTYPE ,FILE
|
||||
,MENU]
|
||||
'NAME
|
||||
'MANAGER-COMMAND))
|
||||
NIL])
|
||||
|
||||
(* ;;
|
||||
(Manager.DO.COMMAND.PROCFN
|
||||
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 20-May-2024 11:15 by mth")
|
||||
(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)
|
||||
(APPLY* #'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 "Copy " ITEM " as name: "]
|
||||
(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 (in ALL loaded files) "
|
||||
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 (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES))
|
||||
FILE)))
|
||||
|
||||
(* ;;
|
||||
"I'm assuming that the CAR of the FILEDATES list is the most recent...")
|
||||
|
||||
(FB.FASTSEE.ONEFILE
|
||||
NIL FULLNAME
|
||||
(LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME
|
||||
"..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W))))
|
||||
(TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES))
|
||||
FILE)))
|
||||
(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 (if FILE
|
||||
then (printout T .FONT LAMBDAFONT
|
||||
"Writing CommonLisp source into "
|
||||
FILE ".LSP" .FONT
|
||||
DEFAULTFONT T)
|
||||
(PRINT (COMMON-MAKEFILE FILE)
|
||||
T)
|
||||
else (CL:FORMAT T
|
||||
(FB.FASTSEE.ONEFILE NIL FULLNAME
|
||||
(LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME "..."]
|
||||
(DSPSCROLL 'ON W)
|
||||
(WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN)
|
||||
(TTYDISPLAYSTREAM W)
|
||||
W))))
|
||||
(TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES))
|
||||
FILE)))
|
||||
(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 (if FILE
|
||||
then (printout T .FONT LAMBDAFONT
|
||||
"Writing CommonLisp source into " FILE ".LSP"
|
||||
.FONT DEFAULTFONT T)
|
||||
(PRINT (COMMON-MAKEFILE FILE)
|
||||
T)
|
||||
else (CL:FORMAT T
|
||||
"~&CommonLispify must be selected separately for each file"
|
||||
)))
|
||||
((LIST HARDCOPY) (LISTFILES1 FILE))
|
||||
((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (
|
||||
Manager.SET-ANCHOR
|
||||
COMMAND))
|
||||
(CLEANUP
|
||||
(printout T .FONT LAMBDAFONT "Cleanup..." .FONT
|
||||
DEFAULTFONT T)
|
||||
)))
|
||||
((LIST HARDCOPY) (LISTFILES1 FILE))
|
||||
((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) (Manager.SET-ANCHOR COMMAND))
|
||||
(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))
|
||||
(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")
|
||||
(* ;; " 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)))
|
||||
(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")
|
||||
(* ;; "DATABASEFNS stuff")
|
||||
|
||||
(DB (CL:FORMAT T
|
||||
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
|
||||
SAVEDBFLG LOADDBFLG))
|
||||
(DBFILE
|
||||
(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 LOADDBFLG))
|
||||
(DBON
|
||||
(SETQ LOADDBFLG 'ON)
|
||||
(SETQ SAVEDBFLG 'ON))
|
||||
(DBOFF
|
||||
(SETQ LOADDBFLG 'NO)
|
||||
(SETQ SAVEDBFLG 'NO))
|
||||
(DBASK
|
||||
(SETQ LOADDBFLG 'ASK)
|
||||
(SETQ SAVEDBFLG 'ASK))
|
||||
(DBLOADON (SETQ LOADDBFLG 'YES))
|
||||
(DBSAVEON (SETQ SAVEDBFLG 'YES))
|
||||
(DBLOADOFF (SETQ LOADDBFLG 'NO))
|
||||
(DBSAVEOFF (SETQ SAVEDBFLG 'NO))
|
||||
(DBLOADASK (SETQ LOADDBFLG 'ASK))
|
||||
(DBSAVEASK (SETQ SAVEDBFLG 'ASK))
|
||||
(DBFILEON (PUTPROP FILE 'DATABASE 'YES))
|
||||
(DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
|
||||
(DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
|
||||
(DUMPDB
|
||||
(printout T .FONT LAMBDAFONT
|
||||
"Dumping the Masterscope Database for file " FILE
|
||||
.FONT DEFAULTFONT T)
|
||||
(DUMPDB FILE))
|
||||
(LOADDB
|
||||
(printout T .FONT LAMBDAFONT
|
||||
"Loading the Masterscope Database for file " FILE
|
||||
.FONT DEFAULTFONT T)
|
||||
(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?)))
|
||||
(DB (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
|
||||
SAVEDBFLG LOADDBFLG))
|
||||
(DBFILE
|
||||
(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 LOADDBFLG))
|
||||
(DBON
|
||||
(SETQ LOADDBFLG 'ON)
|
||||
(SETQ SAVEDBFLG 'ON))
|
||||
(DBOFF
|
||||
(SETQ LOADDBFLG 'NO)
|
||||
(SETQ SAVEDBFLG 'NO))
|
||||
(DBASK
|
||||
(SETQ LOADDBFLG 'ASK)
|
||||
(SETQ SAVEDBFLG 'ASK))
|
||||
(DBLOADON (SETQ LOADDBFLG 'YES))
|
||||
(DBSAVEON (SETQ SAVEDBFLG 'YES))
|
||||
(DBLOADOFF (SETQ LOADDBFLG 'NO))
|
||||
(DBSAVEOFF (SETQ SAVEDBFLG 'NO))
|
||||
(DBLOADASK (SETQ LOADDBFLG 'ASK))
|
||||
(DBSAVEASK (SETQ SAVEDBFLG 'ASK))
|
||||
(DBFILEON (PUTPROP FILE 'DATABASE 'YES))
|
||||
(DBFILEOFF (PUTPROP FILE 'DATABASE 'NO))
|
||||
(DBFILEASK (PUTPROP FILE 'DATABASE 'ASK))
|
||||
(DUMPDB
|
||||
(printout T .FONT LAMBDAFONT "Dumping the Masterscope Database for file "
|
||||
FILE .FONT DEFAULTFONT T)
|
||||
(DUMPDB FILE))
|
||||
(LOADDB
|
||||
(printout T .FONT LAMBDAFONT "Loading the Masterscope Database for file "
|
||||
FILE .FONT DEFAULTFONT T)
|
||||
(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.")
|
||||
(* ;; "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 "~&------"))))
|
||||
(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])
|
||||
(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])])
|
||||
|
||||
(Manager.HIGHLIGHT
|
||||
[LAMBDA (ITEM MENU ON) (* ; "Edited 31-Jul-87 17:33 by raf")
|
||||
@ -1772,21 +1708,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS MANAGER COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (25606 102972 (MANAGER 25616 . 26415) (MANAGER.RESET 26417 . 27931) (Manager.ADDADV
|
||||
27933 . 29286) (Manager.ADDTOFILES? 29288 . 29566) (Manager.ALTERMARKING 29568 . 31178) (
|
||||
Manager.ANCHORED-SET-POSITION 31180 . 32283) (Manager.DO.COMMAND 32285 . 63115) (Manager.HIGHLIGHT
|
||||
63117 . 63414) (Manager.PROMPT 63416 . 63729) (Manager.WINDOW 63731 . 64364) (
|
||||
Manager.insurefilehighlights 64366 . 65437) (Manager.CHANGED? 65439 . 65988) (Manager.CHECKFILE 65990
|
||||
. 67089) (Manager.COLLECTCOMS 67091 . 68529) (Manager.COMS.WSF 68531 . 71201) (Manager.COMSOPEN 71203
|
||||
. 75941) (Manager.COMSUPDATE 75943 . 77035) (Manager.HIGHLIGHTED 77037 . 77343) (
|
||||
Manager.INSUREHIGHLIGHTS 77345 . 77903) (Manager.FILECHANGES 77905 . 78204) (Manager.FILELSTCHANGED?
|
||||
78206 . 78534) (Manager.FILESUBTYPES 78536 . 79174) (Manager.GET.ENVIRONMENT 79176 . 81714) (
|
||||
Manager.GETFILE 81716 . 84030) (Manager.INTITLE? 84032 . 84710) (Manager.MAIN.WSF 84712 . 87356) (
|
||||
Manager.MAINCLOSE 87358 . 88468) (Manager.MAINMENUITEMS 88470 . 89547) (Manager.MAINOPEN 89549 . 94942
|
||||
) (Manager.MAINUPDATE 94944 . 95580) (Manager.MAKEFILE.ADV 95582 . 96618) (Manager.MENUCOLUMNS 96620
|
||||
. 97424) (Manager.MENUHASITEM 97426 . 97783) (Manager.MENUITEMS 97785 . 98030) (
|
||||
Manager.REMOVE.DUPLICATE.ADVICE 98032 . 99638) (Manager.RESETSUBITEMS 99640 . 100877) (
|
||||
Manager.SET-ANCHOR 100879 . 101198) (Manager.SORT.COMS 101200 . 101732) (Manager.SORTBYCOLUMN 101734
|
||||
. 102970)))))
|
||||
(FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959
|
||||
. 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) (
|
||||
Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) (
|
||||
Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 .
|
||||
53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED?
|
||||
55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF
|
||||
58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) (
|
||||
Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065
|
||||
. 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) (
|
||||
Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870
|
||||
) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 .
|
||||
79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742
|
||||
. 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS
|
||||
87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) (
|
||||
Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 .
|
||||
93130)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@ -1,16 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "22-Jun-2022 13:32:08"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;45 47672
|
||||
(FILECREATED "21-May-2024 22:10:45" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;2 47745
|
||||
|
||||
:CHANGES-TO (FNS FIXEDITDATE)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:PREVIOUS-DATE "13-May-2022 08:16:23"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;44)
|
||||
:CHANGES-TO (FNS EDITLOADFNS?)
|
||||
|
||||
:PREVIOUS-DATE "22-Jun-2022 13:32:08" {DSK}<home>matt>Interlisp>medley>sources>EDITINTERFACE.;1
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1986-1988, 1990-1991, 2024 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT EDITINTERFACECOMS)
|
||||
@ -374,12 +375,18 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(CDR X])
|
||||
|
||||
(EDITLOADFNS?
|
||||
[LAMBDA (FN STR ASKFLG FILES) (* lmm "20-Nov-86 21:23")
|
||||
(* ;; "Value is name of file from which function or functions can be loaded. If STR is non-NIL, user is asked to approve, and STR used in the message. EDITLOADFNS? is also used by prettyprint")
|
||||
[LAMBDA (FN STR ASKFLG FILES) (* ; "Edited 21-May-2024 18:18 by mth")
|
||||
(* lmm "20-Nov-86 21:23")
|
||||
|
||||
(* ;; "Value is name of file from which function or functions can be loaded. If STR is non-NIL, user is asked to approve, and STR used in the message. EDITLOADFNS? is also used by prettyprint")
|
||||
|
||||
(AND FN FILEPKGFLG (PROG ((LST (WHEREIS FN 'FNS FILES))
|
||||
FILE DATES FD)
|
||||
(OR (COND
|
||||
((EQ FILES T) (* ;; "if FILES = T, means consult data base. if user has removed a function from one of those files, as evidenced by the fact that editloafns? was called with files=T, then dont offer that file.")
|
||||
((EQ FILES T)
|
||||
|
||||
(* ;; "if FILES = T, means consult data base. if user has removed a function from one of those files, as evidenced by the fact that editloafns? was called with files=T, then dont offer that file.")
|
||||
|
||||
(SETQ LST (LDIFFERENCE LST FILELST)))
|
||||
(T LST))
|
||||
(RETURN))
|
||||
@ -394,8 +401,10 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(RETURN)))
|
||||
(T (CAR LST]
|
||||
[SETQ DATES (LISTP (GETPROP FILE 'FILEDATES]
|
||||
(* ;;
|
||||
"only look at file in FILEDATES if the file has been LOADed or LOADFROMd")
|
||||
|
||||
(* ;;
|
||||
"only look at file in FILEDATES if the file has been LOADed or LOADFROMd")
|
||||
|
||||
(SETQ FILE (OR (AND DATES (FMEMB (CDAR (GETPROP FILE 'FILE))
|
||||
'(LOADFNS T))
|
||||
(INFILEP (CDAR DATES)))
|
||||
@ -412,15 +421,16 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
"found a goood version of file on a different name. smash name")
|
||||
(/RPLACD (CAR DATES)
|
||||
FILE))
|
||||
(T (CL:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded."
|
||||
(T (CL:FORMAT *TERMINAL-IO* "*** Note: loading definition from ~A dated ~A~&while file ~A dated ~A is the version currently loaded."
|
||||
FILE FD (CDAR DATES)
|
||||
(CAAR DATES]
|
||||
(COND
|
||||
((STREQUAL STR ""))
|
||||
((NULL ASKFLG)
|
||||
(if STR
|
||||
then (EXEC-FORMAT "~&~A~A" STR FILE)
|
||||
else (EXEC-FORMAT "~&Loading definition of ~S from ~A." FN FILE)))
|
||||
then (EXEC-FORMAT "~&~A~A~&" STR FILE)
|
||||
else (EXEC-FORMAT "~&Loading definition of ~S from ~A.~&" FN FILE)
|
||||
))
|
||||
((NEQ (ASKUSER DWIMWAIT 'Y (LIST FN STR FILE)
|
||||
NIL T)
|
||||
'Y)
|
||||
@ -942,13 +952,13 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
|
||||
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2024))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4089 10388 (ED 4089 . 10388)) (10390 14366 (INSTALL-PROTOTYPE-DEFN 10390 . 14366)) (
|
||||
14367 31150 (EDITDEF.FNS 14377 . 15713) (EDITF 15715 . 16595) (EDITFB 16597 . 17445) (EDITFNS 17447 .
|
||||
18767) (EDITLOADFNS? 18769 . 22569) (EDITMODE 22571 . 24581) (EDITP 24583 . 25094) (EDITV 25096 .
|
||||
25735) (DC 25737 . 26418) (DF 26420 . 27462) (DP 27464 . 28548) (DV 28550 . 29122) (EDITPROP 29124 .
|
||||
29343) (EF 29345 . 29674) (EP 29676 . 29859) (EV 29861 . 30040) (EDITE 30042 . 30920) (EDITL 30922 .
|
||||
31148)) (31500 46817 (NEW/EDITDATE 31510 . 31732) (FIXEDITDATE 31734 . 40341) (EDITDATE? 40343 . 43371
|
||||
) (EDITDATE 43373 . 44820) (SETINITIALS 44822 . 46815)))))
|
||||
(FILEMAP (NIL (4081 10380 (ED 4081 . 10380)) (10382 14358 (INSTALL-PROTOTYPE-DEFN 10382 . 14358)) (
|
||||
14359 31218 (EDITDEF.FNS 14369 . 15705) (EDITF 15707 . 16587) (EDITFB 16589 . 17437) (EDITFNS 17439 .
|
||||
18759) (EDITLOADFNS? 18761 . 22637) (EDITMODE 22639 . 24649) (EDITP 24651 . 25162) (EDITV 25164 .
|
||||
25803) (DC 25805 . 26486) (DF 26488 . 27530) (DP 27532 . 28616) (DV 28618 . 29190) (EDITPROP 29192 .
|
||||
29411) (EF 29413 . 29742) (EP 29744 . 29927) (EV 29929 . 30108) (EDITE 30110 . 30988) (EDITL 30990 .
|
||||
31216)) (31568 46885 (NEW/EDITDATE 31578 . 31800) (FIXEDITDATE 31802 . 40409) (EDITDATE? 40411 . 43439
|
||||
) (EDITDATE 43441 . 44888) (SETINITIALS 44890 . 46883)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user