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

Manager (Lispusers) grow anchor, icon, and fix typo. (#1346)

Browse Source 
* File See operations use full path to loaded file.
Add Manager.WINDOW-ANCHOR to fix corner from which MANAGER-MAIN-WINDOW grows, and (attempt) to keep it on-screen.

* Improved handling of the ICONW for MANAGER-MAIN-WINDOW.

* Fix typo in MasterScope functions (multiple occurrences: LOADBFLG should be LOADDBFLG).
Changed to CL compiler by default (not need to go to submenu). This is my preference, so I should remove it before setting pull request.

* Manual cleanup of multiple "Edited" comments in 4 FNS.
Reverted: Changed to CL compiler by default (not need to go to submenu). (From commit f60c6362)

* Update MANAGER.TEDIT documentation file.
Fix error in previous commit. (Changes that I thought were there, were not.)
Cleanup COMMON-MAKE COMS so it can be handled by the file package, and add .LCOM file to the repo.
This commit is contained in:
Matt Heffron
2023-10-14 06:39:13 -07:00
committed by GitHub
parent f1833861cc
commit d92aa6395a
8 changed files with 466 additions and 450 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
lispusers/COMMON-MAKE
View File

@@ -1,27 +1,26 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "11-Dec-87 14:48:16" {DSK}<XAVIER>COMMON-MAKE.;5 15290
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS COMMON-MAKECOMS)
(FNS COMMON-FILE-COMMAND COMMON-MAKEFILE)
(PROPS (COMMON-MAKE MAKEFILE-ENVIRONMENT))
(FILECREATED "13-Oct-2023 16:40:48" {LU}COMMON-MAKE.;2 14315
previous date%: "11-Dec-87 12:53:46" {DSK}<XAVIER>COMMON-MAKE.;1)
:EDIT-BY "mth"
:CHANGES-TO (VARS COMMON-MAKECOMS)
:PREVIOUS-DATE "11-Dec-87 14:48:16" {LU}COMMON-MAKE.;1)
(* "
Copyright (c) 1987 by Unisys Corp.. All rights reserved.
")
(PRETTYCOMPRINT COMMON-MAKECOMS)
(RPAQQ COMMON-MAKECOMS ((* FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES)
(RPAQQ COMMON-MAKECOMS [
(* ;; "FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES")
(FNS COMMON-FILE-COMMAND COMMON-MAKEFILE)
(PROP MAKEFILE-ENVIRONMENT COMMON-MAKE)
(EDITHIST COMMON-MAKE)))
(DECLARE%: DONTCOPY (ALISTS (EDITHISTALIST COMMON-MAKE])
(* FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES)
(* ;; "FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES")
(DEFINEQ
@@ -227,30 +226,20 @@ Copyright (c) 1987 by Unisys Corp.. All rights reserved.
(CLOSEF *STANDARD-OUTPUT*])
)
(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(DECLARE%: DONTCOPY
(ADDTOVAR EDITHISTALIST (COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}<XAVIER>COMMON-MAKE.;1
(COMMON-FILE-COMMAND COMMON-MAKEFILE))
("11-Dec-87 13:35:35" DJVB {DSK}<XAVIER>COMMON-MAKE.;2 (
COMMON-FILE-COMMAND
COMMON-MAKEFILE
)
(GETTING DETAILS RIGHT))
("11-Dec-87 13:40:48" DJVB {DSK}<XAVIER>COMMON-MAKE.;3 (
COMMON-FILE-COMMAND
))
("11-Dec-87 14:09:04" DJVB {DSK}<XAVIER>COMMON-MAKE.;4 (
COMMON-FILE-COMMAND
))
("11-Dec-87 14:48:44" DJVB {DSK}<XAVIER>COMMON-MAKE.;5 (
COMMON-FILE-COMMAND
)
(FIXED FILE COMMENTS AND CL:DEFVAR ET AL))))
(ADDTOVAR EDITHISTALIST
(COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}<XAVIER>COMMON-MAKE.;1 (COMMON-FILE-COMMAND
COMMON-MAKEFILE))
("11-Dec-87 13:35:35" DJVB {DSK}<XAVIER>COMMON-MAKE.;2 (COMMON-FILE-COMMAND
COMMON-MAKEFILE)
(GETTING DETAILS RIGHT))
("11-Dec-87 13:40:48" DJVB {DSK}<XAVIER>COMMON-MAKE.;3 (COMMON-FILE-COMMAND))
("11-Dec-87 14:09:04" DJVB {DSK}<XAVIER>COMMON-MAKE.;4 (COMMON-FILE-COMMAND))
("11-Dec-87 14:48:44" DJVB {DSK}<XAVIER>COMMON-MAKE.;5 (COMMON-FILE-COMMAND)
(FIXED FILE COMMENTS AND CL:DEFVAR ET AL))))
)
(PUTPROPS COMMON-MAKE COPYRIGHT ("Unisys Corp." 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (829 13460 (COMMON-FILE-COMMAND 839 . 9055) (COMMON-MAKEFILE 9057 . 13458)))))
(FILEMAP (NIL (722 13353 (COMMON-FILE-COMMAND 732 . 8948) (COMMON-MAKEFILE 8950 . 13351)))))
STOP
ÿ

