1
0
mirror of synced 2026-03-06 11:34:26 +00:00
* PSEUDOHOSTS: Overlay a file system at the end of a path in another file system

New package, please look through it.

* REGIONMANAGER:  added RELCREATEPOSITION, allow for arguments to be spread

If the WIDTH argument looks like a list of arguments, the arguments are spread out.  Means that a relative region can be passed through intermediate functions.

* EXAMINEDEFS:  More control over regions and windows

Examination windows are returned so that callers can manipulate them

* TEDIT-PF-SEE:  tf respects reader environment and bold faces of DEFUN and DEFMACRO names

* COMPAREDIRECTORIES:  refactored for more flexibility and easier maintenance

Also, based on SPY, made more internal operations work on streams that are located and created once, rather than on file

Added CDMERGE to merge CDVALUES for different subdirectories, to permit scrolling of all differences in a single browser window

* COMPARESOURCES:  Region for CS browser is passed through, window is returned

Also tried to eliminate mismatching of simple edit timestamps

* COMPARETEXT: Files can be input streams, region is passed in, window is returned

* COMPAREDIRECTORIES again:  Fixed a promptwindow bug

* GITFNS:  New package for comparing and copying back and forth from My Medley to the git clone

* REGIONMANAGER:  Added CLOSEWITH and MOVEWITh

Primitives for building hierarchically dependent window clusters

* PSEUDOHOSTS:  Added PSEUDOHOSTNAME, hierarchical hosts #663

For hierarchical hosts (hosts whose prefixes are extensions of the prefixes of other pseudohosts), always the pseudofilename is always the shortest one.  See #663 for more details

* EXAMINEDEFS:  Fix prettyprint of non-function expressions

