github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

Fix issue #1719. (#1726)

Browse Source 
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:
Matt Heffron 2024-05-24 20:42:54 -07:00 committed by GitHub
commit eda9863432
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 356 additions and 409 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

711
lispusers/MANAGER
View File

@ -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

BIN
lispusers/MANAGER.DFASL
View File

Binary file not shown.

54
sources/EDITINTERFACE
View File

@ -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

BIN
sources/EDITINTERFACE.LCOM
View File

Binary file not shown.