BIN
lispusers/COMMON-MAKE.LCOM Normal file
View File

Binary file not shown.

287
lispusers/MANAGER
View File

@@ -1,16 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Sep-2022 23:39:36" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;2 111145
(FILECREATED "13-Oct-2023 16:41:52" {LU}MANAGER.;3 112648
:EDIT-BY "mth"
:CHANGES-TO (FNS Manager.DO.COMMAND)
(VARS MANAGERCOMS MANAGER-FILE-OPERATIONS-COMMANDS)
:PREVIOUS-DATE "10-Feb-2022 22:17:51" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;1)
:PREVIOUS-DATE "10-Oct-2023 11:27:25" {LU}MANAGER.;1)
(* ; "
Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
")
(PRETTYCOMPRINT MANAGERCOMS)
(RPAQQ MANAGERCOMS
@@ -52,11 +51,12 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
(* ;; "")
(SPECVARS Manager.ACTIVEFLG MANAGER-CASES MANAGER-ADDTOFILES?)
(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG
(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADDBFLG 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)
MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW
MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR MANAGER.BM MANAGER.BM.MASK
BackgroundMenuCommands BackgroundMenu)
(VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES)
(MANAGER-ADDTOFILES?)
MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS
@@ -64,28 +64,33 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
MANAGER-MAIN-MENU-ITEMS MANAGER.BM MANAGER.BM.MASK)
(INITVARS (Manager.ACTIVEFLG NIL)
(Manager.SORTFILELSTFLG T)
(Manager.WINDOW-ANCHOR 'ANCHOR-BL)
(Manager.MENUROWS 20)
(Manager.DATASPACE NIL)
(MANAGER-WINDOWS NIL)
(MANAGER-MAIN-WINDOW NIL)
(MANAGER-MAIN-ICONW (ICONW MANAGER.BM MANAGER.BM.MASK
(create POSITION XCOORD _ 0 YCOORD _ 0)
T))
(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")
(FILES DATABASEFNS FILEBROWSER (FROM LISPUSERS)
COMMON-MAKE)
(* ; "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.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.SORT.COMS Manager.SORTBYCOLUMN)
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))
@@ -181,10 +186,11 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG
(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADDBFLG 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)
MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR
MANAGER.BM MANAGER.BM.MASK BackgroundMenuCommands BackgroundMenu)
)
(RPAQQ *UNMANAGED-TYPES* (EXPRESSIONS FILES FIELDS FILEVARS-ARE-NOW-OK))
@@ -368,6 +374,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
("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.")
("Set Window Anchor" 'ANCHOR-BL
"Set the anchor corner for window growth to Bottom Left (default)"
(SUBITEMS (" Top Left " 'ANCHOR-TL "Set the anchor corner to Top Left")
(" Top Right " 'ANCHOR-TR "Set the anchor corner to Top Right")
(" Bottom Left " 'ANCHOR-BL "Set the anchor corner to Bottom Left")
(" Bottom Right " 'ANCHOR-BR "Set the anchor corner to Bottom Right")))
("Quit" 'QUIT "Shut down all manager windows" (SUBITEMS ("Quit" 'QUIT
"Shut down all manager windows"
)
@@ -385,6 +397,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(RPAQ? Manager.SORTFILELSTFLG T)
(RPAQ? Manager.WINDOW-ANCHOR 'ANCHOR-BL)
(RPAQ? Manager.MENUROWS 20)
(RPAQ? Manager.DATASPACE NIL)
@@ -393,6 +407,9 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(RPAQ? MANAGER-MAIN-WINDOW NIL)
(RPAQ? MANAGER-MAIN-ICONW (ICONW MANAGER.BM MANAGER.BM.MASK (create POSITION XCOORD _ 0 YCOORD _ 0)
T))
(RPAQ? MANAGER-OPEN-WINDOWS NIL)
(RPAQ? MANAGER-FILE-MENU NIL)
@@ -405,11 +422,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(RPAQ? MANAGER-MARKED-SHADE BOLDMENUFONT)
(FILESLOAD FILEBROWSER)
(FILESLOAD DATABASEFNS FILEBROWSER (FROM LISPUSERS)
COMMON-MAKE)
(* ; "for SEE command")
(* ; "FILEBROWSER for SEE command")
(DEFINEQ
@@ -522,11 +540,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(Manager.HIGHLIGHT ITEM MENU MARKING?))) finally (Manager.MAINUPDATE
UPDATEFILES])
(Manager.ANCHORED-SET-POSITION
[LAMBDA (IW IH) (* ; "Edited 10-Oct-2023 11:22 by mth")
(LET (WREGION XPOS YPOS TEMP)
(SETQ WREGION (WINDOWPROP MANAGER-MAIN-WINDOW 'REGION))
(SETQ YPOS (fetch (REGION BOTTOM) of WREGION))
(if (FMEMB Manager.WINDOW-ANCHOR '(ANCHOR-TL ANCHOR-TR))
then (SETQ YPOS (- (+ YPOS (fetch (REGION HEIGHT) of WREGION))
IH)))
(SETQ TEMP (+ YPOS IH))
(if (>= TEMP SCREENHEIGHT)
then (SETQ YPOS (- SCREENHEIGHT 1)))
(SETQ XPOS (fetch (REGION LEFT) of WREGION))
(if (FMEMB Manager.WINDOW-ANCHOR '(ANCHOR-TR ANCHOR-BR))
then (SETQ XPOS (- (+ XPOS (fetch (REGION WIDTH) of WREGION))
IW)))
(SETQ TEMP (+ XPOS IW))
(if (>= TEMP SCREENWIDTH)
then (SETQ XPOS (- SCREENWIDTH 1)))
(create POSITION
XCOORD _ XPOS
YCOORD _ YPOS])
(Manager.DO.COMMAND
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 15-Sep-2022 23:35 by Matt Heffron")
(* ; "Edited 15-Sep-2022 23:32 by Matt Heffron")
(* ; "Edited 15-Sep-2022 23:19 by Matt Heffron")
(* ; "Edited 18-Nov-87 14:30 by raf")
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "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.")
)
@@ -719,15 +756,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(Manager.HIGHLIGHT FILE MENU)))
else (* ; "single item")
(UNMARKASCHANGED ITEM COMSTYPE)))
(SEE (FB.FASTSEE.ONEFILE
NIL FILE (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE
"..."]
(DSPSCROLL 'ON W)
(WINDOWPROP W 'PAGEFULLFN
'FB.SEEFULLFN)
(TTYDISPLAYSTREAM W)
W)))
(TEDIT-SEE (TEDIT-SEE FILE))
(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)
@@ -748,18 +792,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
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
(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)
@@ -821,68 +867,42 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(* ;; "DATABASEFNS stuff")
(DB
(FILESLOAD 'DATABASEFNS)
(CL:FORMAT T
(DB (CL:FORMAT T
"~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a"
SAVEDBFLG LOADBFLG))
SAVEDBFLG LOADDBFLG))
(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))
SAVEDBFLG LOADDBFLG))
(DBON
(FILESLOAD 'DATABASEFNS)
(SETQ LOADBFLG 'ON)
(SETQ LOADDBFLG 'ON)
(SETQ SAVEDBFLG 'ON))
(DBOFF
(FILESLOAD 'DATABASEFNS)
(SETQ LOADBFLG 'OFF)
(SETQ SAVEDBFLG 'OFF))
(SETQ LOADDBFLG 'NO)
(SETQ SAVEDBFLG 'NO))
(DBASK
(FILESLOAD 'DATABASEFNS)
(SETQ LOADBFLG 'ASK)
(SETQ LOADDBFLG '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))
(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)
(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
@@ -1372,7 +1392,7 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
FILE])
(Manager.MAINOPEN
[LAMBDA (POSITION) (* ; "Edited 17-Aug-87 13:59 by raf")
[LAMBDA (POSITION) (* ; "Edited 10-Oct-2023 11:23 by mth")
(* ;;; "Builds the manager main (FILELST) menu at the indicated position.")
@@ -1387,31 +1407,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(ADDMENU MANAGER-FILE-MENU
(SETQ MANAGER-MAIN-WINDOW
(CREATEW (with POSITION
(with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW IMAGEWIDTH)
SCREENWIDTH))
(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))
(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 (Manager.ANCHORED-SET-POSITION IW IH)
(* ;; "(with REGION (WINDOWPROP MANAGER-MAIN-WINDOW (QUOTE REGION)) (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM))")
(CLOSEW MANAGER-MAIN-WINDOW))
else (* ;
 "let user say where to put the menu")
(GETBOXPOSITION IW IH)))
(GETBOXPOSITION IW IH)))
(create REGION
LEFT _ XCOORD
WIDTH _ IW
@@ -1434,17 +1453,18 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(* ;; "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)))
[WINDOWPROP IW 'EXPANDFN
(FUNCTION (LAMBDA NIL
(
 Manager.MAINUPDATE
NIL]
IW]
(SETQ MANAGER-MAIN-ICONW
(if (NULL OICON)
then (OR MANAGER-MAIN-ICONW
(ICONW MANAGER.BM
MANAGER.BM.MASK))
else OICON))
[WINDOWPROP MANAGER-MAIN-ICONW
'EXPANDFN
(FUNCTION (LAMBDA NIL
(Manager.MAINUPDATE
NIL]
MANAGER-MAIN-ICONW]
(SETQ Manager.ACTIVEFLG T)
(Manager.MAINUPDATE T])
@@ -1545,6 +1565,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(CONCAT "Creates a " TYPE
" submenu for the file " FILE])
(Manager.SET-ANCHOR
[LAMBDA (NEWANCHOR) (* ; "Edited 10-Oct-2023 11:24 by mth")
(if (AND (FMEMB NEWANCHOR '(ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR))
(NEQ Manager.WINDOW-ANCHOR NEWANCHOR))
then (SETQ Manager.WINDOW-ANCHOR NEWANCHOR])
(Manager.SORT.COMS
[LAMBDA (A B) (* ; "Edited 18-Nov-87 15:12 by raf")
@@ -1746,20 +1772,21 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(ADDTOVAR LAMA )
)
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (24415 101274 (MANAGER 24425 . 25224) (MANAGER.RESET 25226 . 26740) (Manager.ADDADV
26742 . 28095) (Manager.ADDTOFILES? 28097 . 28375) (Manager.ALTERMARKING 28377 . 29987) (
Manager.DO.COMMAND 29989 . 61755) (Manager.HIGHLIGHT 61757 . 62054) (Manager.PROMPT 62056 . 62369) (
Manager.WINDOW 62371 . 63004) (Manager.insurefilehighlights 63006 . 64077) (Manager.CHANGED? 64079 .
64628) (Manager.CHECKFILE 64630 . 65729) (Manager.COLLECTCOMS 65731 . 67169) (Manager.COMS.WSF 67171
. 69841) (Manager.COMSOPEN 69843 . 74581) (Manager.COMSUPDATE 74583 . 75675) (Manager.HIGHLIGHTED
75677 . 75983) (Manager.INSUREHIGHLIGHTS 75985 . 76543) (Manager.FILECHANGES 76545 . 76844) (
Manager.FILELSTCHANGED? 76846 . 77174) (Manager.FILESUBTYPES 77176 . 77814) (Manager.GET.ENVIRONMENT
77816 . 80354) (Manager.GETFILE 80356 . 82670) (Manager.INTITLE? 82672 . 83350) (Manager.MAIN.WSF
83352 . 85996) (Manager.MAINCLOSE 85998 . 87108) (Manager.MAINMENUITEMS 87110 . 88187) (
Manager.MAINOPEN 88189 . 93565) (Manager.MAINUPDATE 93567 . 94203) (Manager.MAKEFILE.ADV 94205 . 95241
) (Manager.MENUCOLUMNS 95243 . 96047) (Manager.MENUHASITEM 96049 . 96406) (Manager.MENUITEMS 96408 .
96653) (Manager.REMOVE.DUPLICATE.ADVICE 96655 . 98261) (Manager.RESETSUBITEMS 98263 . 99500) (
Manager.SORT.COMS 99502 . 100034) (Manager.SORTBYCOLUMN 100036 . 101272)))))
(FILEMAP (NIL (25676 102848 (MANAGER 25686 . 26485) (MANAGER.RESET 26487 . 28001) (Manager.ADDADV
28003 . 29356) (Manager.ADDTOFILES? 29358 . 29636) (Manager.ALTERMARKING 29638 . 31248) (
Manager.ANCHORED-SET-POSITION 31250 . 32353) (Manager.DO.COMMAND 32355 . 62991) (Manager.HIGHLIGHT
62993 . 63290) (Manager.PROMPT 63292 . 63605) (Manager.WINDOW 63607 . 64240) (
Manager.insurefilehighlights 64242 . 65313) (Manager.CHANGED? 65315 . 65864) (Manager.CHECKFILE 65866
. 66965) (Manager.COLLECTCOMS 66967 . 68405) (Manager.COMS.WSF 68407 . 71077) (Manager.COMSOPEN 71079
. 75817) (Manager.COMSUPDATE 75819 . 76911) (Manager.HIGHLIGHTED 76913 . 77219) (
Manager.INSUREHIGHLIGHTS 77221 . 77779) (Manager.FILECHANGES 77781 . 78080) (Manager.FILELSTCHANGED?
78082 . 78410) (Manager.FILESUBTYPES 78412 . 79050) (Manager.GET.ENVIRONMENT 79052 . 81590) (
Manager.GETFILE 81592 . 83906) (Manager.INTITLE? 83908 . 84586) (Manager.MAIN.WSF 84588 . 87232) (
Manager.MAINCLOSE 87234 . 88344) (Manager.MAINMENUITEMS 88346 . 89423) (Manager.MAINOPEN 89425 . 94818
) (Manager.MAINUPDATE 94820 . 95456) (Manager.MAKEFILE.ADV 95458 . 96494) (Manager.MENUCOLUMNS 96496
. 97300) (Manager.MENUHASITEM 97302 . 97659) (Manager.MENUITEMS 97661 . 97906) (
Manager.REMOVE.DUPLICATE.ADVICE 97908 . 99514) (Manager.RESETSUBITEMS 99516 . 100753) (
Manager.SET-ANCHOR 100755 . 101074) (Manager.SORT.COMS 101076 . 101608) (Manager.SORTBYCOLUMN 101610
. 102846)))))
STOP

BIN
lispusers/MANAGER.DFASL
View File

Binary file not shown.

BIN
lispusers/MANAGER.TEDIT
View File

Binary file not shown.