* GITFNS, Comparison files:  Use CLOSEWITH and MOVEWITH abstractions for window hierarchies
This commit is contained in:
rmkaplan
2022-01-31 09:51:50 -08:00
committed by GitHub
parent b791bff070
commit fe90ac5f9f
16 changed files with 418 additions and 328 deletions

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jan-2022 17:47:36" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;160 112621
(FILECREATED "29-Jan-2022 00:03:59" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;169 111694
:CHANGES-TO (FNS CD.COMMANDSELECTEDFN)
:CHANGES-TO (FNS CD-MENUFN)
(VARS CDTABLEBROWSER.MENUITEMS)
:PREVIOUS-DATE "26-Jan-2022 15:33:55"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;159)
:PREVIOUS-DATE "28-Jan-2022 17:12:22"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;162)
(* ; "
@@ -1587,7 +1588,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(CDBROWSER
[LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS)
(* ;; "Edited 25-Jan-2022 13:05 by rmk: a table browser for the differences in CDVALUE.")
(* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.")
(* ;; "Creates a table browser for the differences in CDVALUE.")
@@ -1613,25 +1614,18 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
FINALLY (RETURN (WIDTHIFWINDOW (IMAX $$EXTREME (STRINGWIDTH
" CD commands "
DEFAULTFONT]
(* ;; "2 allows for the prompt window")
[SETQ REGION (GETREGION (PLUS TB.LEFT.MARGIN ITEMWIDTH (TIMES 2 WBorder)
MENUWIDTH)
(TIMES (IMAX (IMIN 15 (LENGTH STRINGS))
(ADD1 (LENGTH MENUITEMS)))
(TIMES (IPLUS 2 (IMAX (IMIN 15 (LENGTH STRINGS))
(LENGTH MENUITEMS)))
(FONTPROP DEFAULTFONT 'HEIGHT]
(* ;; "Promptwindow seems to do its own thing, even if under construction. So we preshrink the main window.")
[SETQ REGION (CREATE REGION USING REGION HEIGHT _ (DIFFERENCE (FETCH (REGION HEIGHT)
OF REGION)
(FONTPROP DEFAULTFONT
'HEIGHT]
(SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare directories " (LENGTH
STRINGS)
" files"))
NIL T))
[WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
(FOR W INSIDE (WINDOWPROP W 'SUBWINDOWS)
DO (CLOSEW (WFROMDS W]
(WINDOWPROP WINDOW 'UNDERCONSTRUCTION T)
(* ;; "TABLEBROWSER is odd: USERDATA is a single recognized property. But it allows for other unrecognized properties in the list, it pushes them on to a list USERPROPS...and then throws it away. So here I'm using USERDATA to hold the directory lengths so they can be stripped off for display. It may actually be better to have a field name in CDVALUE for all of the shared stuff in front of the entries, and keep it all.")
@@ -1816,23 +1810,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(CD-MENUFN
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
(* ;; "Edited 25-Jan-2022 10:19 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
(* ;; "Edited 29-Jan-2022 00:03 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
(* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.")
(CL:WHEN (MEMB (OR (CADDR MENUITEM)
(CAR MENUITEM))
'(Compare See See% right See% both See% left))
(* ; "Close the previous ones")
(CLOSEWITH.DOIT WINDOW))
(LET
(SUBWINDOWS)
(CL:WHEN (MEMB (OR (CADDR MENUITEM)
(CAR MENUITEM))
'(Compare See% right See% both See% left))
(FOR W IN (WINDOWPROP WINDOW 'SUBWINDOWS) WHEN (OPENWP W) DO (CLOSEW W)))
(SELECTQ (OR (CADDR MENUITEM)
(CAR MENUITEM))
(Compare (IF (AND FILE1 FILE2)
THEN [SETQ SUBWINDOWS
(SELECTQ TYPE
(CHILDREN)
(SETQ CHILDREN
(SELECTQ (OR (CADDR MENUITEM)
(CAR MENUITEM))
(Compare (IF (AND FILE1 FILE2)
THEN (SELECTQ TYPE
(SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
(RELCREATEREGION
[FIXR (TIMES 0.75 (FETCH (REGION WIDTH)
@@ -1860,57 +1855,56 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(LIST LABEL1 LABEL2)))
(PROGN (FLASHWINDOW T)
(PRIN3 "Unable to compare, showing both" T)
(TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2]
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(See% left (IF FILE1
THEN (SETQ SUBWINDOWS (TEDIT-SEE FILE1
(RELCREATEREGION
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
(TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2)))
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(See% left (IF FILE1
THEN (TEDIT-SEE FILE1 (RELCREATEREGION 700 700 'RIGHT 'TOP
`(,WINDOW 0.5)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
T)
NIL
(CONCAT "SEE window for " LABEL1)))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
(See% right (IF FILE2
THEN (SETQ SUBWINDOWS (TEDIT-SEE FILE2
(RELCREATEREGION
700 700 'LEFT 'TOP `(,WINDOW 0.5)
NIL
(CONCAT "SEE window for " LABEL1))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
(See% right (IF FILE2
THEN (TEDIT-SEE FILE2 (RELCREATEREGION 700 700 'LEFT 'TOP
`(,WINDOW 0.5)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
T)
NIL
(CONCAT "SEE window for " LABEL2)))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
(See% both (IF (AND FILE1 FILE2)
THEN (SETQ SUBWINDOWS (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
(RELCREATEREGION
1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
T)))
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2]
(PRIN3 (CL:IF DEST
(CONCAT "Copied to " DEST)
(PROGN (FLASHWINDOW T)
(CONCAT FILE2 " could not be copied")))
T)))
(Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1]
(PRIN3 (CL:IF DEST
(CONCAT "Copied to " DEST)
(PROGN (FLASHWINDOW T)
(CONCAT FILE1 " could not be copied")))
T)))
(SHOULDNT))
(FOR W INSIDE SUBWINDOWS DO (WINDOWADDPROP WINDOW 'SUBWINDOWS (WFROMDS W])
NIL
(CONCAT "SEE window for " LABEL2))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
((See See% both)
(IF (AND FILE1 FILE2)
THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
'REGION))
-1)
T))
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2]
(PRIN3 (CL:IF DEST
(CONCAT "Copied to " DEST)
(PROGN (FLASHWINDOW T)
(CONCAT FILE2 " could not be copied")))
T)))
(Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1]
(PRIN3 (CL:IF DEST
(CONCAT "Copied to " DEST)
(PROGN (FLASHWINDOW T)
(CONCAT FILE1 " could not be copied")))
T)))
(SHOULDNT)))
(CLOSEWITH CHILDREN WINDOW)
(MOVEWITH CHILDREN WINDOW])
)
(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN)
@@ -1918,30 +1912,31 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(Copy% <- CD-MENUFN)
(See% left CD-MENUFN)
(See% right CD-MENUFN)
(See% both CD-MENUFN)))
(See% both CD-MENUFN)
(See CD-MENUFN)))
(FILESLOAD (SYSLOAD)
COMPARESOURCES COMPARETEXT)
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
2018 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2497 19012 (COMPAREDIRECTORIES 2507 . 8956) (COMPAREDIRECTORIES.INFOS 8958 . 11078) (
CDENTRIES.SELECT 11080 . 15766) (COMPAREDIRECTORIES.INFOS.TYPE 15768 . 16396) (MATCHNAME 16398 . 16928
) (CD.INSURECDVALUE 16930 . 18544) (CD.UPDATEWIDTHS 18546 . 19010)) (19013 29285 (CDFILES 19023 .
25379) (CDFILES.MATCH 25381 . 27006) (CDFILES.PATS 27008 . 29283)) (29286 44371 (CDPRINT 29296 . 31641
) (CDPRINT.HEADER 31643 . 32540) (CDPRINT.LINE 32542 . 35098) (CDPRINT.MAXWIDTHS 35100 . 39215) (
CDPRINT.COLHEADERS 39217 . 39855) (CDPRINT.COLUMNS 39857 . 43736) (CDTEDIT 43738 . 44369)) (44372
52741 (CDMAP 44382 . 45814) (CDENTRY 45816 . 46125) (CDSUBSET 46127 . 47566) (CDMERGE 47568 . 51422) (
CDMERGE.COMMON 51424 . 52739)) (52742 60280 (BINCOMP 52752 . 57041) (EOLTYPE 57043 . 59605) (
EOLTYPE.SHOW 59607 . 60278)) (60808 74015 (FIND-UNCOMPILED-FILES 60818 . 64461) (FIND-UNSOURCED-FILES
64463 . 67272) (FIND-SOURCE-FILES 67274 . 68978) (FIND-COMPILED-FILES 68980 . 71058) (
FIND-UNLOADED-FILES 71060 . 71804) (FIND-LOADED-FILES 71806 . 72360) (FIND-MULTICOMPILED-FILES 72362
. 74013)) (74016 82218 (CREATED-AS 74026 . 78823) (SOURCE-FOR-COMPILED-P 78825 . 81523) (
COMPILE-SOURCE-DATE-DIFF 81525 . 82216)) (82219 92525 (FIX-DIRECTORY-DATES 82229 . 85222) (
FIX-EQUIV-DATES 85224 . 86749) (COPY-COMPARED-FILES 86751 . 88572) (COPY-MISSING-FILES 88574 . 90731)
(COMPILED-ON-SAME-SOURCE 90733 . 92523)) (92719 100458 (CDBROWSER 92729 . 97353) (CDBROWSER.STRINGS
97355 . 100456)) (100620 101892 (CD.TABLEITEM 100630 . 100850) (CD.TABLEITEM.PRINTFN 100852 . 101051)
(CD.TABLEITEM.COPYFN 101053 . 101647) (CDTABLEBROWSER.HEADING.REPAINTFN 101649 . 101890)) (101893
112086 (CDTABLEBROWSER.WHENSELECTEDFN 101903 . 102371) (CD.COMMANDSELECTEDFN 102373 . 105764) (
CD-MENUFN 105766 . 112084)))))
(FILEMAP (NIL (2536 19051 (COMPAREDIRECTORIES 2546 . 8995) (COMPAREDIRECTORIES.INFOS 8997 . 11117) (
CDENTRIES.SELECT 11119 . 15805) (COMPAREDIRECTORIES.INFOS.TYPE 15807 . 16435) (MATCHNAME 16437 . 16967
) (CD.INSURECDVALUE 16969 . 18583) (CD.UPDATEWIDTHS 18585 . 19049)) (19052 29324 (CDFILES 19062 .
25418) (CDFILES.MATCH 25420 . 27045) (CDFILES.PATS 27047 . 29322)) (29325 44410 (CDPRINT 29335 . 31680
) (CDPRINT.HEADER 31682 . 32579) (CDPRINT.LINE 32581 . 35137) (CDPRINT.MAXWIDTHS 35139 . 39254) (
CDPRINT.COLHEADERS 39256 . 39894) (CDPRINT.COLUMNS 39896 . 43775) (CDTEDIT 43777 . 44408)) (44411
52780 (CDMAP 44421 . 45853) (CDENTRY 45855 . 46164) (CDSUBSET 46166 . 47605) (CDMERGE 47607 . 51461) (
CDMERGE.COMMON 51463 . 52778)) (52781 60319 (BINCOMP 52791 . 57080) (EOLTYPE 57082 . 59644) (
EOLTYPE.SHOW 59646 . 60317)) (60847 74054 (FIND-UNCOMPILED-FILES 60857 . 64500) (FIND-UNSOURCED-FILES
64502 . 67311) (FIND-SOURCE-FILES 67313 . 69017) (FIND-COMPILED-FILES 69019 . 71097) (
FIND-UNLOADED-FILES 71099 . 71843) (FIND-LOADED-FILES 71845 . 72399) (FIND-MULTICOMPILED-FILES 72401
. 74052)) (74055 82257 (CREATED-AS 74065 . 78862) (SOURCE-FOR-COMPILED-P 78864 . 81562) (
COMPILE-SOURCE-DATE-DIFF 81564 . 82255)) (82258 92564 (FIX-DIRECTORY-DATES 82268 . 85261) (
FIX-EQUIV-DATES 85263 . 86788) (COPY-COMPARED-FILES 86790 . 88611) (COPY-MISSING-FILES 88613 . 90770)
(COMPILED-ON-SAME-SOURCE 90772 . 92562)) (92758 99800 (CDBROWSER 92768 . 96695) (CDBROWSER.STRINGS
96697 . 99798)) (99962 101234 (CD.TABLEITEM 99972 . 100192) (CD.TABLEITEM.PRINTFN 100194 . 100393) (
CD.TABLEITEM.COPYFN 100395 . 100989) (CDTABLEBROWSER.HEADING.REPAINTFN 100991 . 101232)) (101235
111110 (CDTABLEBROWSER.WHENSELECTEDFN 101245 . 101713) (CD.COMMANDSELECTEDFN 101715 . 105106) (
CD-MENUFN 105108 . 111108)))))
STOP

Binary file not shown.

View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jan-2022 16:05:14" {MM}<lispusers>COMPARESOURCES.;115 41781
(FILECREATED "28-Jan-2022 18:22:40" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270
:CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN)
:PREVIOUS-DATE "24-Jan-2022 23:12:17" {MM}<lispusers>COMPARESOURCES.;113)
:PREVIOUS-DATE "28-Jan-2022 17:12:39"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116)
(* ; "
@@ -35,13 +37,9 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
(DEFINEQ
(COMPARESOURCES
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 26-Dec-2021 21:32 by rmk")
(* ; "Edited 20-Dec-2021 09:51 by rmk")
(* ; "Edited 9-Dec-2021 23:13 by rmk")
(* ; "Edited 4-Dec-2021 19:54 by rmk")
(* ; "Edited 23-Nov-2021 19:46 by rmk:")
(* ; "Edited 30-Oct-2021 20:13 by rmk:")
(* ; "Edited 19-Apr-2018 10:49 by rmk:")
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 28-Jan-2022 17:10 by rmk")
(* ; "Edited 26-Dec-2021 21:32 by rmk")
(* ; "Edited 19-Apr-2018 10:49 by rmk:")
(* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream")
@@ -92,7 +90,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
'DECLARE%:]
(SETQ BODYY (CL:SET-DIFFERENCE BODYY DECLAREY))
(WITH-READER-ENVIRONMENT (OR ENVX ENVY (MAKE-READER-ENVIRONMENT))
(\CS.COMPARE.MASTERS BODYX BODYY DW? CONTEXTSTREAM COMPARESTREAM)
(\CS.COMPARE.MASTERS BODYX BODYY DW?)
(* ;; "Done with the non-DECLARE: expressions. Nw sort what's left according to when it is eval'ed so that we can hopefully further reduce the amount of stuff to compare")
@@ -125,7 +123,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
 "REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order")
(\CS.COMPARE.MASTERS (REVERSE X)
(REVERSE Y)
DW? CONTEXTSTREAM COMPARESTREAM]
DW?]
(TERPRI CONTEXTSTREAM))
(SELECTQ INSERTOBJECTS
(OBJECTWINDOW (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
@@ -554,7 +552,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
ELSE (ADD LINELENGTH (CHARWIDTH C FONT])
(CSOBJ.BUTTONEVENTINFN
[LAMBDA (OBJ WINDOW) (* ; "Edited 25-Jan-2022 16:04 by rmk")
[LAMBDA (OBJ WINDOW) (* ; "Edited 28-Jan-2022 18:22 by rmk")
(* ; "Edited 25-Jan-2022 16:04 by rmk")
(* ; "Edited 23-Jan-2022 18:11 by rmk")
(LET
[(COMPAREDATA (IMAGEOBJPROP OBJ 'COMPAREDATA]
@@ -578,8 +577,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
(LET
[EWINDOW (RELPOS (RELCREATEPOSITION `(,WINDOW 0.5)
`(,WINDOW 0 -2]
(CL:WHEN [WINDOWP (SETQ EWINDOW (WINDOWPROP WINDOW 'EXAMINEWINDOW]
(CLOSEW EWINDOW))
(CLOSEWITH.DOIT WINDOW)
(SETQ EWINDOW
(IF (IMAGEOBJPROP OBJ 'ONLYONE)
THEN
@@ -595,10 +593,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
'TOP RELPOS NIL T]
ELSE (* ; "Spread the arguments")
(EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 RELPOS)))
(WINDOWPROP WINDOW 'EXAMINEWINDOW EWINDOW)
(WINDOWADDPROP WINDOW 'CLOSEFN [FUNCTION (LAMBDA (W)
(CLOSEW (WINDOWPROP W 'EXAMINEWINDOW]
T)
(CLOSEWITH EWINDOW WINDOW)
(MOVEWITH EWINDOW WINDOW)
EWINDOW)))])
(CSOBJ.COPYBUTTONEVENTINFN
@@ -690,16 +686,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
)
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1768 27559 (COMPARESOURCES 1778 . 8291) (\CS.COMPARE.MASTERS 8293 . 16437) (
\CS.COMPARE.TYPES 16439 . 19577) (\CS.EXAMINE 19579 . 23806) (\CS.FIXFNS 23808 . 25310) (
\CS.SORT.DECLARES 25312 . 25655) (\CS.SORT.DECLARE1 25657 . 27077) (\CS.FILTER.GARBAGE 27079 . 27557))
(27560 31540 (\CS.ISFNFORM 27570 . 27838) (\CS.COMPARE.FNS 27840 . 28082) (\CS.FNSID 28084 . 28228) (
\CS.ISVARFORM 28230 . 28335) (\CS.COMPARE.VARS 28337 . 28999) (\CS.ISMACROFORM 29001 . 29139) (
\CS.ISRECFORM 29141 . 29234) (\CS.ISCOURIERFORM 29236 . 29336) (\CS.ISTEMPLATEFORM 29338 . 29436) (
\CS.COMPARE.TEMPLATES 29438 . 29803) (\CS.ISPROPFORM 29805 . 29960) (\CS.PROP.NAME 29962 . 30107) (
\CS.COMPARE.PROPS 30109 . 30266) (\CS.ISADDVARFORM 30268 . 30361) (\CS.COMPARE.ADDVARS 30363 . 30528)
(\CS.ISFPKGCOMFORM 30530 . 30737) (\CS.COMPARE.FPKGCOMS 30739 . 30946) (\CS.COMPARE.DEFINE-FILE-INFO
30948 . 31538)) (31541 37731 (CSOBJ.CREATE 31551 . 31964) (CSOBJ.DISPLAYFN 31966 . 32719) (
CSOBJ.IMAGEBOXFN 32721 . 34882) (CSOBJ.BUTTONEVENTINFN 34884 . 37481) (CSOBJ.COPYBUTTONEVENTINFN 37483
. 37729)) (38595 41299 (CSBROWSER 38605 . 41297)))))
(FILEMAP (NIL (1850 27174 (COMPARESOURCES 1860 . 7906) (\CS.COMPARE.MASTERS 7908 . 16052) (
\CS.COMPARE.TYPES 16054 . 19192) (\CS.EXAMINE 19194 . 23421) (\CS.FIXFNS 23423 . 24925) (
\CS.SORT.DECLARES 24927 . 25270) (\CS.SORT.DECLARE1 25272 . 26692) (\CS.FILTER.GARBAGE 26694 . 27172))
(27175 31155 (\CS.ISFNFORM 27185 . 27453) (\CS.COMPARE.FNS 27455 . 27697) (\CS.FNSID 27699 . 27843) (
\CS.ISVARFORM 27845 . 27950) (\CS.COMPARE.VARS 27952 . 28614) (\CS.ISMACROFORM 28616 . 28754) (
\CS.ISRECFORM 28756 . 28849) (\CS.ISCOURIERFORM 28851 . 28951) (\CS.ISTEMPLATEFORM 28953 . 29051) (
\CS.COMPARE.TEMPLATES 29053 . 29418) (\CS.ISPROPFORM 29420 . 29575) (\CS.PROP.NAME 29577 . 29722) (
\CS.COMPARE.PROPS 29724 . 29881) (\CS.ISADDVARFORM 29883 . 29976) (\CS.COMPARE.ADDVARS 29978 . 30143)
(\CS.ISFPKGCOMFORM 30145 . 30352) (\CS.COMPARE.FPKGCOMS 30354 . 30561) (\CS.COMPARE.DEFINE-FILE-INFO
30563 . 31153)) (31156 37220 (CSOBJ.CREATE 31166 . 31579) (CSOBJ.DISPLAYFN 31581 . 32334) (
CSOBJ.IMAGEBOXFN 32336 . 34497) (CSOBJ.BUTTONEVENTINFN 34499 . 36970) (CSOBJ.COPYBUTTONEVENTINFN 36972
. 37218)) (38084 40788 (CSBROWSER 38094 . 40786)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jan-2022 10:20:31" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31 11252
(FILECREATED "28-Jan-2022 23:36:31" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;32 11715
:CHANGES-TO (FNS EXAMINEFILES)
:CHANGES-TO (FNS TEDITDEF)
:PREVIOUS-DATE "23-Jan-2022 17:41:43"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;30)
:PREVIOUS-DATE "25-Jan-2022 10:20:31"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31)
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
@@ -160,30 +160,35 @@
NIL TITLE2])
(TEDITDEF
[LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 12-Jan-2022 17:27 by rmk")
[LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk")
(* ; "Edited 12-Jan-2022 17:27 by rmk")
(LET ((TSTREAM (OPENTEXTSTREAM)))
(DSPFONT DEFAULTFONT TSTREAM)
(CL:WHEN (EQ (CAR DEF)
'DEFINEQ)
(SETQ DEF (CADR DEF)))
(IF (EQ NAME (CAR DEF))
THEN (DSPFONT BOLDFONT TSTREAM)
(PRINT NAME TSTREAM)
(DSPFONT DEFAULTFONT TSTREAM)
(SETQ DEF (CADR DEF))
(PRINTDEF DEF 3 T NIL NIL TSTREAM)
ELSEIF (EQ NAME (CADR DEF))
THEN
(* ;; "Presumably a DEFUN. Print the CAR, boldface the cadr")
(SELECTQ (CAR DEF)
(DEFINEQ (SETQ DEF (CADR DEF))
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
(PRINTDEF (CADR DEF)
2 T NIL NIL TSTREAM))
((DEFMACRO DEFUN) (* ; "Has args after name")
(PRINTOUT TSTREAM "(" .P2 (CAR DEF)
" " .FONT BOLDFONT .P2 (CADR DEF)
.FONT DEFAULTFONT " " .P2 (CADDR DEF)
T 3)
T)
(PRINTDEF (CDDDR DEF)
3 T T NIL TSTREAM)
(PRIN3 ")" TSTREAM)
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM))
(PRIN3 ")" TSTREAM))
(IF (EQ NAME (CADR DEF))
THEN
(* ;; "Like RPAQQ, bold the name")
[PRINTOUT TSTREAM "(" .P2 (CAR DEF)
" " .FONT BOLDFONT .P2 (CADR DEF)
.FONT DEFAULTFONT T .TAB (IPLUS 2 (NCHARS (CAR DEF]
(PRINTDEF (CDDR DEF)
(IPLUS 2 (NCHARS (CAR DEF)))
T T NIL TSTREAM)
(PRIN3 ")" TSTREAM)
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
TSTREAM])
)
@@ -194,6 +199,6 @@
(FILESLOAD (SYSLOAD)
COMPARETEXT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (662 11110 (EXAMINEDEFS 672 . 8791) (EXAMINEFILES 8793 . 9988) (TEDITDEF 9990 . 11108)))
(FILEMAP (NIL (658 11573 (EXAMINEDEFS 668 . 8787) (EXAMINEFILES 8789 . 9984) (TEDITDEF 9986 . 11571)))
))
STOP

Binary file not shown.

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Jan-2022 22:53:49" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;35 57074
(FILECREATED "29-Jan-2022 00:01:52" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;37 56734
:CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY)
:CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY GIT-COMPARE-BRANCHES)
:PREVIOUS-DATE "26-Jan-2022 22:40:03"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;34)
:PREVIOUS-DATE "28-Jan-2022 12:12:30"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;36)
(PRETTYCOMPRINT GITFNSCOMS)
@@ -23,7 +23,7 @@
(MYMEDLEYHOST 'MM)
(GITMEDLEYHOST 'GIT))
(INITVARS (GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM))
(GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED))
(GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2))
(GIT-MERGE-COMPARES T))
(P (PSEUDOHOST MYMEDLEYHOST MEDLEYDIR)
(PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR))
@@ -106,7 +106,7 @@
(RPAQ? GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM))
(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED))
(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2))
(RPAQ? GIT-MERGE-COMPARES T)
@@ -734,7 +734,8 @@
(LIST DIR1 DIR2))])
(GIT-COMPARE-BRANCHES
[LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 26-Jan-2022 13:42 by rmk")
[LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 28-Jan-2022 23:58 by rmk")
(* ; "Edited 26-Jan-2022 13:42 by rmk")
(* ; "Edited 11-Jan-2022 11:10 by rmk")
(* ; "Edited 6-Jan-2022 13:05 by rmk")
(* ; "Edited 4-Jan-2022 22:52 by rmk")
@@ -774,11 +775,7 @@
(LIST BRANCH1 BRANCH2)
`(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2)
NIL
`(Compare "" (,(CONCAT "See " BRANCH1)
CD-MENUFN See% left)
(,(CONCAT "See " BRANCH2)
CD-MENUFN See% right)
See% both))
`(Compare See))
ELSE "NO DIFFERENCES")
ELSE "NO DIFFERENCES"])
@@ -786,7 +783,7 @@
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE)
(* ;;
 "Edited 26-Jan-2022 22:53 by rmk: my medley subdirectories with the current local git branch.")
 "Edited 28-Jan-2022 23:57 by rmk: my medley subdirectories with the current local git branch.")
(* ;; "Compares my medley subdirectories with the current local git branch.")
@@ -836,10 +833,7 @@
`(BRANCH1 "My Medley" BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
GIT-CD-LABELFN)
NIL
`(Compare "" ("See My Medley" CD-MENUFN See% left)
(,(CONCAT "See " BRANCH2)
CD-MENUFN See% right)
See% both "" (Copy% <- GIT-CD-MENUFN)
`(Compare See "" (Copy% <- GIT-CD-MENUFN)
(|Delete ALL <-| GIT-CD-MENUFN)
,@(CL:UNLESS (STRPOS "master" BRANCH2)
'("" (Copy% -> GIT-CD-MENUFN)
@@ -1124,20 +1118,20 @@
(ERROR "INITIALS is not set"])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4688 9814 (TOGIT 4698 . 6617) (FROMGIT 6619 . 7478) (GIT-DELETE-FILE 7480 . 8374) (
MYMEDLEY-DELETE-FILES 8376 . 9812)) (9815 11456 (MEDLEYSUBDIR 9825 . 10265) (GITSUBDIR 10267 . 10843)
(STRIPDIR 10845 . 11216) (STRIPHOST 11218 . 11454)) (11457 13394 (GFILE4MFILE 11467 . 12138) (
MFILE4GFILE 12140 . 12693) (GIT-REPO-FILENAME 12695 . 13392)) (13395 15729 (MEDLEYSUBDIRS 13405 .
14373) (GITSUBDIRS 14375 . 15727)) (15856 22350 (GIT-COMMIT 15866 . 16444) (GIT-PUSH 16446 . 17002) (
GIT-PULL 17004 . 17410) (GIT-BRANCH-DIFF 17412 . 18607) (GIT-APPROVAL 18609 . 18810) (GIT-GET-FILE
18812 . 19916) (GIT-FILE-EXISTS? 19918 . 20797) (GIT-REMOTE-UPDATE 20799 . 21841) (GIT-FILE-DATE 21843
. 22348)) (22395 26572 (GIT-CHECKOUT 22405 . 22646) (GIT-WHICH-BRANCH 22648 . 23232) (GIT-MAKE-BRANCH
23234 . 24725) (GIT-BRANCHES 24727 . 25507) (GIT-BRANCH-EXISTS? 25509 . 26570)) (26602 29307 (
GIT-MY-CURRENT-BRANCH 26612 . 26785) (GIT-MY-BRANCHP 26787 . 27706) (GIT-MY-NEXT-BRANCH 27708 . 28149)
(GIT-MY-BRANCHES 28151 . 29305)) (29353 33123 (GIT-ADD-WORKTREE 29363 . 31123) (GIT-REMOVE-WORKTREE
31125 . 31703) (GIT-LIST-WORKTREES 31705 . 32509) (WORKTREEDIR 32511 . 33121)) (33171 54106 (
GIT-GET-DIFFERENT-FILES 33181 . 35051) (GIT-COMPARE-BRANCHES 35053 . 38191) (GIT-COMPARE-WITH-MYMEDLEY
38193 . 42091) (GIT-COMPARE-WORKTREE 42093 . 45570) (GITCDOBJBUTTONFN 45572 . 50576) (GIT-CD-LABELFN
50578 . 51660) (GIT-CD-MENUFN 51662 . 54104)) (54152 57051 (CDGITDIR 54162 . 54594) (GIT-COMMAND 54596
. 56164) (GITORIGIN 56166 . 56743) (GIT-INITIALS 56745 . 57049)))))
(FILEMAP (NIL (4731 9857 (TOGIT 4741 . 6660) (FROMGIT 6662 . 7521) (GIT-DELETE-FILE 7523 . 8417) (
MYMEDLEY-DELETE-FILES 8419 . 9855)) (9858 11499 (MEDLEYSUBDIR 9868 . 10308) (GITSUBDIR 10310 . 10886)
(STRIPDIR 10888 . 11259) (STRIPHOST 11261 . 11497)) (11500 13437 (GFILE4MFILE 11510 . 12181) (
MFILE4GFILE 12183 . 12736) (GIT-REPO-FILENAME 12738 . 13435)) (13438 15772 (MEDLEYSUBDIRS 13448 .
14416) (GITSUBDIRS 14418 . 15770)) (15899 22393 (GIT-COMMIT 15909 . 16487) (GIT-PUSH 16489 . 17045) (
GIT-PULL 17047 . 17453) (GIT-BRANCH-DIFF 17455 . 18650) (GIT-APPROVAL 18652 . 18853) (GIT-GET-FILE
18855 . 19959) (GIT-FILE-EXISTS? 19961 . 20840) (GIT-REMOTE-UPDATE 20842 . 21884) (GIT-FILE-DATE 21886
. 22391)) (22438 26615 (GIT-CHECKOUT 22448 . 22689) (GIT-WHICH-BRANCH 22691 . 23275) (GIT-MAKE-BRANCH
23277 . 24768) (GIT-BRANCHES 24770 . 25550) (GIT-BRANCH-EXISTS? 25552 . 26613)) (26645 29350 (
GIT-MY-CURRENT-BRANCH 26655 . 26828) (GIT-MY-BRANCHP 26830 . 27749) (GIT-MY-NEXT-BRANCH 27751 . 28192)
(GIT-MY-BRANCHES 28194 . 29348)) (29396 33166 (GIT-ADD-WORKTREE 29406 . 31166) (GIT-REMOVE-WORKTREE
31168 . 31746) (GIT-LIST-WORKTREES 31748 . 32552) (WORKTREEDIR 32554 . 33164)) (33214 53766 (
GIT-GET-DIFFERENT-FILES 33224 . 35094) (GIT-COMPARE-BRANCHES 35096 . 38064) (GIT-COMPARE-WITH-MYMEDLEY
38066 . 41751) (GIT-COMPARE-WORKTREE 41753 . 45230) (GITCDOBJBUTTONFN 45232 . 50236) (GIT-CD-LABELFN
50238 . 51320) (GIT-CD-MENUFN 51322 . 53764)) (53812 56711 (CDGITDIR 53822 . 54254) (GIT-COMMAND 54256
. 55824) (GITORIGIN 55826 . 56403) (GIT-INITIALS 56405 . 56709)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jan-2022 12:35:16" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;119 22617
(FILECREATED "30-Jan-2022 08:58:48" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135 25556
:CHANGES-TO (VARS PSEUDOHOSTSCOMS)
:CHANGES-TO (FNS PSEUDOHOST CONTRACT.PH EXPAND.PH PSEUDOFILENAME)
(RECORDS PHDEVICE TARGETDEVICE)
(VARS PSEUDOHOSTSCOMS)
:PREVIOUS-DATE "26-Jan-2022 23:33:17"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;118)
:PREVIOUS-DATE "28-Jan-2022 09:06:55"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;123)
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -15,7 +17,7 @@
[
(* ;; "Public entries")
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME)
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME)
(* ;; "Internals")
@@ -24,7 +26,7 @@
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
(P (PSEUDOHOST 'LI LOGINHOST/DIR))
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE)
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
(P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE)
(LOAD 'EXPORTS.ALL))])
@@ -36,26 +38,32 @@
(DEFINEQ
(PSEUDOHOST
[LAMBDA (HOST PREFIX) (* ; "Edited 25-Jan-2022 09:58 by rmk")
(* ; "Edited 23-Jan-2022 20:43 by rmk")
(* ; "Edited 18-Jan-2022 13:08 by rmk")
[LAMBDA (HOST PREFIX)
(* ;; "Edited 30-Jan-2022 08:58 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.")
(CL:WHEN (AND (LISTP HOST)
(NULL PREFIX))
(SETQ PREFIX (CADR HOST))
(SETQ HOST (CAR HOST)))
(SETQ HOST (U-CASE (MKATOM HOST)))
(IF PREFIX
THEN (CL:UNLESS (FILENAMEFIELD PREFIX 'HOST)
(SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST 'DSK 'BODY PREFIX))))
(CL:UNLESS (MEMB (NTHCHARCODE PREFIX -1)
(CHARCODE (> / <)))
(SETQ PREFIX (CONCAT PREFIX (IF (STRPOS "/" PREFIX)
THEN "/"
ELSE ">"))))
[LET (PREVIOUS TARGETHOST TARGETDEVICE)
(CL:WHEN (SETQ PREVIOUS (PSEUDOHOSTP HOST))(* ;
[IF PREFIX
THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ;
 "Redefining: first clear out the previous one")
(PSEUDOHOST HOST NIL))
(PSEUDOHOST HOST NIL))
[LET (TARGETHOST TARGETDEVICE PREFIXHOST)
(CL:UNLESS [SETQ PREFIXHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST]
(SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST (SETQ PREFIXHOST 'DSK)
'BODY PREFIX))))
(* ;; "We want the maximal prefix. If {LI} is a pseudohost with prefix {DSK}<abc> and we are defining {FOO} with prefix {LI}<xyz>, we want FOO's prefix to be {DSK}<abc>xyz>. , And if FUM is then defined as {FOO}<mno>, we want its prefix to be {DSK}<abc>xyz>mno>. This gives the true filenames.")
(SETQ PREFIX (EXPAND.PH PREFIX PREFIXHOST))
(CL:UNLESS (MEMB (NTHCHARCODE PREFIX -1)
(CHARCODE (> / <)))
(SETQ PREFIX (CONCAT PREFIX (IF (STRPOS "/" PREFIX)
THEN "/"
ELSE ">"))))
[SETQ TARGETHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST]
(* ;; "We know about the directory separators for these particular devices. Maybe there should be separate list of slash-hosts somewhere that we can use.")
@@ -70,35 +78,48 @@
(* ;; "Save the last directory marker to pack on if needed.")
(\DEFINEDEVICE HOST (CREATE FDEV
USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE
FDEV2 _ (CONS PREFIX (CL:IF (EQ (CHARCODE /)
(NTHCHARCODE PREFIX -1
))
'/
'<))
OPENFILE _ (FUNCTION OPENFILE.PH)
GETFILENAME _ (FUNCTION GETFILENAME.PH)
DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH)
CLOSEFILE _ (FUNCTION CLOSEFILE.PH)
REOPENFILE _ (FUNCTION REOPENFILE.PH)
DELETEFILE _ (FUNCTION DELETEFILE.PH)
OPENP _ (FUNCTION OPENP.PH)
UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH)
REGISTERFILE _ (FUNCTION REGISTERFILE.PH)
GENERATEFILES _ (FUNCTION GENERATEFILES.PH)
GETFILEINFO _ (FUNCTION GETFILEINFO.PH)
SETFILEINFO _ (FUNCTION SETFILEINFO.PH)
RENAMEFILE _ (FUNCTION RENAMEFILE.PH]
ELSEIF (PSEUDOHOSTP HOST)
THEN (UNINTERRUPTABLY
(* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.")
(\DEFINEDEVICE HOST
(CREATE FDEV
USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE FDEV2 _ PREFIX
OPENFILE _ (FUNCTION OPENFILE.PH)
GETFILENAME _ (FUNCTION GETFILENAME.PH)
DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH)
CLOSEFILE _ (FUNCTION CLOSEFILE.PH)
REOPENFILE _ (FUNCTION REOPENFILE.PH)
DELETEFILE _ (FUNCTION DELETEFILE.PH)
OPENP _ (FUNCTION OPENP.PH)
UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH)
REGISTERFILE _ (FUNCTION REGISTERFILE.PH)
GENERATEFILES _ (FUNCTION GENERATEFILES.PH)
GETFILEINFO _ (FUNCTION GETFILEINFO.PH)
SETFILEINFO _ (FUNCTION SETFILEINFO.PH)
RENAMEFILE _ (FUNCTION RENAMEFILE.PH)))
(SETQ \FILEDEVICES (DREMOVE (\GETDEVICEFROMNAME HOST \FILEDEVICES)
\FILEDEVICES))
(\DEFINEDEVICE HOST NIL))
ELSE (ERROR HOST "is not a pseudohost"))
(* ;; "The ultimate target device keeps a map of prefixes and the hostnames they map to. The longest matching prefix is chosen when a name that expands to the target device is contracted.")
(CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEVICE)
(SORT (CONS (LIST PREFIX HOST (CL:IF (EQ (CHARCODE /)
(NTHCHARCODE PREFIX -1))
'/
'<))
DATUM)
(FUNCTION (LAMBDA (P1 P2)
(IGREATERP (NCHARS (CAR P1))
(NCHARS (CAR P2]
ELSEIF (SETQ PREFIX (CADR (PSEUDOHOSTP HOST)))
THEN
(* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.")
(LET* ((PHHOST (\GETDEVICEFROMNAME HOST \FILEDEVICES))
(TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF PHHOST)))
(UNINTERRUPTABLY
(CL:WHEN TARGETDEV (* ;
 "Don't want to fail uninterruptably")
(CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEV)
(DREMOVE (ASSOC PREFIX DATUM)
DATUM)))
(SETQ \FILEDEVICES (DREMOVE PHHOST \FILEDEVICES))
(\DEFINEDEVICE HOST NIL))]
HOST])
(PSEUDOHOSTP
@@ -131,6 +152,15 @@
(CL:IF (TYPE? PHDEVICE DEVICE)
(EXPAND.PH FILENAME DEVICE)
FILENAME)])
(PSEUDOFILENAME
[LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk")
(* ; "Edited 28-Jan-2022 09:06 by rmk")
(FOR D PN (FILENAME _ (IF (STREAMP FILE)
THEN (FETCH (STREAM FULLFILENAME) OF FILE)
ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES
WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D)))
DO (RETURN PN) FINALLY (RETURN FILENAME])
)
@@ -142,52 +172,64 @@
(EXPAND.PH
[LAMBDA (FILENAME PHDEV)
(* ;; "Edited 26-Jan-2022 11:06 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name")
(* ;; "Edited 30-Jan-2022 00:15 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name")
(* ;; "Assumes that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name")
(IF (TYPE? STREAM FILENAME)
[IF (TYPE? STREAM FILENAME)
THEN (CL:UNLESS PHDEV
(SETQ PHDEV (FETCH (STREAM DEVICE) OF FILENAME)))
(SETQ FILENAME (FETCH (STREAM FULLNAME) OF FILENAME))
ELSEIF (NOT (TYPE? FDEV PHDEV))
THEN (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV)))
(LET (SUFFIX SUFFIXPOS)
(CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME))
(SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS)))
(CL:WHEN (FMEMB (CHCON1 SUFFIX)
(CHARCODE (< > /)))
(SETQ SUFFIX (SUBSTRING SUFFIX 2)))
(CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV)
SUFFIX))])
THEN (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV (FILENAMEFIELD FILENAME 'HOST]
(IF (TYPE? PHDEVICE PHDEV)
THEN (LET (SUFFIX SUFFIXPOS)
(CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME))
(SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS)))
(CL:WHEN (FMEMB (CHCON1 SUFFIX)
(CHARCODE (< > /)))
(SETQ SUFFIX (SUBSTRING SUFFIX 2)))
(CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV)
SUFFIX)))
ELSE FILENAME])
(CONTRACT.PH
[LAMBDA (NAME PHDEV) (* ; "Edited 25-Jan-2022 09:44 by rmk")
(* ; "Edited 20-Jan-2022 20:04 by rmk")
(* ; "Edited 18-Jan-2022 22:54 by rmk")
(* ; "Edited 16-Jan-2022 19:57 by rmk")
(* ; "Edited 14-Jan-2022 00:03 by rmk")
[LAMBDA (NAME PHDEV)
(* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then")
(* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.")
(* ;; "If pseudohosts are defined in terms of other pseudohosts (e.g. FUM is defined in terms of FOO which is defined in terms of LI which is rooted in DSK, then the pseudodevices presumably were created in that order, so the first name we encounter will be the one with the longest prefix. So {DSK}... might collapse to {FUM}. But {FOO}... will not. ")
(CL:UNLESS (TYPE? FDEV PHDEV)
(SETQ PHDEV (\GETDEVICEFROMNAME PHDEV)))
(CL:WHEN NAME
(LET* [(PREFIX (FETCH (PHDEVICE PREFIX) OF PHDEV))
(CONNECTOR (FETCH (PHDEVICE CONNECTOR) OF PHDEV))
(SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX]
(IF (STRPOS PREFIX NAME 1 NIL T NIL FILEDIRCASEARRAY)
THEN (CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY)
(FOR PM PREFIX SUFFIX CONNECTOR IN (FETCH (TARGETDEVICE PREFIXMAP) OF (FETCH (PHDEVICE
TARGETDEV
)
OF PHDEV))
WHEN (STRPOS (SETQ PREFIX (CAR PM))
NAME 1 NIL T NIL FILEDIRCASEARRAY)
DO
(* ;; "This is the lowest host. ")
(* ;; "Must be a subdirectory. (CDR INFO) tells us whether to use / or > depending on what the prefix has")
[SETQ SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX]
(CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY)
[SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/)
THEN (SLASHIT SUFFIX)
ELSE (UNSLASHIT SUFFIX])
(PACK* '{ (FETCH (FDEV DEVICENAME) OF PHDEV)
"}"
(OR SUFFIX ""))
ELSE
(* ;; "If the target's NAME didn't begin with the prefix, then the caller must have jumped outside the pseudo root. So just return the NAME")
(* ;; "CONNECTOR tells us whether to use / or > depending on what the prefix has")
NAME)))])
(SETQ CONNECTOR (CADDR PM))
[SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/)
THEN (SLASHIT SUFFIX)
ELSE (UNSLASHIT SUFFIX])
(RETURN (PACK* '{ (CADR PM)
"}"
(OR SUFFIX ""))) FINALLY
(* ;; "If we didn't match a prefix, then this was not related to any pseudhost descending from the target, it is a pure target name, presumably because something like a relative .. reference took it off all paths. We return the original name.")
(RETURN NAME)))])
(SLASHIT
[LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk")
@@ -376,13 +418,15 @@
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(ACCESSFNS PHDEVICE [(PREFIX (CAR (FETCH (FDEV FDEV2) OF DATUM)))
(ACCESSFNS PHDEVICE ((PREFIX (FETCH (FDEV FDEV2) OF DATUM))
(TARGETDEV (FETCH (FDEV FDEV1) OF DATUM)
(REPLACE (FDEV FDEV1) OF DATUM WITH NEWVALUE))
(CONNECTOR (CDR (FETCH (FDEV FDEV2) OF DATUM]
(REPLACE (FDEV FDEV1) OF DATUM WITH NEWVALUE)))
(TYPE? (FETCH (PHDEVICE PREFIX) OF DATUM)))
(RECORD PHGENFILESTATE (PHDEVICE . TARGETGENFILESTATE))
(ACCESSFNS TARGETDEVICE ((PREFIXMAP (FETCH (FDEV FDEV3) OF DATUM)
(REPLACE (FDEV FDEV3) OF DATUM WITH NEWVALUE))))
)
(DECLARE%: EVAL@COMPILE
@@ -427,12 +471,12 @@
(LOAD 'EXPORTS.ALL))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1205 7096 (PSEUDOHOST 1215 . 5418) (PSEUDOHOSTP 5420 . 5770) (PSEUDOHOSTS 5772 . 6129)
(TARGETHOST 6131 . 6405) (TRUEFILENAME 6407 . 7094)) (7124 13330 (EXPAND.PH 7134 . 8189) (CONTRACT.PH
8191 . 10010) (SLASHIT 10012 . 11580) (UNSLASHIT 11582 . 13328)) (13331 20121 (OPENFILE.PH 13341 .
13902) (GETFILENAME.PH 13904 . 14193) (DIRECTORYNAMEP.PH 14195 . 14819) (CLOSEFILE.PH 14821 . 15175) (
REOPENFILE.PH 15177 . 15742) (DELETEFILE.PH 15744 . 16028) (OPENP.PH 16030 . 16206) (UNREGISTERFILE.PH
16208 . 16513) (REGISTERFILE.PH 16515 . 16816) (GENERATEFILES.PH 16818 . 17858) (GETFILEINFO.PH 17860
. 18162) (SETFILEINFO.PH 18164 . 18363) (NEXTFILEFN.PH 18365 . 18907) (FILEINFOFN.PH 18909 . 19180) (
RENAMEFILE.PH 19182 . 20119)))))
(FILEMAP (NIL (1355 8925 (PSEUDOHOST 1365 . 6625) (PSEUDOHOSTP 6627 . 6977) (PSEUDOHOSTS 6979 . 7336)
(TARGETHOST 7338 . 7612) (TRUEFILENAME 7614 . 8301) (PSEUDOFILENAME 8303 . 8923)) (8953 16177 (
EXPAND.PH 8963 . 10190) (CONTRACT.PH 10192 . 12857) (SLASHIT 12859 . 14427) (UNSLASHIT 14429 . 16175))
(16178 22968 (OPENFILE.PH 16188 . 16749) (GETFILENAME.PH 16751 . 17040) (DIRECTORYNAMEP.PH 17042 .
17666) (CLOSEFILE.PH 17668 . 18022) (REOPENFILE.PH 18024 . 18589) (DELETEFILE.PH 18591 . 18875) (
OPENP.PH 18877 . 19053) (UNREGISTERFILE.PH 19055 . 19360) (REGISTERFILE.PH 19362 . 19663) (
GENERATEFILES.PH 19665 . 20705) (GETFILEINFO.PH 20707 . 21009) (SETFILEINFO.PH 21011 . 21210) (
NEXTFILEFN.PH 21212 . 21754) (FILEINFOFN.PH 21756 . 22027) (RENAMEFILE.PH 22029 . 22966)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jan-2022 13:24:29" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;106 34264
(FILECREATED "28-Jan-2022 23:52:21" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;113 36064
:CHANGES-TO (FNS RELCREATEREGION \RELCREATEREGION.SIZE RELGETREGION)
:CHANGES-TO (FNS CLOSEWITH MOVEWITH MOVEWITH.DOIT CLOSEWITH.DOIT)
:PREVIOUS-DATE "25-Jan-2022 15:38:10"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;105)
:PREVIOUS-DATE "28-Jan-2022 16:55:38"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;108)
(PRETTYCOMPRINT REGIONMANAGERCOMS)
@@ -36,6 +36,7 @@
(* ;; "Composite application construction")
(COMS (FNS RM-ATTACHWINDOW)
(FNS CLOSEWITH CLOSEWITH.DOIT MOVEWITH MOVEWITH.DOIT)
(P (MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG)
(MOVD 'RM-ATTACHWINDOW 'ATTACHWINDOW))
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS RFIELDDIFF])
@@ -613,6 +614,39 @@
(WINDOWPROP WINDOWTOATTACH 'PASSTOMAINCOMS WINDOWCOMACTION))))
VAL])
)
(DEFINEQ
(CLOSEWITH
[LAMBDA (CHILDREN PARENT) (* ; "Edited 28-Jan-2022 23:51 by rmk")
[FOR C ONE INSIDE CHILDREN WHEN (AND C (SETQ C (WFROMDS C))) DO (SETQ ONE T)
(WINDOWADDPROP PARENT
'CLOSECHILDREN C)
FINALLY (CL:WHEN ONE
(WINDOWADDPROP PARENT 'CLOSEFN (FUNCTION CLOSEWITH.DOIT)))]
PARENT])
(CLOSEWITH.DOIT
[LAMBDA (PARENT) (* ; "Edited 28-Jan-2022 17:54 by rmk")
(FOR C IN (WINDOWPROP PARENT 'CLOSECHILDREN) WHEN (OPENWP C) DO (CLOSEW C))
(WINDOWPROP PARENT 'CLOSECHILDREN NIL)
PARENT])
(MOVEWITH
[LAMBDA (CHILDREN PARENT) (* ; "Edited 28-Jan-2022 23:43 by rmk")
[FOR C ONE INSIDE CHILDREN WHEN (AND C (SETQ C (WFROMDS C))) DO (SETQ ONE T)
(WINDOWADDPROP PARENT
'MOVECHILDREN C)
FINALLY (CL:WHEN ONE
(WINDOWADDPROP PARENT 'MOVEFN (FUNCTION MOVEWITH.DOIT)))]
PARENT])
(MOVEWITH.DOIT
[LAMBDA (PARENT NEWPOS) (* ; "Edited 28-Jan-2022 22:34 by rmk")
[FOR C (DELTA _ (PTDIFFERENCE NEWPOS (WINDOWPOSITION PARENT))) IN (WINDOWPROP PARENT
'MOVECHILDREN)
DO (MOVEW C (PTPLUS DELTA (WINDOWPOSITION C]
PARENT])
)
(MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG)
@@ -626,9 +660,10 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1612 3799 (SET-TYPED-REGIONS 1622 . 3797)) (3800 10801 (RM-CREATEW 3810 . 6317) (
RM-CLOSEW 6319 . 7720) (RM-GETREGION 7722 . 10308) (CLOSE-TYPED-W 10310 . 10799)) (11717 19196 (
RELCREATEREGION 11727 . 16350) (RELGETREGION 16352 . 18959) (RELCREATEPOSITION 18961 . 19194)) (19197
24499 (\RELCREATEREGION.REF 19207 . 22239) (\RELCREATEREGION.SIZE 22241 . 24497)) (24552 33894 (
RM-ATTACHWINDOW 24562 . 33892)))))
(FILEMAP (NIL (1677 3864 (SET-TYPED-REGIONS 1687 . 3862)) (3865 10866 (RM-CREATEW 3875 . 6382) (
RM-CLOSEW 6384 . 7785) (RM-GETREGION 7787 . 10373) (CLOSE-TYPED-W 10375 . 10864)) (11782 19261 (
RELCREATEREGION 11792 . 16415) (RELGETREGION 16417 . 19024) (RELCREATEPOSITION 19026 . 19259)) (19262
24564 (\RELCREATEREGION.REF 19272 . 22304) (\RELCREATEREGION.SIZE 22306 . 24562)) (24617 33959 (
RM-ATTACHWINDOW 24627 . 33957)) (33960 35694 (CLOSEWITH 33970 . 34497) (CLOSEWITH.DOIT 34499 . 34779)
(MOVEWITH 34781 . 35304) (MOVEWITH.DOIT 35306 . 35692)))))
STOP

Binary file not shown.

View File

@@ -49,13 +49,60 @@ Each of these applications is constructed by anticipating the subregions that th
Also for convenience, if WIDTH is a potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call.
(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function]
Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen.
Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen.
(RELCREATEPOSITION REFX REFY) [Function]
Creates a position with X and Y coordinates specified by REFX and REFY references as above.
Constellation regions
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region.
Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window.
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions.
A somewhat weaker form of a constellation is a collection of windows that are not attached around a central window but stand in a parent-child relationship at least with respect to closing and moving. A parent windows spawns children that respond independently to ordinary window commands (move, shape, close). But the children close when the parent closes, and the children move when the parent moves so that they continue to appear in the same relative positions. These primitives allow the construction of a tree of windows that are dependent in this way.
(CLOSEWITH CHILDREN PARENT) [Function]
Establishes a link between the PARENT window and any number of CHILDREN windows such that all CHILDREN will close when PARENT closes. The closing is accomplished by CLOSEWITH.DOIT:
(CLOSEWITH.DOIT PARENT) [Function]
Creates a position with X and Y coordinates specified by REFX and REFY references as above.
Constellation regions
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region.
Closes the close-with children of PARENT.
(MOVEWITH CHILDREN PARENT) [Function]
Establishes a link between the PARENT window and any number of CHILDREN windows such that all CHILDREN will move when PARENT closes. The closing is accomplished by MOVEWITH.DOIT:
(MOVEWITH.DOIT PARENT NEWPOS) [Function]
If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before.
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))4Ⱥ4ÈÈ4ÈÈ4ÈÈ4ÈÈ4ÈÈ. $È. È.È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADTERMINALÿüTERMINALÿü
TIMESROMAN$TERMINALMODERN MODERN
 HRULE.GETFN
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
 HRULE.GETFNMODERN

 HRULE.GETFNMODERN
   HRULE.GETFNMODERN 
 HRULE.GETFNMODERN   
(

È
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions.(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 4ÈÈ4ÈÈ4ÈÈ4ÈÈ. $È. È.È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADTERMINALÿüTERMINALÿü

}


/ ¯
[ <01>
Ch
<00>T Û

Á
?


; 3o)
M

A
 &Mm
JS-

j 
/3t2C ƒ
 "
O

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jan-2022 13:20:38" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;109 49971
(FILECREATED "30-Jan-2022 09:03:52" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;112 47459
:CHANGES-TO (FNS COMPARETEXT.TEXTOBJ)
:PREVIOUS-DATE "23-Jan-2022 20:22:06"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;108)
:PREVIOUS-DATE "28-Jan-2022 17:12:30"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;110)
(* ; "
@@ -130,12 +130,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
WINDOW])
(COMPARETEXT.TEXTOBJ
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 27-Jan-2022 13:14 by rmk")
(* ; "Edited 23-Jan-2022 16:51 by rmk")
(* ; "Edited 20-Jan-2022 22:29 by rmk")
(* ; "Edited 19-Jan-2022 08:52 by rmk")
(* ; "Edited 30-Dec-2021 21:21 by rmk")
(* ; "Edited 27-Dec-2021 15:56 by rmk")
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Jan-2022 09:03 by rmk")
(* ; "Edited 28-Jan-2022 22:37 by rmk")
(* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.")
@@ -172,30 +168,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
'FILELABELS))
(CADDR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
'FILELABELS)))]
[WINDOWADDPROP WINDOW 'MOVEFN (FUNCTION (LAMBDA (W NEWPOS)
(LET ((DELTA (PTDIFFERENCE NEWPOS (
WINDOWPOSITION
W)))
TOBJ TW)
(CL:WHEN [AND (SETQ TOBJ
(WINDOWPROP W
'COL1TEXTOBJ))
(SETQ TW
(WFROMDS (TEXTSTREAM
TOBJ]
(MOVEW TW (PTPLUS DELTA (
WINDOWPOSITION
TW))))
(CL:WHEN [AND (SETQ TOBJ
(WINDOWPROP W
'COL2TEXTOBJ))
(SETQ TW
(WFROMDS (TEXTSTREAM
TOBJ]
(MOVEW TW (PTPLUS DELTA (
WINDOWPOSITION
TW))))
NIL])
(MOVEWITH TWINDOW WINDOW)
(CLOSEWITH TWINDOW WINDOW))
TEXTOBJ])
(COMPARETEXT.SETSEL
@@ -781,12 +755,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
)
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1345 42591 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) (
COMPARETEXT.TEXTOBJ 7677 . 12786) (COMPARETEXT.SETSEL 12788 . 13578) (CHUNKNODELABEL 13580 . 14701) (
IMCOMPARE.BOXNODE 14703 . 15470) (IMCOMPARE.CHUNKS 15472 . 19848) (IMCOMPARE.COLLECT.HASH.CHUNKS 19850
. 22767) (IMCOMPARE.DISPLAYGRAPH 22769 . 30612) (IMCOMPARE.HASH 30614 . 34801) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 34803 . 38299) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 38301 . 40256) (
IMCOMPARE.SHOW.DIST 40258 . 40704) (IMCOMPARE.UPDATE.SYMBOL.TABLE 40706 . 42589)) (42592 48749 (
IMCOMPARE.LEFTBUTTONFN 42602 . 45179) (IMCOMPARE.MIDDLEBUTTONFN 45181 . 48297) (IMCOMPARE.COPYBUTTONFN
48299 . 48747)) (48802 49493 (TAIL1 48812 . 49166) (TAIL2 49168 . 49491)))))
(FILEMAP (NIL (1345 40079 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) (
COMPARETEXT.TEXTOBJ 7677 . 10274) (COMPARETEXT.SETSEL 10276 . 11066) (CHUNKNODELABEL 11068 . 12189) (
IMCOMPARE.BOXNODE 12191 . 12958) (IMCOMPARE.CHUNKS 12960 . 17336) (IMCOMPARE.COLLECT.HASH.CHUNKS 17338
. 20255) (IMCOMPARE.DISPLAYGRAPH 20257 . 28100) (IMCOMPARE.HASH 28102 . 32289) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 32291 . 35787) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 35789 . 37744) (
IMCOMPARE.SHOW.DIST 37746 . 38192) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38194 . 40077)) (40080 46237 (
IMCOMPARE.LEFTBUTTONFN 40090 . 42667) (IMCOMPARE.MIDDLEBUTTONFN 42669 . 45785) (IMCOMPARE.COPYBUTTONFN
45787 . 46235)) (46290 46981 (TAIL1 46300 . 46654) (TAIL2 46656 . 46979)))))
STOP