1
0
mirror of synced 2026-03-09 04:30:27 +00:00

Rmk27 GITFNS for renaming, minor other convenience adjustments (#728)

* GITFNS, COMPAREDIRECTORIES: more on renaming and copying

* MODERNIZE: use Wborder for the top for windows without titles

* DIRECTORY:  DEPTH as a parameter

* FILEPKG:  EDITCALLERS does FILDIR if FILES contains *

* GITFNS: Don't error on a non-existent "deleted" file
This commit is contained in:
rmkaplan
2022-03-07 12:38:35 -08:00
committed by GitHub
parent 74dc52b73f
commit 831aa94cb4
11 changed files with 408 additions and 362 deletions

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Feb-2022 12:47:42" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;211 124421
(FILECREATED " 6-Mar-2022 19:53:40" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;214 123835
:CHANGES-TO (FNS CD-MENUFN)
:CHANGES-TO (FNS CD.COMMANDSELECTEDFN)
:PREVIOUS-DATE "25-Feb-2022 21:30:55"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;209)
:PREVIOUS-DATE " 5-Mar-2022 15:10:31"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;213)
(* ; "
@@ -386,12 +386,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(DEFINEQ
(CDFILES
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 25-Feb-2022 21:26 by rmk")
(* ; "Edited 26-Jan-2022 15:25 by rmk")
(* ; "Edited 21-Jan-2022 22:40 by rmk")
(* ; "Edited 5-Jan-2022 15:07 by rmk")
(* ; "Edited 23-Dec-2021 22:49 by rmk")
(* ; "Edited 6-Nov-2021 12:08 by rmk:")
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 5-Mar-2022 15:05 by rmk")
(* ; "Edited 16-Oct-2020 13:42 by rmk:")
(* ;; "Returns a list of fullnames for files that satisfy the criteria. We generate all candidates that match INCLUDEDFILES but not EXCLUDEDFILES in DIR.")
@@ -418,18 +413,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(SETQ EXCLUDEDFILES (LDIFFERENCE EXCLUDEDFILES INCLUDEDFILES))
(LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*]
(EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES)))
HOST FILING.ENUMERATION.DEPTH ENUMPAT)
(DECLARE (SPECVARS FILING.ENUMERATION.DEPTH))
HOST ENUMPAT)
(SETQ HOST (FILENAMEFIELD DIR 'HOST))
(SETQ DIR (FILENAMEFIELD DIR 'DIRECTORY))
[SETQ FILING.ENUMERATION.DEPTH (IF (EQ DEPTH T)
THEN MAX.SMALLP
ELSEIF DEPTH
ELSE
(* ;; "DEPTH is the number of internal > or /")
(CL:UNLESS DEPTH
(FOR P IN INCLUDES LARGEST (CADDDR P)
FINALLY (RETURN $$EXTREME]
(* ;; "DEPTH is the number of internal > or /")
(SETQ DEPTH (FOR P IN INCLUDES LARGEST (CADDDR P) FINALLY (RETURN $$EXTREME))))
(* ;; "ENUMPAT is the single pattern that we use for the directory enumeration (given the enumeration depth). We have to go to the most general specification, then filter the generated results.")
@@ -462,25 +453,27 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(* ;; "We enumerate all the files, checking to see that")
(FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (ADD1 (NCHARS DIR)))
IN (DIRECTORY ENUMPAT NIL NIL (CL:IF ALLVERSIONS
"*"
""))
EACHTIME (SETQ UNPACK (UNPACKFILENAME FULLNAME))
(SETQ NAME (LISTGET UNPACK 'NAME))
(SETQ EXT (LISTGET UNPACK 'EXTENSION))
(CL:UNLESS NAME
(CL:WHEN EXT (* ; ".XY")
(SETQ NAME (PACK* "." EXT))
(SETQ EXT NIL)))
(CL:UNLESS (OR NAME EXT) (* ; "Must have been a directory")
(GO $$ITERATE))
(SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY)
STARTPOS))
(SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SUBDIR I)
((> /)
(ADD CNT 1))
(NIL (RETURN CNT))
NIL)))
IN (DIRECTORY ENUMPAT `(DEPTH ,DEPTH COLLECT)
NIL
(CL:IF ALLVERSIONS
"*"
"")) EACHTIME (SETQ UNPACK (UNPACKFILENAME FULLNAME))
(SETQ NAME (LISTGET UNPACK 'NAME))
(SETQ EXT (LISTGET UNPACK 'EXTENSION))
(CL:UNLESS NAME
(CL:WHEN EXT (* ; ".XY")
(SETQ NAME (PACK* "." EXT))
(SETQ EXT NIL)))
(CL:UNLESS (OR NAME EXT)(* ; "Must have been a directory")
(GO $$ITERATE))
(SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY)
STARTPOS))
(SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1
DO (SELCHARQ (NTHCHARCODE SUBDIR I)
((> /)
(ADD CNT 1))
(NIL (RETURN CNT))
NIL)))
WHEN (OR (NULL INCLUDES)
(CDFILES.MATCH SUBDIR NAME EXT THISDEPTH INCLUDES))
UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME])
@@ -1808,7 +1801,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
'DON'T])
(CD.COMMANDSELECTEDFN
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 24-Feb-2022 19:52 by rmk")
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 6-Mar-2022 19:52 by rmk")
(* ; "Edited 24-Feb-2022 19:52 by rmk")
(* ; "Edited 5-Feb-2022 17:23 by rmk")
(* ; "Edited 27-Jan-2022 17:46 by rmk")
(* ; "Edited 10-Jan-2022 22:51 by rmk")
@@ -1864,11 +1858,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(* ;;
 "One of the files is not real if its date is %"%", a rename.")
(CL:WHEN (STREQUAL "" (FETCH (CDINFO DATE)
(CL:WHEN (STREQUAL "" (FETCH (CDINFO LENGTH)
OF (FETCH (CDENTRY INFO1)
OF CDENTRY)))
(SETQ FILE1 NIL))
(CL:WHEN (STREQUAL "" (FETCH (CDINFO DATE)
(CL:WHEN (STREQUAL "" (FETCH (CDINFO LENGTH)
OF (FETCH (CDENTRY INFO2)
OF CDENTRY)))
(SETQ FILE2 NIL))
@@ -2108,24 +2102,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
2018 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2599 22160 (COMPAREDIRECTORIES 2609 . 7836) (COMPAREDIRECTORIES.INFOS 7838 . 10600) (
COMPAREDIRECTORIES.CANDIDATES 10602 . 13987) (CDENTRIES.SELECT 13989 . 18764) (
COMPAREDIRECTORIES.INFOS.TYPE 18766 . 19394) (MATCHNAME 19396 . 20076) (CD.INSURECDVALUE 20078 . 21692
) (CD.UPDATEWIDTHS 21694 . 22158)) (22161 32410 (CDFILES 22171 . 28504) (CDFILES.MATCH 28506 . 30131)
(CDFILES.PATS 30133 . 32408)) (32411 47496 (CDPRINT 32421 . 34766) (CDPRINT.HEADER 34768 . 35665) (
CDPRINT.LINE 35667 . 38223) (CDPRINT.MAXWIDTHS 38225 . 42340) (CDPRINT.COLHEADERS 42342 . 42980) (
CDPRINT.COLUMNS 42982 . 46861) (CDTEDIT 46863 . 47494)) (47497 55866 (CDMAP 47507 . 48939) (CDENTRY
48941 . 49250) (CDSUBSET 49252 . 50691) (CDMERGE 50693 . 54547) (CDMERGE.COMMON 54549 . 55864)) (55867
63405 (BINCOMP 55877 . 60166) (EOLTYPE 60168 . 62730) (EOLTYPE.SHOW 62732 . 63403)) (63933 77140 (
FIND-UNCOMPILED-FILES 63943 . 67586) (FIND-UNSOURCED-FILES 67588 . 70397) (FIND-SOURCE-FILES 70399 .
72103) (FIND-COMPILED-FILES 72105 . 74183) (FIND-UNLOADED-FILES 74185 . 74929) (FIND-LOADED-FILES
74931 . 75485) (FIND-MULTICOMPILED-FILES 75487 . 77138)) (77141 85343 (CREATED-AS 77151 . 81948) (
SOURCE-FOR-COMPILED-P 81950 . 84648) (COMPILE-SOURCE-DATE-DIFF 84650 . 85341)) (85344 95650 (
FIX-DIRECTORY-DATES 85354 . 88347) (FIX-EQUIV-DATES 88349 . 89874) (COPY-COMPARED-FILES 89876 . 91697)
(COPY-MISSING-FILES 91699 . 93856) (COMPILED-ON-SAME-SOURCE 93858 . 95648)) (95844 103190 (CDBROWSER
95854 . 99781) (CDBROWSER.STRINGS 99783 . 103188)) (103352 105088 (CD.TABLEITEM 103362 . 103582) (
CD.TABLEITEM.PRINTFN 103584 . 103783) (CD.TABLEITEM.COPYFN 103785 . 104843) (
CDTABLEBROWSER.HEADING.REPAINTFN 104845 . 105086)) (105089 123837 (CDTABLEBROWSER.WHENSELECTEDFN
105099 . 105567) (CD.COMMANDSELECTEDFN 105569 . 110557) (CD-MENUFN 110559 . 116922) (CDBROWSER-COPY
116924 . 120295) (CDBROWSER-DELETE-FILE 120297 . 123316) (CD-SWAPDIRS 123318 . 123835)))))
(FILEMAP (NIL (2610 22171 (COMPAREDIRECTORIES 2620 . 7847) (COMPAREDIRECTORIES.INFOS 7849 . 10611) (
COMPAREDIRECTORIES.CANDIDATES 10613 . 13998) (CDENTRIES.SELECT 14000 . 18775) (
COMPAREDIRECTORIES.INFOS.TYPE 18777 . 19405) (MATCHNAME 19407 . 20087) (CD.INSURECDVALUE 20089 . 21703
) (CD.UPDATEWIDTHS 21705 . 22169)) (22172 31711 (CDFILES 22182 . 27805) (CDFILES.MATCH 27807 . 29432)
(CDFILES.PATS 29434 . 31709)) (31712 46797 (CDPRINT 31722 . 34067) (CDPRINT.HEADER 34069 . 34966) (
CDPRINT.LINE 34968 . 37524) (CDPRINT.MAXWIDTHS 37526 . 41641) (CDPRINT.COLHEADERS 41643 . 42281) (
CDPRINT.COLUMNS 42283 . 46162) (CDTEDIT 46164 . 46795)) (46798 55167 (CDMAP 46808 . 48240) (CDENTRY
48242 . 48551) (CDSUBSET 48553 . 49992) (CDMERGE 49994 . 53848) (CDMERGE.COMMON 53850 . 55165)) (55168
62706 (BINCOMP 55178 . 59467) (EOLTYPE 59469 . 62031) (EOLTYPE.SHOW 62033 . 62704)) (63234 76441 (
FIND-UNCOMPILED-FILES 63244 . 66887) (FIND-UNSOURCED-FILES 66889 . 69698) (FIND-SOURCE-FILES 69700 .
71404) (FIND-COMPILED-FILES 71406 . 73484) (FIND-UNLOADED-FILES 73486 . 74230) (FIND-LOADED-FILES
74232 . 74786) (FIND-MULTICOMPILED-FILES 74788 . 76439)) (76442 84644 (CREATED-AS 76452 . 81249) (
SOURCE-FOR-COMPILED-P 81251 . 83949) (COMPILE-SOURCE-DATE-DIFF 83951 . 84642)) (84645 94951 (
FIX-DIRECTORY-DATES 84655 . 87648) (FIX-EQUIV-DATES 87650 . 89175) (COPY-COMPARED-FILES 89177 . 90998)
(COPY-MISSING-FILES 91000 . 93157) (COMPILED-ON-SAME-SOURCE 93159 . 94949)) (95145 102491 (CDBROWSER
95155 . 99082) (CDBROWSER.STRINGS 99084 . 102489)) (102653 104389 (CD.TABLEITEM 102663 . 102883) (
CD.TABLEITEM.PRINTFN 102885 . 103084) (CD.TABLEITEM.COPYFN 103086 . 104144) (
CDTABLEBROWSER.HEADING.REPAINTFN 104146 . 104387)) (104390 123251 (CDTABLEBROWSER.WHENSELECTEDFN
104400 . 104868) (CD.COMMANDSELECTEDFN 104870 . 109971) (CD-MENUFN 109973 . 116336) (CDBROWSER-COPY
116338 . 119709) (CDBROWSER-DELETE-FILE 119711 . 122730) (CD-SWAPDIRS 122732 . 123249)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Mar-2022 19:52:30" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;108 71762
(FILECREATED " 7-Mar-2022 08:14:19" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;129 74976
:CHANGES-TO (FNS CDGITDIR)
:CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES)
:PREVIOUS-DATE " 5-Mar-2022 12:08:34"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;107)
:PREVIOUS-DATE " 6-Mar-2022 21:51:16"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;128)
(PRETTYCOMPRINT GITFNSCOMS)
@@ -216,13 +216,15 @@
(DEFCOMMAND cob (BRANCH)
(* ;; "Switches to BRANCH. Defaults to my current branch, T means my next branch (under wherever we are now ")
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now). Default is to bring up a menu of locally available branches.")
(SELECTQ (U-CASE BRANCH)
(NIL (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH)))
((T NEW)
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH)))
((NEW NEXT)
(GIT-MAKE-BRANCH))
(GIT-CHECKOUT BRANCH)))
(GIT-CHECKOUT (OR BRANCH (PICK-BRANCH NIL "Branches" 'LOCAL))
BRANCH
'LOCAL)))
(DEFCOMMAND b? (BRANCH) (GIT-WHICH-BRANCH))
@@ -481,7 +483,7 @@
(GIT-BRANCH-DIFF
[LAMBDA (BRANCH1 BRANCH2)
(* ;; "Edited 28-Feb-2022 22:27 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).")
(* ;; "Edited 6-Mar-2022 14:52 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).")
(* ;; "This returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).")
@@ -513,11 +515,14 @@
(M (CL:IF (SETQ POS (STRPOS " " L))
(PUSH CHANGED (SUBSTRING L (ADD1 POS)))
(ERROR "CHANGED NOT RECOGNIZED" L)))
(C (IF (SETQ POS (STRPOS " " L))
THEN [PUSH COPIED (LIST [SUBSTRING L (ADD1 POS)
(SUB1 (SETQ POS (STRPOS " " L (ADD1 POS]
(SUBSTRING L (ADD1 POS]
ELSE (HELP "COPY NOT UNDERSTOOD" L)))
(C (IF (AND (EQ (CHARCODE TAB)
(NTHCHARCODE L 5))
(SETQ POS (STRPOS " " L 7)))
THEN [PUSH COPIED (LIST (SUBSTRING L 6 (SUB1 POS))
(SUBSTRING L (ADD1 POS))
(OR (FIXP (SUBATOM L 2 4))
(HELP "C without a number" L]
ELSE (HELP "COPY NOT RECOGNIZED" L)))
(R (IF (AND (EQ (CHARCODE TAB)
(NTHCHARCODE L 5))
(SETQ POS (STRPOS " " L 7)))
@@ -550,17 +555,19 @@
(GIT-GET-FILE
[LAMBDA (BRANCH GITFILE LOCALFILE NOERROR)
(* ;; "Edited 24-Feb-2022 19:42 by rmk: the stream, not the name because of the NODIRCORE case.")
(* ;; "Edited 6-Mar-2022 17:45 by rmk: the stream, not the name because of the NODIRCORE case.")
(* ;; "Returns the stream, not the name because of the NODIRCORE case.")
(* ;; "If GITFILE in (remote) BRANCH exists, it is copied to LOCALFILE and LOCALFILE is returned. If it doesn't exist, return value is NIL if NOERROR, otherwise an ERROR.")
(CL:WHEN (AND BRANCH (STRPOS "local/" BRANCH 1 NIL T))
(SETQ BRANCH (SUBSTRING BRANCH 7)))
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR)
"git show " BRANCH ":" GITFILE)))
(SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL))
(LET (BYTES)
(IF (FOR I B C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: path '" I))
(IF (FOR I B C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I))
DO
(* ;;
 "Returns NIL if we run off the fatal string with a match, otherwise T")
@@ -588,7 +595,8 @@
ELSE (ERROR "GIT FILE NOT FOUND" GITFILE])
(GIT-FILE-EXISTS?
[LAMBDA (BRANCH GITFILE) (* ; "Edited 10-Feb-2022 20:55 by rmk")
[LAMBDA (BRANCH GITFILE) (* ; "Edited 6-Mar-2022 19:04 by rmk")
(* ; "Edited 10-Feb-2022 20:55 by rmk")
(* ; "Edited 10-Dec-2021 21:30 by rmk")
(* ;; "T if GITFILE exists on BRANCH. If s is EOFP, the file exists but is empty")
@@ -596,7 +604,7 @@
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR)
"git show " BRANCH ":" GITFILE)))
(SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL))
(NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: path '" I))
(NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I))
ALWAYS (EQ (BIN s)
C])
@@ -627,7 +635,10 @@
(CAR RESULT])
(GIT-FILE-DATE
[LAMBDA (GFILE BRANCH) (* ; "Edited 3-Jan-2022 19:43 by rmk")
[LAMBDA (GFILE BRANCH) (* ; "Edited 6-Mar-2022 17:41 by rmk")
(* ; "Edited 3-Jan-2022 19:43 by rmk")
(CL:WHEN (AND NIL BRANCH (STRPOS "local/" BRANCH 1 NIL T))
(SETQ BRANCH (SUBSTRING BRANCH 7)))
(LET [(DATE (CAR (GIT-COMMAND (CONCAT "git log -1 --pretty=%"format:%%cD%" "
(CL:IF BRANCH
(CONCAT BRANCH " -- ")
@@ -692,46 +703,46 @@
ELSE (HELP "Unexpected git result" RESULT])
(GIT-BRANCHES
[LAMBDA (WHERE) (* ; "Edited 24-Feb-2022 21:20 by rmk")
[LAMBDA (WHERE) (* ; "Edited 6-Mar-2022 08:54 by rmk")
(* ; "Edited 24-Feb-2022 21:20 by rmk")
(* ; "Edited 8-Dec-2021 08:43 by rmk")
(* ; "Edited 17-Nov-2021 18:20 by rmk:")
(* ; "Edited 16-Nov-2021 09:21 by rmk:")
(* ;;
 "Strips of the %"* %" that indicates the current branch and the 2-space padding on other branches")
(* ;; "Strips of the %"* %" that indicates the current branch and the 2-space padding on other branches. Packs local/ on to local branches")
(LET [(LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
(LET [[LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
'(NIL ALL LOCAL))
(GIT-COMMAND "git branch")))
(FOR B IN (GIT-COMMAND "git branch") COLLECT (PACK* "local/" (SUBATOM B 3))))]
(REMOTE (CL:WHEN (MEMB (U-CASE WHERE)
'(NIL ALL REMOTE T))
(GIT-COMMAND "git branch -r"]
(SORT (FOR B IN (APPEND LOCAL REMOTE) COLLECT (SUBATOM B 3])
(FOR B IN (GIT-COMMAND "git branch -r") COLLECT (SUBATOM B 3)))]
(SORT (APPEND LOCAL REMOTE])
(GIT-BRANCH-EXISTS?
[LAMBDA (BRANCH WHERE NOERROR) (* ; "Edited 16-Dec-2021 08:50 by rmk")
(* ; "Edited 8-Dec-2021 08:44 by rmk")
(* ; "Edited 19-Nov-2021 15:13 by rmk:")
(* ; "Edited 17-Nov-2021 18:24 by rmk:")
[LAMBDA (BRANCH WHERE NOERROR) (* ; "Edited 6-Mar-2022 15:28 by rmk")
(* ; "Edited 16-Dec-2021 08:50 by rmk")
(* ; "Edited 8-Dec-2021 08:44 by rmk")
(* ; "Edited 19-Nov-2021 15:13 by rmk:")
(* ; "Edited 17-Nov-2021 18:24 by rmk:")
(* ;; "Returns the canonical name of the branch (xxx or origin/xxx) depending on whether BRANCH is local/xxx or origin/xxx")
(* ; "Edited 16-Nov-2021 09:25 by rmk:")
(IF (STRPOS "origin/" BRANCH)
THEN (SETQ WHERE 'REMOTE)
ELSEIF (STRPOS "local/" BRANCH 1 NIL T)
THEN (SETQ WHERE 'LOCAL)
(SETQ BRANCH (SUBATOM BRANCH 7)))
(IF (CAR (MEMB (MKATOM BRANCH)
(GIT-BRANCHES WHERE)))
 (* ; "Edited 16-Nov-2021 09:25 by rmk:")
(IF [CAR (MEMB (MKATOM BRANCH)
(GIT-BRANCHES (IF (STRPOS "origin/" BRANCH 1 NIL T)
THEN 'REMOTE
ELSEIF (STRPOS "local/" BRANCH 1 NIL T)
THEN 'LOCAL]
ELSEIF (NOT NOERROR)
THEN (ERROR "Unknown branch" BRANCH])
(PICK-BRANCH
[LAMBDA (BRANCHES TITLE) (* ; "Edited 25-Feb-2022 09:02 by rmk")
[LAMBDA (BRANCHES TITLE WHERE) (* ; "Edited 6-Mar-2022 08:55 by rmk")
(* ; "Edited 25-Feb-2022 09:02 by rmk")
(MENU (CREATE MENU
TITLE _ (OR TITLE 'Branches)
ITEMS _ (OR (LISTP BRANCHES)
(GIT-BRANCHES BRANCHES))
(GIT-BRANCHES WHERE))
MENUFONT _ DEFAULTFONT])
(GIT-PULL-REQUESTS
@@ -793,7 +804,8 @@
0])
(GIT-MY-BRANCHES
[LAMBDA NIL (* ; "Edited 19-Jan-2022 13:20 by rmk")
[LAMBDA NIL (* ; "Edited 6-Mar-2022 21:50 by rmk")
(* ; "Edited 19-Jan-2022 13:20 by rmk")
(* ; "Edited 8-Jan-2022 09:53 by rmk")
(* ; "Edited 12-Dec-2021 11:46 by rmk")
@@ -803,7 +815,7 @@
(* ;; "The return list is sorted so that lower n's come before later n's. The last element is my current branch")
(FOR B (INITS _ (GIT-INITIALS))
(FOR B (INITS _ (CONCAT "local/" (GIT-INITIALS)))
INC IN (GIT-BRANCHES) FIRST (SETQ INC (NCHARS INITS))
WHEN (STRPOS INITS B 1 NIL T NIL UPPERCASEARRAY) COLLECT B
FINALLY (RETURN (SORT $$VAL (FUNCTION (LAMBDA (A B)
@@ -823,10 +835,11 @@
(DEFINEQ
(GIT-ADD-WORKTREE
[LAMBDA (BRANCH REMOTEONLY) (* ; "Edited 12-Dec-2021 11:57 by rmk")
(* ; "Edited 25-Nov-2021 08:45 by rmk:")
(* ; "Edited 19-Nov-2021 19:01 by rmk:")
(* ; "Edited 17-Nov-2021 18:25 by rmk:")
[LAMBDA (BRANCH REMOTEONLY) (* ; "Edited 6-Mar-2022 15:51 by rmk")
(* ; "Edited 12-Dec-2021 11:57 by rmk")
(* ; "Edited 25-Nov-2021 08:45 by rmk:")
(* ; "Edited 19-Nov-2021 19:01 by rmk:")
(* ; "Edited 17-Nov-2021 18:25 by rmk:")
(SETQ BRANCH (GITORIGIN BRANCH (NOT REMOTEONLY)))
(CL:UNLESS (OR (GIT-BRANCH-EXISTS? BRANCH NIL T)
(GIT-BRANCH-EXISTS? BRANCH T))
@@ -894,12 +907,14 @@
(DEFINEQ
(GIT-GET-DIFFERENT-FILES
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 24-Feb-2022 23:57 by rmk")
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 7-Mar-2022 08:14 by rmk")
(* ; "Edited 24-Feb-2022 23:57 by rmk")
(* ; "Edited 23-Feb-2022 18:47 by rmk")
(* ; "Edited 12-Feb-2022 18:35 by rmk")
(* ; "Edited 23-Jan-2022 21:45 by rmk")
(* ; "Edited 11-Jan-2022 11:03 by rmk")
(* ; "Edited 5-Jan-2022 08:01 by rmk")
(DECLARE (USEDFREE FROMGITN))
(* ;; "Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.")
@@ -930,49 +945,66 @@
(SETQ DIR2 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH2)
">")))
(FOR DLIST IN DIFFS
DO
(SELECTQ (CAR DLIST)
(ADDED (* ;
DO (SELECTQ (CAR DLIST)
(ADDED (* ;
 "Shouldn't exist in MERGE, should exist in BRANCH1")
(FOR GFILE IN (CDR DLIST) DO (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1 GFILE))))
(DELETED (* ;
 "Shouldn't exist in BRANCH1, should exist in MERGE")
(FOR GFILE IN (CDR DLIST) DO (GIT-GET-FILE MERGE GFILE (CONCAT DIR2 GFILE))))
(CHANGED (* ; "Should exist in both branches")
(FOR GFILE IN (CDR DLIST) DO (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1 GFILE)
)
(GIT-GET-FILE MERGE GFILE (CONCAT DIR2 GFILE))))
(RENAMED
(* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, mappings is returned so the connection can be reestablished higher up. If renamed, it has disappared from the first location and appeared in the second. The destination is in the CADR, the CAR file doesn't exist. But we store the files in DIR1 because they are coming from branch1")
(FOR GFILE IN (CDR DLIST) DO (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1 GFILE
))))
(DELETED
(* ;; "Shouldn't exist in BRANCH1, should exist in MERGE. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.")
[FOR GFILE IN (CDR DLIST)
DO (IF (EQ (CADDR GFILE)
100)
THEN (PUSH MAPPINGS (LIST [FULLNAME (GIT-GET-FILE
BRANCH1
(CADR GFILE)
(CONCAT DIR1 (CADR GFILE]
(CONCAT DIR2 (CAR GFILE))
'R))
ELSE (* ;
 "Deleted from MERGE, added to BRANCH1")
(GIT-GET-FILE MERGE (CAR GFILE)
(CONCAT DIR1 (CAR GFILE)))
(GIT-GET-FILE BRANCH1 (CADR GFILE)
(CONCAT DIR2 (CADR GFILE])
(COPIED
(* ;; "Same issue as for renaming")
(FOR GFILE IN (CDR DLIST) DO (OR (GIT-GET-FILE MERGE GFILE
(CONCAT DIR2 GFILE)
T)
(GIT-GET-FILE BRANCH1 GFILE
(CONCAT DIR1 GFILE)
T))))
(CHANGED (* ; "Should exist in both branches")
(FOR GFILE IN (CDR DLIST) DO (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1
GFILE))
(GIT-GET-FILE MERGE GFILE (CONCAT DIR2 GFILE
))))
((RENAMED COPIED)
[FOR GFILE IN (CDR DLIST)
DO (PUSH MAPPINGS (LIST [FULLNAME (GIT-GET-FILE BRANCH1 (CADR GFILE)
(CONCAT DIR1 (CADR GFILE]
(CONCAT DIR2 (CAR GFILE))
'C])
(HELP "UNKNOWN GIT-DIFF TAG" DLIST)))
(* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in MERGE and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up. ")
(* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.")
(* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.")
(FOR GFILE F1 IN (CDR DLIST)
DO
(* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")
[SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE)
(CONCAT DIR1 (CADR GFILE]
(IF (EQ (CADDR GFILE)
100)
THEN
(* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2")
(PUSH MAPPINGS (LIST (FULLNAME F1)
(SLASHIT (U-CASE (CONCAT DIR2
(CAR GFILE)))
T)
(NTHCHAR (CAR DLIST)
1)
100))
ELSE
(* ;;
 "If not a perfect match, then the directory should figure it out")
(GIT-GET-FILE MERGE (CAR GFILE)
(CONCAT DIR2 (CAR GFILE))
T))))
(HELP "UNKNOWN GIT-DIFF TAG" DLIST)))
(LIST DIR1 DIR2 MAPPINGS))])
(GIT-COMPARE-BRANCHES
[LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 22-Feb-2022 22:53 by rmk")
[LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 6-Mar-2022 19:52 by rmk")
(* ; "Edited 22-Feb-2022 22:53 by rmk")
(* ; "Edited 19-Feb-2022 10:21 by rmk")
(* ; "Edited 13-Feb-2022 21:27 by rmk")
(* ; "Edited 2-Feb-2022 08:46 by rmk")
@@ -1028,7 +1060,9 @@
(REPLACE (CDENTRY INFO2) OF CDE
WITH (CREATE CDINFO
FULLNAME _ (CADR MAP)
DATE _ ""
DATE _ (CL:IF (EQ 'R (CADDR MAP))
" <-"
" ==")
LENGTH _ ""
AUTHOR _ ""
TYPE _ ""
@@ -1056,7 +1090,7 @@
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE HOST1 HOST2)
(* ;;
 "Edited 26-Feb-2022 11:58 by rmk: my medley subdirectories with the current local git branch.")
 "Edited 6-Mar-2022 21:51 by rmk: my medley subdirectories with the current local git branch.")
(* ;; "Compares my medley subdirectories with the current local git branch.")
@@ -1066,7 +1100,7 @@
(SETQ SUBDIRS (CAR SUBDIRS)))
(SETQ SUBDIRS (L-CASE SUBDIRS))
(PRINTOUT T "Comparing " (SELECTQ SUBDIRS
(nil (SETQ SUBDIRS '(sources library lispusers)))
(nil (SETQ SUBDIRS '(scripts sources library lispusers)))
(all (SETQ SUBDIRS (ALLSUBDIRS HOST1 HOST2))
"ALL subdirectories")
SUBDIRS)
@@ -1347,7 +1381,8 @@
" ; "])
(GIT-COMMAND
[LAMBDA (CMD ALL NOERROR) (* ; "Edited 25-Feb-2022 09:25 by rmk")
[LAMBDA (CMD ALL NOERROR) (* ; "Edited 6-Mar-2022 15:53 by rmk")
(* ; "Edited 25-Feb-2022 09:25 by rmk")
(* ; "Edited 3-Jan-2022 10:47 by rmk")
(* ; "Edited 24-Nov-2021 16:44 by rmk:")
(* ; "Edited 16-Nov-2021 09:07 by rmk:")
@@ -1372,9 +1407,9 @@
(OR ALL (NOT (STRPOS ".git" LINE 1 NIL T] COLLECT LINE
FINALLY (CL:UNLESS NOERROR
(CL:WHEN (OR (EQ 1 (STRPOS "fatal" (CAR $$VAL)
1 NIL NIL T))
1 NIL T))
(EQ 1 (STRPOS "gh: Command not found" (CAR $$VAL)
1 NIL NIL T)))
1 NIL T)))
(ERROR (CONCAT "Git command %"" CMD "%" failed")
(CAR $$VAL))))])
@@ -1402,22 +1437,22 @@
(ERROR "INITIALS is not set"])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4679 5525 (GIT-CLONEP 4689 . 5523)) (7851 9831 (ALLSUBDIRS 7861 . 9029) (MEDLEYSUBDIRS
9031 . 9470) (GITSUBDIRS 9472 . 9829)) (9832 15306 (TOGIT 9842 . 11990) (FROMGIT 11992 . 12970) (
GIT-DELETE-FILE 12972 . 13866) (MYMEDLEY-DELETE-FILES 13868 . 15304)) (15307 17456 (MYMEDLEYSUBDIR
15317 . 15763) (GITSUBDIR 15765 . 16088) (STRIPDIR 16090 . 16461) (STRIPHOST 16463 . 16699) (STRIPNAME
16701 . 17454)) (17457 18985 (GFILE4MFILE 17467 . 17713) (MFILE4GFILE 17715 . 18057) (
GIT-REPO-FILENAME 18059 . 18983)) (19034 29384 (GIT-COMMIT 19044 . 19622) (GIT-PUSH 19624 . 20180) (
GIT-PULL 20182 . 20588) (GIT-BRANCH-DIFF 20590 . 24388) (GIT-APPROVAL 24390 . 24591) (GIT-GET-FILE
24593 . 26796) (GIT-FILE-EXISTS? 26798 . 27522) (GIT-REMOTE-UPDATE 27524 . 28566) (GIT-REMOTE-ADD
28568 . 28875) (GIT-FILE-DATE 28877 . 29382)) (29429 35048 (GIT-CHECKOUT 29439 . 29680) (
GIT-WHICH-BRANCH 29682 . 30266) (GIT-MAKE-BRANCH 30268 . 31759) (GIT-BRANCHES 31761 . 32739) (
GIT-BRANCH-EXISTS? 32741 . 33802) (PICK-BRANCH 33804 . 34148) (GIT-PULL-REQUESTS 34150 . 35046)) (
35078 37783 (GIT-MY-CURRENT-BRANCH 35088 . 35261) (GIT-MY-BRANCHP 35263 . 36182) (GIT-MY-NEXT-BRANCH
36184 . 36625) (GIT-MY-BRANCHES 36627 . 37781)) (37829 41599 (GIT-ADD-WORKTREE 37839 . 39599) (
GIT-REMOVE-WORKTREE 39601 . 40179) (GIT-LIST-WORKTREES 40181 . 40985) (WORKTREEDIR 40987 . 41597)) (
41647 68101 (GIT-GET-DIFFERENT-FILES 41657 . 46747) (GIT-COMPARE-BRANCHES 46749 . 52241) (
GIT-COMPARE-WITH-MYMEDLEY 52243 . 55963) (GIT-COMPARE-WORKTREE 55965 . 59442) (GITCDOBJBUTTONFN 59444
. 64448) (GIT-CD-LABELFN 64450 . 65532) (GIT-CD-MENUFN 65534 . 68099)) (68171 71739 (CDGITDIR 68181
. 68877) (GIT-COMMAND 68879 . 70852) (GITORIGIN 70854 . 71431) (GIT-INITIALS 71433 . 71737)))))
(FILEMAP (NIL (4694 5540 (GIT-CLONEP 4704 . 5538)) (8022 10002 (ALLSUBDIRS 8032 . 9200) (MEDLEYSUBDIRS
9202 . 9641) (GITSUBDIRS 9643 . 10000)) (10003 15477 (TOGIT 10013 . 12161) (FROMGIT 12163 . 13141) (
GIT-DELETE-FILE 13143 . 14037) (MYMEDLEY-DELETE-FILES 14039 . 15475)) (15478 17627 (MYMEDLEYSUBDIR
15488 . 15934) (GITSUBDIR 15936 . 16259) (STRIPDIR 16261 . 16632) (STRIPHOST 16634 . 16870) (STRIPNAME
16872 . 17625)) (17628 19156 (GFILE4MFILE 17638 . 17884) (MFILE4GFILE 17886 . 18228) (
GIT-REPO-FILENAME 18230 . 19154)) (19205 30157 (GIT-COMMIT 19215 . 19793) (GIT-PUSH 19795 . 20351) (
GIT-PULL 20353 . 20759) (GIT-BRANCH-DIFF 20761 . 24741) (GIT-APPROVAL 24743 . 24944) (GIT-GET-FILE
24946 . 27246) (GIT-FILE-EXISTS? 27248 . 28075) (GIT-REMOTE-UPDATE 28077 . 29119) (GIT-REMOTE-ADD
29121 . 29428) (GIT-FILE-DATE 29430 . 30155)) (30202 36259 (GIT-CHECKOUT 30212 . 30453) (
GIT-WHICH-BRANCH 30455 . 31039) (GIT-MAKE-BRANCH 31041 . 32532) (GIT-BRANCHES 32534 . 33708) (
GIT-BRANCH-EXISTS? 33710 . 34907) (PICK-BRANCH 34909 . 35359) (GIT-PULL-REQUESTS 35361 . 36257)) (
36289 39121 (GIT-MY-CURRENT-BRANCH 36299 . 36472) (GIT-MY-BRANCHP 36474 . 37393) (GIT-MY-NEXT-BRANCH
37395 . 37836) (GIT-MY-BRANCHES 37838 . 39119)) (39167 43059 (GIT-ADD-WORKTREE 39177 . 41059) (
GIT-REMOVE-WORKTREE 41061 . 41639) (GIT-LIST-WORKTREES 41641 . 42445) (WORKTREEDIR 42447 . 43057)) (
43107 71214 (GIT-GET-DIFFERENT-FILES 43117 . 49552) (GIT-COMPARE-BRANCHES 49554 . 55346) (
GIT-COMPARE-WITH-MYMEDLEY 55348 . 59076) (GIT-COMPARE-WORKTREE 59078 . 62555) (GITCDOBJBUTTONFN 62557
. 67561) (GIT-CD-LABELFN 67563 . 68645) (GIT-CD-MENUFN 68647 . 71212)) (71284 74953 (CDGITDIR 71294
. 71990) (GIT-COMMAND 71992 . 74066) (GITORIGIN 74068 . 74645) (GIT-INITIALS 74647 . 74951)))))
STOP

Binary file not shown.

View File

@@ -24,7 +24,8 @@ This will compare the files in origin/rmk15 and origin/lmm12. branch1 defaults
brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser.
If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided. If gh is not available, the menu will offer all known branches. If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones.
Note that the comparison that this provides is essentially read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
bbc branch1 branch2 [command]
This compares the files in branch1 and branch2, for example
bbc rmk15 lmm12 (local)
@@ -46,6 +47,6 @@ TIMESROMAN$TERMINALMODERN
gmc subdirectories [command]
This produces a browser for all the files in the corresponding Medley subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to sources library lispusers. If it is ALL, then files in all My Medley subdirectories are examined.
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {GIT} to My Medley and deleting files from {MM}. If the master branch is current, then the menu has no commands to change the files in the clone. The browser will show those files that have been updated from a recent merge, and they can individually be copied to new My Medley versions in order to realign the two source trees. If the comparison is with a different branch, say the user's current staging branch, copying files from My Medley to git or deleting git files will set git up for future commits.
Note that the menu item for deleting My Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for My Medley files is also accomplished by renaming to a {MM}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
Note that the menu item for deleting My Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for My Medley files is also accomplished by renaming to a {MM}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
(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ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADMODERN
(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ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADMODERN

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Dec-2021 22:27:41" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39 30532
(FILECREATED " 5-Mar-2022 23:20:21" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;40 30674
:CHANGES-TO (FNS MODERN-MENUBUTTONFN)
:CHANGES-TO (FNS MODERNWINDOW.BUTTONEVENTFN)
:PREVIOUS-DATE "25-Dec-2021 22:20:10"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;38)
:PREVIOUS-DATE "25-Dec-2021 22:27:41"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39)
(PRETTYCOMPRINT MODERNIZECOMS)
@@ -216,9 +216,10 @@
(DEFINEQ
(MODERNWINDOW.BUTTONEVENTFN
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "Edited 25-Dec-2021 22:19 by rmk")
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "Edited 5-Mar-2022 23:20 by rmk")
(* ; "Edited 25-Dec-2021 22:19 by rmk")
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
(* ;; "WINDOW is the window that received the click and that should be passed through to the original function, if we don't pick it off here.")
@@ -228,7 +229,7 @@
(* ;; "For windows without a top margin, the shape/move region is MODERN-WINDOW-MARGIN points below the top, in the clipping region of the window. ")
(* ;; "Not sure about using MODERN-WINDOW-MARGIN for the top region of an untitle window. Maybe it should be 2 times the border width in that case, and the MODERN-WINDOW-MARGIN separately defines the rectangle that constitutes a corner.")
(* ;; "Changed to use Wborder for the top region of an untitle window instead of MODERN-WINDOW-MARGIN. Maybe it should be 2 times the border width in that case, and the MODERN-WINDOW-MARGIN separately defines the rectangle that constitutes a corner.")
(LET (CORNER ATTACHEDREGION)
(IF CORNERREGION
@@ -236,15 +237,15 @@
(* ;; "Caller tells us whether the corner window has a title.")
(CL:UNLESS (FIXP TOPMARGIN)
(SETQ TOPMARGIN (if TOPMARGIN
(SETQ TOPMARGIN (if (OR TOPMARGIN (WINDOWPROP WINDOW 'TITLE))
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
else WBorder)))
ELSE (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION))
(* ; "WINDOW is the corner window")
(SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN)
elseif (WINDOWPROP WINDOW 'TITLE)
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
else WBorder)))
(if (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0)
(INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY))
@@ -612,12 +613,12 @@
(ADDTOVAR LAMA MODERN-ADD-EXEC)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5122 11399 (MODERNWINDOW 5132 . 6587) (MODERNWINDOW.SETUP 6589 . 9538) (UNMODERNWINDOW
9540 . 9934) (MODERNWINDOW.UNSETUP 9936 . 10748) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10750 . 11397)) (
11464 21491 (MODERNWINDOW.BUTTONEVENTFN 11474 . 18366) (NEARTOP 18368 . 19296) (NEARESTCORNER 19298 .
20177) (INCORNER.REGION 20179 . 21489)) (21549 24021 (MODERN-ADD-EXEC 21559 . 21990) (MODERN-SNAPW
21992 . 22535) (TOTOPW.MODERNIZE 22537 . 22965) (MODERN-MENUBUTTONFN 22967 . 24019)) (24022 26451 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24032 . 24679) (MODERNIZED.TB.BUTTONEVENTFN 24681 . 26449)) (26492
28771 (TEDIT.MODERNIZE 26502 . 27316) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27318 . 28440) (TEDIT.SELECTALL
28442 . 28769)))))
(FILEMAP (NIL (5129 11406 (MODERNWINDOW 5139 . 6594) (MODERNWINDOW.SETUP 6596 . 9545) (UNMODERNWINDOW
9547 . 9941) (MODERNWINDOW.UNSETUP 9943 . 10755) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10757 . 11404)) (
11471 21633 (MODERNWINDOW.BUTTONEVENTFN 11481 . 18508) (NEARTOP 18510 . 19438) (NEARESTCORNER 19440 .
20319) (INCORNER.REGION 20321 . 21631)) (21691 24163 (MODERN-ADD-EXEC 21701 . 22132) (MODERN-SNAPW
22134 . 22677) (TOTOPW.MODERNIZE 22679 . 23107) (MODERN-MENUBUTTONFN 23109 . 24161)) (24164 26593 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24174 . 24821) (MODERNIZED.TB.BUTTONEVENTFN 24823 . 26591)) (26634
28913 (TEDIT.MODERNIZE 26644 . 27458) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27460 . 28582) (TEDIT.SELECTALL
28584 . 28911)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Apr-92 15:04:56" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>DIRECTORY.;5| 26134
changes to%: (FNS DIRECTORY DODIRCOMMANDS)
(FILECREATED " 5-Mar-2022 09:04:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;8 27503
previous date%: "31-May-90 12:25:29" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>DIRECTORY.;4|)
:CHANGES-TO (FNS DIRECTORY FILDIR)
:PREVIOUS-DATE " 5-Mar-2022 08:46:23"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;7)
(* ; "
Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT DIRECTORYCOMS)
@@ -31,9 +33,9 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(ADDTOVAR LISPXMACROS (DIR (DODIR (NLAMBDA.ARGS LISPXLINE)))
(NDIR (DODIR (NLAMBDA.ARGS LISPXLINE)
'(P COLUMNS 20)
'* "")))
(NDIR (DODIR (NLAMBDA.ARGS LISPXLINE)
'(P COLUMNS 20)
'* "")))
(DEFINEQ
(DODIR
@@ -41,15 +43,19 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
)
(FILDIR
(LAMBDA (FILEGROUP) (* lmm " 4-OCT-83 03:27") (DIRECTORY FILEGROUP)))
[LAMBDA (FILEGROUP DEPTH) (* ; "Edited 5-Mar-2022 09:03 by rmk")
(* lmm " 4-OCT-83 03:27")
(DIRECTORY FILEGROUP (AND DEPTH `(COLLECT DEPTH ,DEPTH])
(DIRECTORY
[LAMBDA (FILES COMMANDS DEFAULTEXT DEFAULTVERS)
(DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS))
(DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS)) (* ; "Edited 4-Mar-2022 23:17 by rmk")
(* ; "Edited 30-Apr-92 14:55 by jds")
(PROG (VALUE COLUMNS NAMEFLG DELETEDONLY FILEGROUP PRINTFLG OUTFILE PROMPTFLG LASTHOST&DIR
DESIREDPROPS PFLG HEADINGS VALUES-WANTED)
(DECLARE (SPECVARS VALUE COLUMNS NAMEFLG FILEGROUP DESIREDPROPS LASTHOST&DIR))
DESIREDPROPS PFLG HEADINGS VALUES-WANTED (FILING.ENUMERATION.DEPTH
FILING.ENUMERATION.DEPTH))
(DECLARE (SPECVARS VALUE COLUMNS NAMEFLG FILEGROUP DESIREDPROPS LASTHOST&DIR
FILING.ENUMERATION.DEPTH))
(PROG ([COMTAIL (SETQ COMMANDS (COND
((LISTP COMMANDS)
(APPEND COMMANDS))
@@ -78,7 +84,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(@ (SETQ COMTAIL (CDR COMTAIL))
(if (FNTYP (SETQ COM (CAR COMTAIL)))
then [RPLACA COMTAIL (CONS COM '(FILENAME]
(SETQ NAMEFLG T)
(SETQ NAMEFLG T)
elseif (FMEMB 'FILENAME (FREEVARS COM))
then (SETQ NAMEFLG T)))
(COLUMNS (SETQ COLUMNS (CADR COMTAIL))
@@ -95,17 +101,26 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
then (push DESIREDPROPS 'IREADDATE))
(RPLACA (SETQ COMTAIL (CDR COMTAIL))
(if (NUMBERP (SETQ COM (CAR COMTAIL)))
then (* ; "A number of days")
[IDIFFERENCE (IDATE)
(TIMES COM (DEFERREDCONSTANT (IDIFFERENCE
(IDATE
"2-JAN-77 00:00"
)
(IDATE
"1-JAN-77 00:00"
]
then (* ; "A number of days")
[IDIFFERENCE (IDATE)
(TIMES COM (DEFERREDCONSTANT (IDIFFERENCE
(IDATE "2-JAN-77 00:00"
)
(IDATE "1-JAN-77 00:00"
]
elseif (IDATE COM)
else (\ILLEGAL.ARG COM))))
(DEPTH [SETQ FILING.ENUMERATION.DEPTH (IF (AND (SMALLP (CADR COMTAIL))
(IGEQ (CADR COMTAIL)
0))
THEN (CADR COMTAIL)
ELSEIF (EQ T (CADR COMTAIL))
THEN MAX.SMALLP
ELSE (\ILLEGAL.ARG (CADR COMTAIL]
(* ;; "We remove the depth number from the list, leaving just the DEPTH, to be removed below. Otherwise we have to have a trailing pointer.")
(RPLACD COMTAIL (CDDR COMTAIL)))
(COND
((STRINGP COM)
(RPLNODE COMTAIL 'PRINT (CONS (MKSTRING COM)
@@ -128,6 +143,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(T (ERROR "invalid DIRECTORY command" COM]
(AND (SETQ COMTAIL (CDR COMTAIL))
(GO COMLP)))
(SETQ COMMANDS (DREMOVE 'DEPTH COMMANDS))
(RESETLST
(* ;; "RESETLST is here, among other reasons, to clean up after any file generators that worry about the DIR being aborted")
@@ -136,12 +152,12 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
PATTERN _ (DIRECTORY.PARSE FILES)
FILEGENERATORS _ FILEGROUP))
(* ;
 "DIRECTORY.PARSE smashes generators on FILEGROUP for each atomic file specification it finds.")
 "DIRECTORY.PARSE smashes generators on FILEGROUP for each atomic file specification it finds.")
[COND
((EQL \MACHINETYPE \MAIKO)
(RESETSAVE NIL '(AND RESETSTATE (\UFS.ABORT.DIRECTORY]
(* ;
 "Make sure all instances of UFSGENFILESTATE will be released.")
 "Make sure all instances of UFSGENFILESTATE will be released.")
(COND
((OR PRINTFLG OUTFILE PROMPTFLG)
[COND
@@ -157,39 +173,36 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
[COND
((AND PFLG (NEQ (CAR PFLG)
'PAUSE)) (* ;
 "Postpone print commands until after predicate commands")
 "Postpone print commands until after predicate commands")
(SETQ COMTAIL COMMANDS)
(bind SEENP PREVTAIL
do (SELECTQ (CAR COMTAIL)
((P PP)
(SETQ SEENP (OR PREVTAIL T)))
((BY COLUMNS @ OUT OLDERTHAN NEWERTHAN)
(pop COMTAIL))
(PROGN [COND
((AND SEENP (NEQ COMTAIL (CDR PFLG)))
(bind SEENP PREVTAIL do (SELECTQ (CAR COMTAIL)
((P PP)
(SETQ SEENP (OR PREVTAIL T)))
((BY COLUMNS @ OUT OLDERTHAN NEWERTHAN)
(pop COMTAIL))
(PROGN [COND
((AND SEENP (NEQ COMTAIL (CDR PFLG)))
(* ;
 "Move the P or PP to before COMTAIL")
(RPLACD PREVTAIL (CONS (CAR PFLG)
COMTAIL))
(COND
((NEQ SEENP T)
(RPLACD SEENP (CDDR SEENP)))
(T (pop COMMANDS]
(RETURN)))
(SETQ COMTAIL (CDR (SETQ PREVTAIL COMTAIL]
 "Move the P or PP to before COMTAIL")
(RPLACD PREVTAIL (CONS (CAR PFLG)
COMTAIL))
(COND
((NEQ SEENP T)
(RPLACD SEENP (CDDR SEENP)))
(T (pop COMMANDS]
(RETURN)))
(SETQ COMTAIL (CDR (SETQ PREVTAIL COMTAIL]
[COND
((AND HEADINGS (for X in HEADINGS thereis (CAR X)))
(TERPRI)
(for X in (REVERSE HEADINGS) bind (I _ 22)
do (TAB I)
[COND
((CAR X)
(PRIN1 (CAR X]
(add I (CADR X]
(for X in (REVERSE HEADINGS) bind (I _ 22) do (TAB I)
[COND
((CAR X)
(PRIN1 (CAR X]
(add I (CADR X]
(SETQ PRINTFLG T)
(TAB 0 0)))
(while (DIRECTORY.NEXTFILE FILEGROUP) do (DODIRCOMMANDS COMMANDS
FILEGROUP))
(while (DIRECTORY.NEXTFILE FILEGROUP) do (DODIRCOMMANDS COMMANDS FILEGROUP))
(COND
(PRINTFLG (TAB 0 0))))
(RETURN (OR VALUE (COND
@@ -370,7 +383,8 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
UNDELETE
(VERBOSE AUTHOR CREATIONDATE SIZE READDATE WRITEDATE)
TRIMTO
(DELVER OLDVERSIONS DELETE)))
(DELVER OLDVERSIONS DELETE)
DEPTH))
(RPAQQ FILEINFOTYPES
((WRITEDATE 22)
@@ -393,8 +407,8 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
(DECLARE%: EVAL@COMPILE
(PUTPROPS DTAB DMACRO ((N)
(TAB (PROG1 I (add I N 1))
0)))
(TAB (PROG1 I (add I N 1))
0)))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -404,10 +418,10 @@ Copyright (c) 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All ri
)
(PUTPROPS DIRECTORY COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1992))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1339 24611 (DODIR 1349 . 1896) (FILDIR 1898 . 1979) (DIRECTORY 1981 . 11071) (
DIRECTORY.PARSE 11073 . 11781) (DIRECTORY.FILL.PATTERN 11783 . 12167) (DIRCONJ 12169 . 12389) (
DIRECTORY.NEXTFILE 12391 . 12984) (DMATCH 12986 . 13361) (DIRECTORY.MATCH.SETUP 13363 . 13897) (
DIRECTORY.MATCH 13899 . 14316) (DIRECTORY.MATCH1 14318 . 16431) (DODIRCOMMANDS 16433 . 22206) (
DIRPRINTNAME 22208 . 23624) (DPRIN1 23626 . 23711) (DIRFILENAME 23713 . 24142) (DIRGETFILEINFO 24144
. 24296) (DREAD 24298 . 24609)))))
(FILEMAP (NIL (1330 25982 (DODIR 1340 . 1887) (FILDIR 1889 . 2169) (DIRECTORY 2171 . 12442) (
DIRECTORY.PARSE 12444 . 13152) (DIRECTORY.FILL.PATTERN 13154 . 13538) (DIRCONJ 13540 . 13760) (
DIRECTORY.NEXTFILE 13762 . 14355) (DMATCH 14357 . 14732) (DIRECTORY.MATCH.SETUP 14734 . 15268) (
DIRECTORY.MATCH 15270 . 15687) (DIRECTORY.MATCH1 15689 . 17802) (DODIRCOMMANDS 17804 . 23577) (
DIRPRINTNAME 23579 . 24995) (DPRIN1 24997 . 25082) (DIRFILENAME 25084 . 25513) (DIRGETFILEINFO 25515
. 25667) (DREAD 25669 . 25980)))))
STOP

Binary file not shown.

View File

@@ -1,10 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Mar-2022 15:49:32" {DSK}<home>larry>medley>sources>FILEPKG.;3 279296
(FILECREATED " 6-Mar-2022 11:02:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;19 278872
:CHANGES-TO (FNS FILECHANGES)
:CHANGES-TO (FNS EDITCALLERS)
:PREVIOUS-DATE " 2-Dec-2021 23:35:54" {DSK}<home>larry>medley>sources>FILEPKG.;1)
:PREVIOUS-DATE " 2-Mar-2022 15:49:32"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;18)
(* ; "
@@ -3109,14 +3110,14 @@ compiling " T)
(ADDTOVAR USERMACROS
(M NIL (MAKE FILE FILE))
(M (X . Y)
(E (MARKASCHANGED (COND ((LISTP 'X)
(CAR 'X))
(T 'X))
'USERMACROS)
T)
(ORIGINAL (M X . Y)))
(M NIL (MAKE FILE FILE)))
(ORIGINAL (M X . Y))))
(ADDTOVAR EDITMACROS
(M (X . Y)
@@ -4404,19 +4405,25 @@ compiling " T)
(CAR X])
(EDITCALLERS
[LAMBDA (ATOMS FILES COMS) (* ; "Edited 28-Jun-2021 09:50 by rmk:")
(* bvm%: " 3-Nov-86 17:30")
[LAMBDA (ATOMS FILES COMS)
(* ;; "Edited 6-Mar-2022 11:02 by rmk: If FILES contains *, use FILDIR")
(* ;; "Edited 28-Jun-2021 09:50 by rmk:")
(* bvm%: " 3-Nov-86 17:30")
(LET
(FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN)
[SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS]
[for FILE in (COND
((NULL FILES)
FILELST)
((EQ FILES T)
(UNION SYSFILES FILELST))
((LISTP FILES)
FILES)
(T (LIST FILES)))
((NULL FILES)
FILELST)
((EQ FILES T)
(UNION SYSFILES FILELST))
((LISTP FILES)
FILES)
((STRPOS "*" FILES)
(FILDIR FILES))
(T (LIST FILES)))
do
(RESETLST
[PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I)
@@ -4430,82 +4437,76 @@ compiling " T)
(OR (GET-ENVIRONMENT-AND-FILEMAP FULL)
(\PARSE-FILE-HEADER FILESTREAM)))
(* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file")
(* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file")
(SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV)))
(CL:WHEN (AND ENV (FETCH (READER-ENVIRONMENT REFORMAT) OF ENV))
(\EXTERNALFORMAT FILESTREAM (FETCH (READER-ENVIRONMENT REFORMAT)
OF ENV)))
(\EXTERNALFORMAT FILESTREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF ENV)))
(SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL))
[OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS)))
(push FFILEPOSPATTERNS
(CONS RDTBL (SETQ PATTERNS
(for ATOM in ATOMS
collect (CONCAT
(COND
((EQ (CHCON1 ATOM)
(CHARCODE ESCAPE))
(SETQ ATOM (SUBSTRING ATOM 2 -1))
"")
(T " "))
[COND
((SETQ I (STRPOS ' ATOM))
(SUBSTRING ATOM 1 (SUB1 I)))
((STRINGP ATOM))
(T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE
ATOM)))
(* ;
 "Keep MKSTRING from putting a prefix on")
(MKSTRING ATOM T RDTBL]
(COND
(I "")
(T " "]
(CONS RDTBL (SETQ PATTERNS
(for ATOM in ATOMS
collect (CONCAT (COND
((EQ (CHCON1 ATOM)
(CHARCODE ESCAPE))
(SETQ ATOM (SUBSTRING ATOM 2 -1))
"")
(T " "))
[COND
((SETQ I (STRPOS ' ATOM))
(SUBSTRING ATOM 1 (SUB1 I)))
((STRINGP ATOM))
(T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE
ATOM)))
(* ;
 "Keep MKSTRING from putting a prefix on")
(MKSTRING ATOM T RDTBL]
(COND
(I "")
(T " "]
(for PATTERN in PATTERNS
do
(SETFILEPTR FILESTREAM (SETQ I (OR TOP 0)))
(while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA))
do
(COND
((NULL PRINTFLG) (* ;
 "cause the printing of the filename to be saved on history list")
((NULL PRINTFLG) (* ;
 "cause the printing of the filename to be saved on history list")
(SETQ PRINTFLG T)
(LISPXPRIN2 FULL T T T)
(* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list")
(* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list")
(LISPXPRIN1 ": " T NIL T)))
[OR
[AND (NEQ MAP T)
(for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0)
(SETQ MAP (OR (GETFILEMAP
FILESTREAM)
(LOADFILEMAP
FILESTREAM]
(PROGN
(* ; "file has no filemap")
(SETQ MAP (SETQ NOMAPFLG T))
(LISPXPRIN1 " no filemap!" T)
NIL)))
(SETQ MAP (OR (GETFILEMAP FILESTREAM)
(LOADFILEMAP FILESTREAM]
(PROGN (* ; "file has no filemap")
(SETQ MAP (SETQ NOMAPFLG T))
(LISPXPRIN1 " no filemap!" T)
NIL)))
thereis (AND (ILESSP (CAR X)
I)
(IGREATERP (CADR X)
I)
(for Z in (CDDR X)
thereis (COND
((AND (ILESSP (CADR Z)
I)
(IGREATERP (CDDR Z)
I))
[COND
((NOT (FMEMB (CAR Z)
FNS))
(SETQ FNS
(CONS (LISPXPRIN2
(CAR Z)
T T)
FNS]
(SETQ I (CDDR Z))
T]
I)
(IGREATERP (CADR X)
I)
(for Z in (CDDR X)
thereis (COND
((AND (ILESSP (CADR Z)
I)
(IGREATERP (CDDR Z)
I))
[COND
((NOT (FMEMB (CAR Z)
FNS))
(SETQ FNS (CONS (LISPXPRIN2
(CAR Z)
T T)
FNS]
(SETQ I (CDDR Z))
T]
(PROGN (LISPXPRIN2 I T T)
(OR (FMEMB FILE OTHERSFILES)
(SETQ OTHERSFILES (CONS FILE OTHERSFILES]
@@ -4914,46 +4915,46 @@ compiling " T)
(PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989
1990 1991 1992 1993 1995 2018 2020 2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (19209 20914 (SEARCHPRETTYTYPELST 19219 . 20198) (PRETTYDEFMACROS 20200 . 20658) (
FILEPKGCOMPROPS 20660 . 20912)) (21716 56963 (CLEANUP 21726 . 23114) (COMPILEFILES 23116 . 23392) (
COMPILEFILES0 23394 . 24114) (CONTINUEDIT 24116 . 25536) (MAKEFILE 25538 . 37875) (FILECHANGES 37877
. 40641) (FILEPKG.MERGECHANGES 40643 . 41466) (FILEPKG.CHANGEDFNS 41468 . 41780) (MAKEFILE1 41782 .
46009) (COMPILE-FILE? 46011 . 47568) (MAKEFILES 47570 . 49263) (ADDFILE 49265 . 51786) (ADDFILE0 51788
. 55924) (LISTFILES 55926 . 56961)) (57635 92875 (FILEPKGCHANGES 57645 . 58995) (GETFILEPKGTYPE 58997
. 62070) (MARKASCHANGED 62072 . 63709) (FILECOMS 63711 . 64095) (WHEREIS 64097 . 65517) (
SMASHFILECOMS 65519 . 65754) (FILEFNSLST 65756 . 65918) (FILECOMSLST 65920 . 66404) (UPDATEFILES 66406
. 71706) (INFILECOMS? 71708 . 73611) (INFILECOMTAIL 73613 . 74753) (INFILECOMS 74755 . 74916) (
INFILECOM 74918 . 85127) (INFILECOMSVALS 85129 . 85456) (INFILECOMSVAL 85458 . 86460) (INFILECOMSPROP
86462 . 87291) (IFCPROPS 87293 . 88554) (IFCEXPRTYPE 88556 . 89067) (IFCPROPSCAN 89069 . 90122) (
IFCDECLARE 90124 . 91435) (INFILEPAIRS 91437 . 91769) (INFILECOMSMACRO 91771 . 92873)) (92910 124330 (
FILES? 92920 . 95113) (FILES?1 95115 . 95813) (FILES?PRINTLST 95815 . 96597) (ADDTOFILES? 96599 .
107645) (ADDTOFILE 107647 . 108563) (WHATIS 108565 . 110541) (ADDTOCOMS 110543 . 112187) (ADDTOCOM
112189 . 118736) (ADDTOCOM1 118738 . 119909) (ADDNEWCOM 119911 . 120961) (MAKENEWCOM 120963 . 122806)
(DEFAULTMAKENEWCOM 122808 . 124328)) (124400 127217 (MERGEINSERT 124410 . 126753) (MERGEINSERT1 126755
. 127215)) (127371 128728 (ADDTOFILEKEYLST 127381 . 128726)) (128845 139757 (DELFROMFILES 128855 .
129705) (DELFROMCOMS 129707 . 131386) (DELFROMCOM 131388 . 137256) (DELFROMCOM1 137258 . 138055) (
REMOVEITEM 138057 . 138931) (MOVETOFILE 138933 . 139755)) (139971 142340 (SAVEPUT 139981 . 142338)) (
142465 150789 (UNMARKASCHANGED 142475 . 144183) (PREEDITFN 144185 . 146696) (POSTEDITPROPS 146698 .
149199) (POSTEDITALISTS 149201 . 150787)) (150934 171488 (ALISTS.GETDEF 150944 . 151323) (
ALISTS.WHENCHANGED 151325 . 151969) (CLEARCLISPARRAY 151971 . 153145) (EXPRESSIONS.WHENCHANGED 153147
. 153521) (MAKEALISTCOMS 153523 . 154596) (MAKEFILESCOMS 154598 . 156035) (MAKELISPXMACROSCOMS 156037
. 158055) (MAKEPROPSCOMS 158057 . 158755) (MAKEUSERMACROSCOMS 158757 . 160557) (PROPS.WHENCHANGED
160559 . 161180) (FILEGETDEF.LISPXMACROS 161182 . 162624) (FILEGETDEF.ALISTS 162626 . 163245) (
FILEGETDEF.RECORDS 163247 . 164178) (FILEGETDEF.PROPS 164180 . 164972) (FILEGETDEF.MACROS 164974 .
166034) (FILEGETDEF.VARS 166036 . 166452) (FILEGETDEF.FNS 166454 . 167818) (FILEPKGCOMS.PUTDEF 167820
. 170260) (FILES.PUTDEF 170262 . 171219) (VARS.PUTDEF 171221 . 171364) (FILES.WHENCHANGED 171366 .
171486)) (173510 180943 (RENAME 173520 . 174921) (CHANGECALLERS 174923 . 180941)) (180944 229800 (
SHOWDEF 180954 . 182147) (COPYDEF 182149 . 184623) (GETDEF 184625 . 186901) (GETDEFCOM 186903 . 187869
) (GETDEFCOM0 187871 . 189217) (GETDEFCURRENT 189219 . 195639) (GETDEFERR 195641 . 196942) (
GETDEFFROMFILE 196944 . 201224) (GETDEFSAVED 201226 . 202330) (PUTDEF 202332 . 203035) (EDITDEF 203037
. 204014) (DEFAULT.EDITDEF 204016 . 206852) (EDITDEF.FILES 206854 . 207055) (LOADDEF 207057 . 207233)
(DWIMDEF 207235 . 208089) (DELDEF 208091 . 211105) (DELFROMLIST 211107 . 211611) (HASDEF 211613 .
217935) (GETFILEDEF 217937 . 218459) (SAVEDEF 218461 . 220120) (UNSAVEDEF 220122 . 221018) (
COMPAREDEFS 221020 . 224830) (COMPARE 224832 . 225536) (TYPESOF 225538 . 229798)) (229950 238721 (
FILEPKGCOM 229960 . 234893) (FILEPKGTYPE 234895 . 238719)) (250754 265686 (FINDCALLERS 250764 . 251279
) (EDITCALLERS 251281 . 259191) (EDITFROMFILE 259193 . 265001) (FINDATS 265003 . 265275) (LOOKIN
265277 . 265684)) (265687 267414 (SEPRCASE 265697 . 267412)) (267931 273488 (IMPORTFILE 267941 .
268915) (IMPORTEVAL 268917 . 269797) (IMPORTFILESCAN 269799 . 270220) (CHECKIMPORTS 270222 . 271558) (
GATHEREXPORTS 271560 . 272898) (\DUMPEXPORTS 272900 . 273486)) (273826 276034 (CLEARFILEPKG 273836 .
276032)))))
(FILEMAP (NIL (19254 20959 (SEARCHPRETTYTYPELST 19264 . 20243) (PRETTYDEFMACROS 20245 . 20703) (
FILEPKGCOMPROPS 20705 . 20957)) (21761 57008 (CLEANUP 21771 . 23159) (COMPILEFILES 23161 . 23437) (
COMPILEFILES0 23439 . 24159) (CONTINUEDIT 24161 . 25581) (MAKEFILE 25583 . 37920) (FILECHANGES 37922
. 40686) (FILEPKG.MERGECHANGES 40688 . 41511) (FILEPKG.CHANGEDFNS 41513 . 41825) (MAKEFILE1 41827 .
46054) (COMPILE-FILE? 46056 . 47613) (MAKEFILES 47615 . 49308) (ADDFILE 49310 . 51831) (ADDFILE0 51833
. 55969) (LISTFILES 55971 . 57006)) (57680 92920 (FILEPKGCHANGES 57690 . 59040) (GETFILEPKGTYPE 59042
. 62115) (MARKASCHANGED 62117 . 63754) (FILECOMS 63756 . 64140) (WHEREIS 64142 . 65562) (
SMASHFILECOMS 65564 . 65799) (FILEFNSLST 65801 . 65963) (FILECOMSLST 65965 . 66449) (UPDATEFILES 66451
. 71751) (INFILECOMS? 71753 . 73656) (INFILECOMTAIL 73658 . 74798) (INFILECOMS 74800 . 74961) (
INFILECOM 74963 . 85172) (INFILECOMSVALS 85174 . 85501) (INFILECOMSVAL 85503 . 86505) (INFILECOMSPROP
86507 . 87336) (IFCPROPS 87338 . 88599) (IFCEXPRTYPE 88601 . 89112) (IFCPROPSCAN 89114 . 90167) (
IFCDECLARE 90169 . 91480) (INFILEPAIRS 91482 . 91814) (INFILECOMSMACRO 91816 . 92918)) (92955 124375 (
FILES? 92965 . 95158) (FILES?1 95160 . 95858) (FILES?PRINTLST 95860 . 96642) (ADDTOFILES? 96644 .
107690) (ADDTOFILE 107692 . 108608) (WHATIS 108610 . 110586) (ADDTOCOMS 110588 . 112232) (ADDTOCOM
112234 . 118781) (ADDTOCOM1 118783 . 119954) (ADDNEWCOM 119956 . 121006) (MAKENEWCOM 121008 . 122851)
(DEFAULTMAKENEWCOM 122853 . 124373)) (124445 127262 (MERGEINSERT 124455 . 126798) (MERGEINSERT1 126800
. 127260)) (127416 128773 (ADDTOFILEKEYLST 127426 . 128771)) (128890 139802 (DELFROMFILES 128900 .
129750) (DELFROMCOMS 129752 . 131431) (DELFROMCOM 131433 . 137301) (DELFROMCOM1 137303 . 138100) (
REMOVEITEM 138102 . 138976) (MOVETOFILE 138978 . 139800)) (140016 142385 (SAVEPUT 140026 . 142383)) (
142510 150834 (UNMARKASCHANGED 142520 . 144228) (PREEDITFN 144230 . 146741) (POSTEDITPROPS 146743 .
149244) (POSTEDITALISTS 149246 . 150832)) (150979 171533 (ALISTS.GETDEF 150989 . 151368) (
ALISTS.WHENCHANGED 151370 . 152014) (CLEARCLISPARRAY 152016 . 153190) (EXPRESSIONS.WHENCHANGED 153192
. 153566) (MAKEALISTCOMS 153568 . 154641) (MAKEFILESCOMS 154643 . 156080) (MAKELISPXMACROSCOMS 156082
. 158100) (MAKEPROPSCOMS 158102 . 158800) (MAKEUSERMACROSCOMS 158802 . 160602) (PROPS.WHENCHANGED
160604 . 161225) (FILEGETDEF.LISPXMACROS 161227 . 162669) (FILEGETDEF.ALISTS 162671 . 163290) (
FILEGETDEF.RECORDS 163292 . 164223) (FILEGETDEF.PROPS 164225 . 165017) (FILEGETDEF.MACROS 165019 .
166079) (FILEGETDEF.VARS 166081 . 166497) (FILEGETDEF.FNS 166499 . 167863) (FILEPKGCOMS.PUTDEF 167865
. 170305) (FILES.PUTDEF 170307 . 171264) (VARS.PUTDEF 171266 . 171409) (FILES.WHENCHANGED 171411 .
171531)) (173555 180988 (RENAME 173565 . 174966) (CHANGECALLERS 174968 . 180986)) (180989 229845 (
SHOWDEF 180999 . 182192) (COPYDEF 182194 . 184668) (GETDEF 184670 . 186946) (GETDEFCOM 186948 . 187914
) (GETDEFCOM0 187916 . 189262) (GETDEFCURRENT 189264 . 195684) (GETDEFERR 195686 . 196987) (
GETDEFFROMFILE 196989 . 201269) (GETDEFSAVED 201271 . 202375) (PUTDEF 202377 . 203080) (EDITDEF 203082
. 204059) (DEFAULT.EDITDEF 204061 . 206897) (EDITDEF.FILES 206899 . 207100) (LOADDEF 207102 . 207278)
(DWIMDEF 207280 . 208134) (DELDEF 208136 . 211150) (DELFROMLIST 211152 . 211656) (HASDEF 211658 .
217980) (GETFILEDEF 217982 . 218504) (SAVEDEF 218506 . 220165) (UNSAVEDEF 220167 . 221063) (
COMPAREDEFS 221065 . 224875) (COMPARE 224877 . 225581) (TYPESOF 225583 . 229843)) (229995 238766 (
FILEPKGCOM 230005 . 234938) (FILEPKGTYPE 234940 . 238764)) (250799 265262 (FINDCALLERS 250809 . 251324
) (EDITCALLERS 251326 . 258767) (EDITFROMFILE 258769 . 264577) (FINDATS 264579 . 264851) (LOOKIN
264853 . 265260)) (265263 266990 (SEPRCASE 265273 . 266988)) (267507 273064 (IMPORTFILE 267517 .
268491) (IMPORTEVAL 268493 . 269373) (IMPORTFILESCAN 269375 . 269796) (CHECKIMPORTS 269798 . 271134) (
GATHEREXPORTS 271136 . 272474) (\DUMPEXPORTS 272476 . 273062)) (273402 275610 (CLEARFILEPKG 273412 .
275608)))))
STOP

Binary file not shown.