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

File See operations use full path to loaded file.

Browse Source 
Add Manager.WINDOW-ANCHOR to fix corner from which MANAGER-MAIN-WINDOW grows, and (attempt) to keep it on-screen.
This commit is contained in:
Matt Heffron
2023-02-06 17:07:50 -08:00
parent 3fa571f798
commit 9fd3b28d7b
2 changed files with 118 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

177
lispusers/MANAGER
View File

@@ -1,14 +1,14 @@
(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 " 6-Feb-2023 16:47:42" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;9 115036
:CHANGES-TO (FNS Manager.DO.COMMAND)
:CHANGES-TO (FNS Manager.SET-ANCHOR)
:PREVIOUS-DATE "10-Feb-2022 22:17:51" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;1)
:PREVIOUS-DATE " 6-Feb-2023 15:24:08" {DSK}<home>matt>medley>LISPUSERS>MANAGER.;8)
(* ; "
Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
Copyright (c) 1986-1987, 1900, 2022-2023 by Xerox Corporation.
")
(PRETTYCOMPRINT MANAGERCOMS)
@@ -55,8 +55,8 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
(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)
MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW
Manager.WINDOW-ANCHOR BackgroundMenuCommands BackgroundMenu)
(VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES)
(MANAGER-ADDTOFILES?)
MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS
@@ -64,6 +64,7 @@ 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)
@@ -77,15 +78,15 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
(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.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))
@@ -184,7 +185,8 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation.
(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)
MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW Manager.WINDOW-ANCHOR BackgroundMenuCommands
BackgroundMenu)
)
(RPAQQ *UNMANAGED-TYPES* (EXPRESSIONS FILES FIELDS FILEVARS-ARE-NOW-OK))
@@ -368,6 +370,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 +393,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)
@@ -522,10 +532,39 @@ 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 6-Feb-2023 15:15 by Matt Heffron")
(* ; "Edited 6-Feb-2023 15:13 by Matt Heffron")
(* ; "Edited 6-Feb-2023 15:10 by Matt Heffron")
(* ; "Edited 6-Feb-2023 14:51 by Matt Heffron")
(* ; "Edited 6-Feb-2023 14:43 by Matt Heffron")
(* ; "Edited 6-Feb-2023 14:40 by Matt Heffron")
(* ; "Edited 6-Feb-2023 14:37 by Matt Heffron")
(* ; "Edited 6-Feb-2023 14:32 by Matt Heffron")
(* ; "Edited 6-Feb-2023 14:26 by Matt Heffron")
(* ; "Edited 6-Feb-2023 13:44 by Matt Heffron")
(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")
[LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 6-Feb-2023 15:23 by Matt Heffron")
(* ; "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.")
@@ -719,15 +758,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)
@@ -754,12 +800,15 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
then (printout T .FONT LAMBDAFONT
"Writing CommonLisp source into " FILE
".LSP" .FONT DEFAULTFONT T)
(PRINT (USER::COMMON-MAKEFILE FILE)
(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)
@@ -1372,7 +1421,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
FILE])
(Manager.MAINOPEN
[LAMBDA (POSITION) (* ; "Edited 17-Aug-87 13:59 by raf")
[LAMBDA (POSITION) (* ; "Edited 6-Feb-2023 15:19 by Matt Heffron")
(* ; "Edited 17-Aug-87 13:59 by raf")
(* ;;; "Builds the manager main (FILELST) menu at the indicated position.")
@@ -1387,31 +1437,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
@@ -1545,6 +1594,14 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(CONCAT "Creates a " TYPE
" submenu for the file " FILE])
(Manager.SET-ANCHOR
[LAMBDA (NEWANCHOR) (* ; "Edited 6-Feb-2023 16:47 by Matt Heffron")
(* ; "Edited 6-Feb-2023 16:45 by Matt Heffron")
(* ; "")
(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 +1803,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
(ADDTOVAR LAMA )
)
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022))
(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022 2023))
(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 (25135 105160 (MANAGER 25145 . 25944) (MANAGER.RESET 25946 . 27460) (Manager.ADDADV
27462 . 28815) (Manager.ADDTOFILES? 28817 . 29095) (Manager.ALTERMARKING 29097 . 30707) (
Manager.ANCHORED-SET-POSITION 30709 . 32793) (Manager.DO.COMMAND 32795 . 65065) (Manager.HIGHLIGHT
65067 . 65364) (Manager.PROMPT 65366 . 65679) (Manager.WINDOW 65681 . 66314) (
Manager.insurefilehighlights 66316 . 67387) (Manager.CHANGED? 67389 . 67938) (Manager.CHECKFILE 67940
. 69039) (Manager.COLLECTCOMS 69041 . 70479) (Manager.COMS.WSF 70481 . 73151) (Manager.COMSOPEN 73153
. 77891) (Manager.COMSUPDATE 77893 . 78985) (Manager.HIGHLIGHTED 78987 . 79293) (
Manager.INSUREHIGHLIGHTS 79295 . 79853) (Manager.FILECHANGES 79855 . 80154) (Manager.FILELSTCHANGED?
80156 . 80484) (Manager.FILESUBTYPES 80486 . 81124) (Manager.GET.ENVIRONMENT 81126 . 83664) (
Manager.GETFILE 83666 . 85980) (Manager.INTITLE? 85982 . 86660) (Manager.MAIN.WSF 86662 . 89306) (
Manager.MAINCLOSE 89308 . 90418) (Manager.MAINMENUITEMS 90420 . 91497) (Manager.MAINOPEN 91499 . 96947
) (Manager.MAINUPDATE 96949 . 97585) (Manager.MAKEFILE.ADV 97587 . 98623) (Manager.MENUCOLUMNS 98625
. 99429) (Manager.MENUHASITEM 99431 . 99788) (Manager.MENUITEMS 99790 . 100035) (
Manager.REMOVE.DUPLICATE.ADVICE 100037 . 101643) (Manager.RESETSUBITEMS 101645 . 102882) (
Manager.SET-ANCHOR 102884 . 103386) (Manager.SORT.COMS 103388 . 103920) (Manager.SORTBYCOLUMN 103922
. 105158)))))
STOP

BIN
lispusers/MANAGER.DFASL
View File

Binary file not shown.