Rmk57 mostly gitfns improvements, other minor cleanups (#843)
* MAKEINIT: Remove bogus non-ascii character from comments * UPCSTATS: move to obsolete * GITFNS: better interface to process stream Now only looks at the process return code, gets all output only from redirected streams. Also offers to increase the diff.renameLimit if it is too small for the branch comparison. * COMPAREDIRECTORIES: reformat browser output The lengths are now in their own column. Also, the < and > are in different columns, to make it easier to pick out which side is newer. * CLIPBOARD.TXT: documented that it uses (SYSTEM-EXTERNALFORMAT) * GITFNS: Fixed a glitch in the renameLimit * GITFNS: Test for gh * COMPAREDIRECTORIES: Fix loadup record sequence * Don't overwrite fixed NCFILES in MEDLEY-UTILS * SKETCHOBJ and TEDIT-FILE already merged Co-authored-by: Larry Masinter <LMM@acm.org>
This commit is contained in:
rmkaplan
GitHub
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-May-2022 08:44:46"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;234 125334
|
||||
(FILECREATED "17-Jul-2022 11:04:12"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;245 127291
|
||||
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
|
||||
:PREVIOUS-DATE "24-May-2022 15:49:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;233)
|
||||
:PREVIOUS-DATE "16-Jul-2022 10:41:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;244)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -27,7 +27,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
CDTEDIT)
|
||||
(FNS CDMAP CDENTRY CDSUBSET CDMERGE CDMERGE.COMMON)
|
||||
(FNS BINCOMP EOLTYPE EOLTYPE.SHOW)
|
||||
(RECORDS CDVALUE CDENTRY CDINFO CDMAXNCHARS)
|
||||
(RECORDS CDMAXNCHARS CDVALUE CDENTRY CDINFO)
|
||||
|
||||
(* ;; "look for compiled files older than the sources")
|
||||
|
||||
@@ -554,7 +554,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(CDPRINT
|
||||
[LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 26-Jan-2022 13:43 by rmk")
|
||||
[LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 15-Jul-2022 12:03 by rmk")
|
||||
(* ; "Edited 26-Jan-2022 13:43 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 20:10 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 20:59 by rmk:")
|
||||
(* ; "Edited 13-Oct-2020 08:38 by rmk:")
|
||||
@@ -569,6 +570,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(COL1WIDTH (POP COLUMNS))
|
||||
(COL2WIDTH (POP COLUMNS))
|
||||
(COL2START (POP COLUMNS))
|
||||
(LENGTH2END (POP COLUMNS))
|
||||
(NCHARSDIR1 (FETCH NCDIR OF (FETCH CDMAXNC1 OF CDVALUE)))
|
||||
(NCHARSDIR2 (FETCH NCDIR OF (FETCH CDMAXNC2 OF CDVALUE]
|
||||
(CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T))
|
||||
@@ -585,7 +587,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
then (CDPRINT.COLHEADERS STREAM COLHEADINGS ENDDATE1 COL1WIDTH COL2START COL2WIDTH)
|
||||
(for E in (fetch CDENTRIES of CDVALUE)
|
||||
do (CDPRINT.LINE STREAM E PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1
|
||||
NCHARSDIR2))
|
||||
NCHARSDIR2 LENGTH2END))
|
||||
else (PRINTOUT T "CDVALUE is empty" T))
|
||||
(AND STREAM (CLOSEF? STREAM))))])
|
||||
|
||||
@@ -611,7 +613,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CL:WHEN SELECT (PRINTOUT STREAM " selecting " SELECT)))])
|
||||
|
||||
(CDPRINT.LINE
|
||||
[LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2)
|
||||
[LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2 LENGTH2END)
|
||||
(* ; "Edited 16-Jul-2022 10:19 by rmk")
|
||||
(* ; "Edited 22-Nov-2021 22:38 by rmk:")
|
||||
(* ; "Edited 9-Jan-2021 10:12 by rmk:")
|
||||
|
||||
@@ -642,13 +645,21 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CL:WHEN PRINTAUTHOR
|
||||
(PRINTOUT STREAM "(" (fetch (CDINFO AUTHOR) OF INFO1)
|
||||
") "))
|
||||
(PRINTOUT STREAM (fetch (CDINFO LENGTH) OF INFO1)
|
||||
.TAB0 DATE1POS (fetch DATE of INFO1)))
|
||||
(PRINTOUT STREAM .TAB0 ENDDATE1 " " (fetch DATEREL of ENTRY)
|
||||
(PRINTOUT STREAM .FR (IDIFFERENCE DATE1POS 2)
|
||||
(fetch (CDINFO LENGTH) OF INFO1)
|
||||
" "
|
||||
(fetch DATE of INFO1)))
|
||||
(PRINTOUT STREAM .TAB0 ENDDATE1 " " (SELECTQ (fetch DATEREL of ENTRY)
|
||||
(< "< ")
|
||||
(> " >")
|
||||
(* (CL:IF INFO1
|
||||
" *"
|
||||
"* "))
|
||||
(SHOULDNT))
|
||||
" ")
|
||||
(CL:WHEN INFO2
|
||||
(PRINTOUT STREAM (fetch DATE of INFO2)
|
||||
" "
|
||||
" "
|
||||
(SUBSTRING (fetch (CDINFO FULLNAME) OF INFO2)
|
||||
(ADD1 NCHARSDIR2)
|
||||
NIL
|
||||
@@ -657,7 +668,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CL:WHEN PRINTAUTHOR
|
||||
(PRINTOUT STREAM "(" (fetch (CDINFO AUTHOR) OF INFO2)
|
||||
") "))
|
||||
(PRINTOUT STREAM (fetch (CDINFO LENGTH) OF INFO2)))
|
||||
(PRINTOUT STREAM .FR LENGTH2END (fetch (CDINFO LENGTH) OF INFO2))
|
||||
(PRINTOUT STREAM " ")) (* ; "A little margin in the window")
|
||||
(TERPRI STREAM])
|
||||
|
||||
(CDPRINT.MAXWIDTHS
|
||||
@@ -717,23 +729,32 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(CDPRINT.COLHEADERS
|
||||
[LAMBDA (STREAM COLHEADINGS ENDDATE1 COL1WIDTH COL2START COL2WIDTH)
|
||||
(* ; "Edited 16-Jul-2022 10:38 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 14:47 by rmk:")
|
||||
|
||||
(* ;; "If column headers are provided, center them over the columns")
|
||||
|
||||
(CL:WHEN (EQLENGTH COLHEADINGS 2)
|
||||
(TAB (DIFFERENCE ENDDATE1 COL1WIDTH)
|
||||
0 STREAM)
|
||||
(FLUSHRIGHT ENDDATE1 (CAR COLHEADINGS)
|
||||
0 NIL T STREAM)
|
||||
(TAB COL2START 0 STREAM)
|
||||
(FLUSHRIGHT (PLUS COL2START COL2WIDTH)
|
||||
(CADR COLHEADINGS)
|
||||
0 NIL T STREAM)
|
||||
(TERPRI STREAM))])
|
||||
(CL:WHEN (LISTP COLHEADINGS)
|
||||
(LET (HEADING)
|
||||
(CL:WHEN (SETQ HEADING (CAR COLHEADINGS))
|
||||
(CL:WHEN (IGREATERP (NCHARS HEADING)
|
||||
COL1WIDTH) (* ; "Truncate to column width")
|
||||
(SETQ HEADING (SUBSTRING HEADING 1 COL1WIDTH)))
|
||||
(TAB (DIFFERENCE ENDDATE1 COL1WIDTH)
|
||||
0 STREAM)
|
||||
(FLUSHRIGHT ENDDATE1 HEADING 0 NIL T STREAM))
|
||||
(CL:WHEN [SETQ HEADING (CAR (LISTP (CDR COLHEADINGS]
|
||||
(CL:WHEN (IGREATERP (NCHARS HEADING)
|
||||
COL2WIDTH)
|
||||
(SETQ HEADING (SUBSTRING HEADING 1 COL2WIDTH)))
|
||||
(TAB COL2START 0 STREAM)
|
||||
(FLUSHRIGHT (PLUS COL2START COL2WIDTH)
|
||||
HEADING 0 NIL T STREAM))
|
||||
(TERPRI STREAM)))])
|
||||
|
||||
(CDPRINT.COLUMNS
|
||||
[LAMBDA (CDVALUE COLHEADINGS PRINTAUTHOR) (* ; "Edited 30-Nov-2021 14:03 by rmk:")
|
||||
[LAMBDA (CDVALUE COLHEADINGS PRINTAUTHOR) (* ; "Edited 16-Jul-2022 10:40 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 14:03 by rmk:")
|
||||
|
||||
(* ;; "Compute the column locations for CDPRINT.LINE")
|
||||
|
||||
@@ -742,13 +763,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(SETQ CDVALUE (CD.INSURECDVALUE CDVALUE))
|
||||
(LET (INFO1 DATE1POS ENDDATE1 (COL1WIDTH 10)
|
||||
(COL2WIDTH 10)
|
||||
(DATERELWIDTH 5)
|
||||
(DATERELWIDTH 6)
|
||||
(MAXWIDTHS1 (FETCH (CDVALUE CDMAXNC1) OF CDVALUE))
|
||||
(MAXWIDTHS2 (FETCH (CDVALUE CDMAXNC2) OF CDVALUE))
|
||||
(MAXAUTHOR1 0)
|
||||
(MAXAUTHOR2 0)
|
||||
[DATEWIDTH (CONSTANT (NCHARS (DATE]
|
||||
MAXFILE1WIDTH MAXFILE2WIDTH (EQUIV 4))
|
||||
MAXNAME1 MAXNAME2 (EQUIV 4)
|
||||
COL2START LENGTH2END)
|
||||
|
||||
(* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing. We have to measure the filename, date, size, and author if desired")
|
||||
|
||||
@@ -758,37 +780,38 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(* ;; "Even though the longest length and author might not go with the longest file name, it is a reasonable approximation to assume that in fact the longest filename did have the longest length. Lengths differ by just a few characters, and a long length with a short filename might balance out. If the long file did have a long length, then it would all be exact. ")
|
||||
|
||||
(* ;; "Include space between truncated file and length")
|
||||
|
||||
[SETQ MAXFILE1WIDTH (IMAX 10 (IPLUS (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS1)
|
||||
(FETCH NCDIR OF MAXWIDTHS1))
|
||||
(CONSTANT (NCHARS " "))
|
||||
(fetch NCLENGTH of MAXWIDTHS1]
|
||||
[SETQ MAXFILE2WIDTH (IMAX 10 (NCHARS (CADR COLHEADINGS))
|
||||
(IPLUS (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS2)
|
||||
(FETCH NCDIR OF MAXWIDTHS2))
|
||||
(CONSTANT (NCHARS " "))
|
||||
(fetch NCLENGTH of MAXWIDTHS2]
|
||||
(SETQ MAXNAME1 (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS1)
|
||||
(fetch NCDIR OF MAXWIDTHS1)))
|
||||
(SETQ MAXNAME2 (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS2)
|
||||
(fetch NCDIR OF MAXWIDTHS2)))
|
||||
(CL:WHEN PRINTAUTHOR
|
||||
(SETQ MAXAUTHOR1 (IPLUS (CONSTANT (NCHARS "() "))
|
||||
(fetch NCAUTHOR of MAXWIDTHS1)))
|
||||
(SETQ MAXAUTHOR2 (IPLUS (CONSTANT (NCHARS "() "))
|
||||
(fetch NCAUTHOR of MAXWIDTHS2))))
|
||||
|
||||
(* ;;
|
||||
"First 4 for width of equiv. 2 spaces between end of widest file and the date column")
|
||||
(* ;; "MAXAUTHOR includes its own suffixspace")
|
||||
|
||||
[SETQ DATE1POS (IPLUS EQUIV MAXFILE1WIDTH MAXAUTHOR1 (CONSTANT (NCHARS " "]
|
||||
(SETQ ENDDATE1 (IPLUS DATE1POS DATEWIDTH))
|
||||
[SETQ MAXAUTHOR1 (IPLUS (CONSTANT (NCHARS "("))
|
||||
(fetch NCAUTHOR of MAXWIDTHS1)
|
||||
(CONSTANT (NCHARS ") "]
|
||||
[SETQ MAXAUTHOR2 (IPLUS (CONSTANT (NCHARS (NCHARS "(")))
|
||||
(fetch NCAUTHOR of MAXWIDTHS2)
|
||||
(CONSTANT (NCHARS ") "])
|
||||
(SETQ COL1WIDTH (IPLUS MAXNAME1 1 MAXAUTHOR1 (fetch NCLENGTH of MAXWIDTHS1)
|
||||
2 DATEWIDTH))
|
||||
(SETQ DATE1POS (IPLUS EQUIV (IDIFFERENCE COL1WIDTH DATEWIDTH)))
|
||||
(SETQ ENDDATE1 (IPLUS EQUIV COL1WIDTH))
|
||||
(SETQ COL2WIDTH (IPLUS DATEWIDTH 2 MAXNAME2 1 MAXAUTHOR2 (fetch NCLENGTH
|
||||
of MAXWIDTHS2)))
|
||||
|
||||
(* ;; "If column headers are provided, center them over the columns")
|
||||
|
||||
(CL:WHEN (EQLENGTH COLHEADINGS 2)
|
||||
(SETQ COL1WIDTH (IMAX (NCHARS (CAR COLHEADINGS))
|
||||
(IPLUS MAXFILE1WIDTH MAXAUTHOR1 DATEWIDTH)))
|
||||
(SETQ COL2WIDTH (IMAX (NCHARS (CADR COLHEADINGS))
|
||||
(IPLUS MAXFILE2WIDTH MAXAUTHOR2 DATEWIDTH))))
|
||||
(LIST DATE1POS ENDDATE1 COL1WIDTH COL2WIDTH (PLUS EQUIV COL1WIDTH DATERELWIDTH])
|
||||
(* ;; "If column headers are provided, center them over the columns. But don't expand the column, the headers will be truncated.")
|
||||
(* (CL:WHEN (CAR (LISTP COLHEADINGS))
|
||||
(SETQ COL1WIDTH (IMAX 10
|
||||
(NCHARS (CAR COLHEADINGS)) COL1WIDTH))))
|
||||
(SETQ COL2START (PLUS EQUIV COL1WIDTH DATERELWIDTH))
|
||||
(* (CL:WHEN (CAR (LISTP
|
||||
(CDR COLHEADINGS))) (SETQ COL2WIDTH
|
||||
(IMAX 10 (NCHARS (CADR COLHEADINGS))
|
||||
COL2WIDTH))))
|
||||
(SETQ LENGTH2END (IPLUS COL2START COL2WIDTH))
|
||||
(LIST DATE1POS ENDDATE1 COL1WIDTH COL2WIDTH COL2START LENGTH2END])
|
||||
|
||||
(CDTEDIT
|
||||
[LAMBDA (CDVALUE TITLE COLHEADINGS PRINTAUTHOR) (* ; "Edited 5-Nov-2021 16:44 by rmk:")
|
||||
@@ -1068,6 +1091,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD CDMAXNCHARS (NCFULLNAME NCLENGTH NCAUTHOR NCTYPE NCDIR))
|
||||
|
||||
(RECORD CDVALUE ((CDDIR1 CDDIR2 CDCOMPAREDATE CDSELECT CDMAXNC1 CDMAXNC2) . CDENTRIES)
|
||||
(RECORD CDVALUE (CDPARAMETERS))
|
||||
CDMAXNC1 _ (CREATE CDMAXNCHARS)
|
||||
@@ -1076,8 +1101,6 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(RECORD CDENTRY (MATCHNAME INFO1 DATEREL INFO2 . EQUIV))
|
||||
|
||||
(RECORD CDINFO (FULLNAME DATE LENGTH AUTHOR TYPE EOL))
|
||||
|
||||
(RECORD CDMAXNCHARS (NCFULLNAME NCLENGTH NCAUTHOR NCTYPE NCDIR))
|
||||
)
|
||||
|
||||
|
||||
@@ -2122,21 +2145,21 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
COMPAREDIRECTORIES.CANDIDATES 10361 . 13746) (CDENTRIES.SELECT 13748 . 18523) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18525 . 19431) (MATCHNAME 19433 . 20113) (CD.INSURECDVALUE 20115 . 21729
|
||||
) (CD.UPDATEWIDTHS 21731 . 22195)) (22198 31867 (CDFILES 22208 . 27961) (CDFILES.MATCH 27963 . 29588)
|
||||
(CDFILES.PATS 29590 . 31865)) (31868 46953 (CDPRINT 31878 . 34223) (CDPRINT.HEADER 34225 . 35122) (
|
||||
CDPRINT.LINE 35124 . 37680) (CDPRINT.MAXWIDTHS 37682 . 41797) (CDPRINT.COLHEADERS 41799 . 42437) (
|
||||
CDPRINT.COLUMNS 42439 . 46318) (CDTEDIT 46320 . 46951)) (46954 55323 (CDMAP 46964 . 48396) (CDENTRY
|
||||
48398 . 48707) (CDSUBSET 48709 . 50148) (CDMERGE 50150 . 54004) (CDMERGE.COMMON 54006 . 55321)) (55324
|
||||
62862 (BINCOMP 55334 . 59623) (EOLTYPE 59625 . 62187) (EOLTYPE.SHOW 62189 . 62860)) (63390 75917 (
|
||||
FIND-UNCOMPILED-FILES 63400 . 67043) (FIND-UNSOURCED-FILES 67045 . 69429) (FIND-SOURCE-FILES 69431 .
|
||||
71169) (FIND-COMPILED-FILES 71171 . 73048) (FIND-UNLOADED-FILES 73050 . 73903) (FIND-LOADED-FILES
|
||||
73905 . 74333) (FIND-MULTICOMPILED-FILES 74335 . 75915)) (75918 84349 (CREATED-AS 75928 . 80725) (
|
||||
SOURCE-FOR-COMPILED-P 80727 . 83654) (COMPILE-SOURCE-DATE-DIFF 83656 . 84347)) (84350 94656 (
|
||||
FIX-DIRECTORY-DATES 84360 . 87353) (FIX-EQUIV-DATES 87355 . 88880) (COPY-COMPARED-FILES 88882 . 90703)
|
||||
(COPY-MISSING-FILES 90705 . 92862) (COMPILED-ON-SAME-SOURCE 92864 . 94654)) (94850 102196 (CDBROWSER
|
||||
94860 . 98787) (CDBROWSER.STRINGS 98789 . 102194)) (102358 104094 (CD.TABLEITEM 102368 . 102588) (
|
||||
CD.TABLEITEM.PRINTFN 102590 . 102789) (CD.TABLEITEM.COPYFN 102791 . 103849) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 103851 . 104092)) (104095 124750 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
104105 . 104573) (CD.COMMANDSELECTEDFN 104575 . 109676) (CD-MENUFN 109678 . 113989) (CD-COMPARE-FILES
|
||||
113991 . 117343) (CDBROWSER-COPY 117345 . 121014) (CDBROWSER-DELETE-FILE 121016 . 124229) (CD-SWAPDIRS
|
||||
124231 . 124748)))))
|
||||
(CDFILES.PATS 29590 . 31865)) (31868 48910 (CDPRINT 31878 . 34395) (CDPRINT.HEADER 34397 . 35294) (
|
||||
CDPRINT.LINE 35296 . 38528) (CDPRINT.MAXWIDTHS 38530 . 42645) (CDPRINT.COLHEADERS 42647 . 43932) (
|
||||
CDPRINT.COLUMNS 43934 . 48275) (CDTEDIT 48277 . 48908)) (48911 57280 (CDMAP 48921 . 50353) (CDENTRY
|
||||
50355 . 50664) (CDSUBSET 50666 . 52105) (CDMERGE 52107 . 55961) (CDMERGE.COMMON 55963 . 57278)) (57281
|
||||
64819 (BINCOMP 57291 . 61580) (EOLTYPE 61582 . 64144) (EOLTYPE.SHOW 64146 . 64817)) (65347 77874 (
|
||||
FIND-UNCOMPILED-FILES 65357 . 69000) (FIND-UNSOURCED-FILES 69002 . 71386) (FIND-SOURCE-FILES 71388 .
|
||||
73126) (FIND-COMPILED-FILES 73128 . 75005) (FIND-UNLOADED-FILES 75007 . 75860) (FIND-LOADED-FILES
|
||||
75862 . 76290) (FIND-MULTICOMPILED-FILES 76292 . 77872)) (77875 86306 (CREATED-AS 77885 . 82682) (
|
||||
SOURCE-FOR-COMPILED-P 82684 . 85611) (COMPILE-SOURCE-DATE-DIFF 85613 . 86304)) (86307 96613 (
|
||||
FIX-DIRECTORY-DATES 86317 . 89310) (FIX-EQUIV-DATES 89312 . 90837) (COPY-COMPARED-FILES 90839 . 92660)
|
||||
(COPY-MISSING-FILES 92662 . 94819) (COMPILED-ON-SAME-SOURCE 94821 . 96611)) (96807 104153 (CDBROWSER
|
||||
96817 . 100744) (CDBROWSER.STRINGS 100746 . 104151)) (104315 106051 (CD.TABLEITEM 104325 . 104545) (
|
||||
CD.TABLEITEM.PRINTFN 104547 . 104746) (CD.TABLEITEM.COPYFN 104748 . 105806) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 105808 . 106049)) (106052 126707 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
106062 . 106530) (CD.COMMANDSELECTEDFN 106532 . 111633) (CD-MENUFN 111635 . 115946) (CD-COMPARE-FILES
|
||||
115948 . 119300) (CDBROWSER-COPY 119302 . 122971) (CDBROWSER-DELETE-FILE 122973 . 126186) (CD-SWAPDIRS
|
||||
126188 . 126705)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
304
lispusers/GITFNS
304
lispusers/GITFNS
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Jul-2022 19:01:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;397 109555
|
||||
(FILECREATED "17-Jul-2022 11:13:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;418 112329
|
||||
|
||||
:CHANGES-TO (FNS GIT-PRC-MENU GIT-COMMAND-TO-FILE)
|
||||
(COMMANDS prc)
|
||||
:CHANGES-TO (FNS GIT-PULL-REQUESTS GIT-BRANCH-DIFF PROCESS-COMMAND)
|
||||
|
||||
:PREVIOUS-DATE " 8-Jul-2022 10:37:36"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;390)
|
||||
:PREVIOUS-DATE "16-Jul-2022 22:22:54"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;414)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -102,7 +101,8 @@
|
||||
|
||||
(* ;; "Utilities")
|
||||
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE)
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND
|
||||
GIT-RESULT-TO-LINES)
|
||||
(PROPS (GITFNS FILETYPE))))
|
||||
|
||||
|
||||
@@ -147,6 +147,7 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 13-Jul-2022 13:47 by rmk")
|
||||
(* ; "Edited 6-Jul-2022 19:34 by rmk")
|
||||
(* ; "Edited 17-May-2022 17:08 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
@@ -169,7 +170,7 @@
|
||||
|
||||
(* ;; "WORKINGPATH T or NIL means try to find a parallel to the projectpath, T means don't cause an error if not found. ")
|
||||
|
||||
(SETQ PROJECTNAME (U-CASE PROJECTNAME))
|
||||
(SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME)))
|
||||
(CL:WHEN (MEMB PROJECTPATH '(NIL T))
|
||||
[SETQ PROJECTPATH (OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME)
|
||||
T)
|
||||
@@ -956,6 +957,8 @@
|
||||
(GIT-BRANCH-DIFF
|
||||
[LAMBDA (BRANCH1 BRANCH2 PROJECT)
|
||||
|
||||
(* ;; "Edited 17-Jul-2022 09:36 by rmk")
|
||||
|
||||
(* ;; "Edited 4-Jun-2022 20:43 by rmk")
|
||||
|
||||
(* ;; "Edited 9-May-2022 16:21 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).")
|
||||
@@ -972,51 +975,79 @@
|
||||
(GIT-COMMAND (CONCAT
|
||||
"git diff-tree --no-commit-id --name-STATUS -r "
|
||||
COMMIT) NIL NIL PROJECT))
|
||||
(LET (POS (LINES (GIT-COMMAND (CONCAT "git diff --name-status -C --find-copies-harder " BRANCH1
|
||||
" " BRANCH2)
|
||||
NIL NIL PROJECT)))
|
||||
(CL:WHEN (SETQ POS (STRPOS "fatal: ambiguous argument '" (CAR LINES)
|
||||
1 NIL T T))
|
||||
(ERROR "Unknown branch " (IF (STRPOS BRANCH1 (CAR LINES)
|
||||
POS NIL T)
|
||||
THEN BRANCH1
|
||||
ELSE BRANCH2)))
|
||||
(SORT (FOR L IN LINES
|
||||
COLLECT (SELCHARQ (CHCON1 L)
|
||||
(A (CL:IF (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 2))
|
||||
(LIST 'ADDED (SUBSTRING L 3))
|
||||
(ERROR "ADDED NOT RECOGNIZED" L)))
|
||||
(D (CL:IF (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 2))
|
||||
(LIST 'DELETED (SUBSTRING L 3))
|
||||
(ERROR "DELETED NOT RECOGNIZED" L)))
|
||||
(M (CL:IF (SETQ POS (STRPOS " " L))
|
||||
(LIST 'CHANGED (SUBSTRING L (ADD1 POS)))
|
||||
(ERROR "CHANGED NOT RECOGNIZED" L)))
|
||||
(C (IF (AND (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 5))
|
||||
(SETQ POS (STRPOS " " L 7)))
|
||||
THEN (LIST 'COPIED (SUBSTRING L 6 (SUB1 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)))
|
||||
THEN (LIST 'RENAMED (SUBSTRING L 6 (SUB1 POS))
|
||||
(SUBSTRING L (ADD1 POS))
|
||||
(OR (FIXP (SUBATOM L 2 4))
|
||||
(HELP "R without a number" L)))
|
||||
ELSE (HELP "RENAME NOT RECOGNIZED" L)))
|
||||
(w (CL:UNLESS (STRPOS "warning: " L 1)
|
||||
(HELP "UNRECOGNZED GIT LINE" L))
|
||||
(CL:UNLESS (EQ 'Y (ASKUSER NIL NIL (CONCAT L
|
||||
|
||||
(* ;; "We don't use GIT-COMMAND because we want to deal with the warning messages here, to give the option of increasing the rename limit..")
|
||||
|
||||
(PROG (POS LIMIT ERRORFILE RLINES ELINES RESULTFILE)
|
||||
RETRY
|
||||
(SETQ RESULTFILE (GIT-COMMAND-TO-FILE (CONCAT
|
||||
"git diff --name-status -C --find-copies-harder "
|
||||
BRANCH1 " " BRANCH2)
|
||||
PROJECT))
|
||||
(SETQ ELINES NIL)
|
||||
(SETQ RLINES NIL)
|
||||
(CL:WHEN (LISTP RESULTFILE)
|
||||
(SETQ ERRORFILE (CADR RESULTFILE))
|
||||
(SETQ ELINES (GIT-RESULT-TO-LINES ERRORFILE))
|
||||
(DELFILE ERRORFILE)
|
||||
(SETQ RESULTFILE (CAR RESULTFILE)))
|
||||
(SETQ RLINES (GIT-RESULT-TO-LINES RESULTFILE))
|
||||
(DELFILE RESULTFILE)
|
||||
(CL:WHEN ELINES
|
||||
(IF [AND (STRPOS "warning: inexact rename detection was skipped due to too many files."
|
||||
(CAR ELINES)
|
||||
1)
|
||||
(SETQ LIMIT (FIXP (SUBATOM (CADR ELINES)
|
||||
(STRPOS " at least " (CADR ELINES)
|
||||
1 NIL NIL T)
|
||||
(SUB1 (STRPOS " and retry " (CADR ELINES]
|
||||
THEN (PRINTOUT T 3 "** For accurate branch differences, "
|
||||
"diff.renameLimit must be increased")
|
||||
(SELECTQ (AND LIMIT (ASKUSER NIL 'N (CONCAT
|
||||
" Should I increase the global limit to "
|
||||
(ADD LIMIT 1)
|
||||
" and try again? ")))
|
||||
(Y (GIT-COMMAND (CONCAT "git config --global diff.renameLimit " LIMIT)
|
||||
NIL NIL PROJECT)
|
||||
(GO RETRY))
|
||||
(ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2)))
|
||||
ELSE (FOR L IN ELINES DO (PRINTOUT T L T))))
|
||||
(RETURN (SORT (FOR L IN RLINES
|
||||
COLLECT (SELCHARQ (CHCON1 L)
|
||||
(A (CL:IF (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 2))
|
||||
(LIST 'ADDED (SUBSTRING L 3))
|
||||
(ERROR "ADDED NOT RECOGNIZED" L)))
|
||||
(D (CL:IF (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 2))
|
||||
(LIST 'DELETED (SUBSTRING L 3))
|
||||
(ERROR "DELETED NOT RECOGNIZED" L)))
|
||||
(M (CL:IF (SETQ POS (STRPOS " " L))
|
||||
(LIST 'CHANGED (SUBSTRING L (ADD1 POS)))
|
||||
(ERROR "CHANGED NOT RECOGNIZED" L)))
|
||||
(C (IF (AND (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 5))
|
||||
(SETQ POS (STRPOS " " L 7)))
|
||||
THEN (LIST 'COPIED (SUBSTRING L 6 (SUB1 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)))
|
||||
THEN (LIST 'RENAMED (SUBSTRING L 6 (SUB1 POS))
|
||||
(SUBSTRING L (ADD1 POS))
|
||||
(OR (FIXP (SUBATOM L 2 4))
|
||||
(HELP "R without a number" L)))
|
||||
ELSE (HELP "RENAME NOT RECOGNIZED" L)))
|
||||
(w (CL:UNLESS (STRPOS "warning: " L 1)
|
||||
(HELP "UNRECOGNZED GIT LINE" L))
|
||||
(CL:UNLESS (EQ 'Y (ASKUSER NIL NIL (CONCAT L
|
||||
" Ignore remaining files? "
|
||||
)))
|
||||
(ERROR!)))
|
||||
(HELP "Unrecognized git-diff code %"" L "%"")))
|
||||
T])
|
||||
)))
|
||||
(ERROR!)))
|
||||
(HELP "Unrecognized git-diff code " L)))
|
||||
T])
|
||||
|
||||
(GIT-COMMIT-DIFFS
|
||||
[LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 26-Jun-2022 13:32 by rmk")
|
||||
@@ -1244,8 +1275,11 @@
|
||||
T)))])
|
||||
|
||||
(GIT-PULL-REQUESTS
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk")
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 17-Jul-2022 11:12 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:54 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 09:26 by rmk")
|
||||
(CL:UNLESS (EQ 0 (PROCESS-COMMAND "command -v gh"))
|
||||
(ERROR "gh must be installed in order to enumerate pull requests:"))
|
||||
(FOR LINE TAB1 TAB2 TAB3 VAL IN (GIT-COMMAND "gh pr list" T NIL PROJECT)
|
||||
WHEN [AND (SETQ TAB1 (STRPOS " " LINE))
|
||||
(SETQ TAB2 (STRPOS " " LINE (ADD1 TAB1)))
|
||||
@@ -1945,7 +1979,8 @@
|
||||
" && "])
|
||||
|
||||
(GIT-COMMAND
|
||||
[LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 8-Jul-2022 10:20 by rmk")
|
||||
[LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 16-Jul-2022 13:06 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 10:20 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:40 by rmk")
|
||||
(* ; "Edited 7-Oct-2021 11:15 by rmk:")
|
||||
|
||||
@@ -1966,13 +2001,7 @@
|
||||
(DELFILE (CADR RESULTFILE))
|
||||
(SETQ RESULTFILE (CAR RESULTFILE)))
|
||||
(CL:WHEN RESULTFILE
|
||||
(SETQ LINES (CL:WITH-OPEN-FILE (STREAM RESULTFILE :DIRECTION :INPUT :EXTERNAL-FORMAT
|
||||
(SYSTEM-EXTERNALFORMAT))
|
||||
(BIND LINE UNTIL (EOFP STREAM)
|
||||
WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P NIL
|
||||
:EOF-VALUE NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1 NIL T] COLLECT
|
||||
LINE)))
|
||||
(SETQ LINES (GIT-RESULT-TO-LINES RESULTFILE ALL))
|
||||
(DELFILE RESULTFILE) (* ; "On tmp/, OK if we miss")
|
||||
LINES)])
|
||||
|
||||
@@ -2001,92 +2030,109 @@
|
||||
(ERROR "INITIALS is not set"])
|
||||
|
||||
(GIT-COMMAND-TO-FILE
|
||||
[LAMBDA (CMD PROJECT NOERROR) (* ; "Edited 9-Jul-2022 18:55 by rmk")
|
||||
[LAMBDA (CMD PROJECT NOERROR) (* ; "Edited 16-Jul-2022 10:09 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 18:55 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 08:51 by rmk")
|
||||
|
||||
(* ;; "Try to make the temporary name unique. Maybe Unix mktemp, except that we need to know the name that was used. So we calculate it, provide it, and assume that it worked. Caller an decide to delete it after examination. (Or, left to be reaped from /tmp/)")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
|
||||
(* ;;
|
||||
"Filename of the form /tmp/medley-gitresult-{IDATE}-{rand} -- Avoid creating new unix directory")
|
||||
(* ;; "Filename of the form /tmp/medley-gitresult-{IDATE}-{rand} ")
|
||||
|
||||
(LET* ([PROJECTNAME (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME]
|
||||
(DATE (IDATE))
|
||||
(RAND (RAND))
|
||||
(RESULTFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-result"))
|
||||
(ERRORFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-error"))
|
||||
COMPLETED)
|
||||
[CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT)
|
||||
CMD " > " (STRIPHOST RESULTFILE)
|
||||
" 2> "
|
||||
(STRIPHOST ERRORFILE)
|
||||
" && echo COMPLETED ")))
|
||||
(CLOSEF? ERRORFILE)
|
||||
|
||||
(* ;;
|
||||
"Avoid reading the process stream if there is another error signal. It ends to hang.")
|
||||
|
||||
(SETQ COMPLETED (IF (AND (INFILEP ERRORFILE)
|
||||
(IGREATERP (GETFILEINFO ERRORFILE 'LENGTH)
|
||||
0))
|
||||
THEN [CL:WITH-OPEN-FILE (ESTREAM ERRORFILE :DIRECTION :INPUT
|
||||
:EXTERNAL-FORMAT (
|
||||
SYSTEM-EXTERNALFORMAT
|
||||
))
|
||||
(OR (NEQ 0 (OR (FILEPOS "fatal: " ESTREAM 0 1)
|
||||
(FILEPOS "gh: Command not found"
|
||||
ESTREAM 0 1)
|
||||
(FILEPOS "unknown command %"" ESTREAM
|
||||
0 1)))
|
||||
(FILEPOS "' is not a git command." ESTREAM
|
||||
(NCHARS CMD]
|
||||
ELSE (SETFILEINFO PS 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(STREQUAL "COMPLETED" (RSTRING PS]
|
||||
COMPLETIONCODE)
|
||||
[SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCAT (CDGITDIR PROJECT)
|
||||
CMD " > " (STRIPHOST RESULTFILE)
|
||||
" 2> "
|
||||
(STRIPHOST ERRORFILE]
|
||||
(CLOSEF? ERRORFILE)
|
||||
(CLOSEF? RESULTFILE)
|
||||
(IF COMPLETED
|
||||
THEN (IF (IEQP 0 (GETFILEINFO ERRORFILE 'LENGTH))
|
||||
THEN (DELFILE ERRORFILE)
|
||||
(SETQ ERRORFILE NIL)
|
||||
ELSEIF (IEQP 0 (GETFILEINFO RESULTFILE 'LENGTH))
|
||||
THEN (SETQ RESULTFILE ERRORFILE)
|
||||
(SETQ ERRORFILE NIL))
|
||||
(IF ERRORFILE
|
||||
(CL:WHEN [AND (INFILEP ERRORFILE)
|
||||
(IEQP 0 (GETFILEINFO ERRORFILE 'LENGTH]
|
||||
(DELFILE ERRORFILE)
|
||||
(SETQ ERRORFILE NIL))
|
||||
(CL:WHEN (AND (INFILEP RESULTFILE)
|
||||
(IEQP 0 (GETFILEINFO RESULTFILE 'LENGTH))
|
||||
ERRORFILE)
|
||||
(DELFILE RESULTFILE) (* ;
|
||||
"Don't delete if the error file is also empty")
|
||||
(SETQ RESULTFILE NIL))
|
||||
(CL:WHEN (AND (EQ COMPLETIONCODE 0)
|
||||
ERRORFILE) (* ;
|
||||
"Check the error file, just in case")
|
||||
(CL:WITH-OPEN-FILE (ESTREAM ERRORFILE :DIRECTION :INPUT :EXTERNAL-FORMAT (
|
||||
SYSTEM-EXTERNALFORMAT
|
||||
))
|
||||
(CL:WHEN (OR (EQ 0 (OR (FILEPOS "fatal: " ESTREAM 0 1)
|
||||
(FILEPOS "gh: Command not found" ESTREAM 0 1)
|
||||
(FILEPOS "unknown command %"" ESTREAM 0 1)))
|
||||
(FILEPOS "' is not a git command." ESTREAM (NCHARS CMD)))
|
||||
(SETQ COMPLETIONCODE 1))))
|
||||
(IF (EQ 0 COMPLETIONCODE)
|
||||
THEN (IF (AND RESULTFILE ERRORFILE)
|
||||
THEN (LIST RESULTFILE ERRORFILE)
|
||||
ELSE RESULTFILE)
|
||||
ELSEIF RESULTFILE
|
||||
ELSE ERRORFILE)
|
||||
ELSE (DELFILE RESULTFILE)
|
||||
(DELFILE ERRORFILE)
|
||||
(IF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR (CONCAT "Command failed: " CMD])
|
||||
(CL:UNLESS NOERROR
|
||||
(ERROR (CONCAT "Command failed: " CMD)))
|
||||
NIL])
|
||||
|
||||
(PROCESS-COMMAND
|
||||
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
|
||||
|
||||
(* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD))
|
||||
(BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1)
|
||||
of PS))
|
||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||
|
||||
(GIT-RESULT-TO-LINES
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
|
||||
(* ;; "Suppress .git lines unless ALL")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT))
|
||||
(BIND LINE UNTIL (EOFP STREAM) WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P
|
||||
NIL :EOF-VALUE NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1]
|
||||
COLLECT LINE])
|
||||
)
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3592 18006 (GIT-CLONEP 3602 . 4865) (GIT-MAKE-PROJECT 4867 . 12847) (GIT-GET-PROJECT
|
||||
12849 . 14774) (GIT-PROJECT-PATH 14776 . 15820) (FIND-ANCESTOR-DIRECTORY 15822 . 16171) (
|
||||
GIT-FIND-CLONE 16173 . 17254) (GIT-MAINBRANCH 17256 . 17651) (GIT-MAINBRANCH? 17653 . 18004)) (24323
|
||||
27111 (ALLSUBDIRS 24333 . 25619) (MEDLEYSUBDIRS 25621 . 26314) (GITSUBDIRS 26316 . 27109)) (27112
|
||||
31902 (TOGIT 27122 . 28528) (FROMGIT 28530 . 29511) (GIT-DELETE-FILE 29513 . 30359) (
|
||||
MYMEDLEY-DELETE-FILES 30361 . 31900)) (31903 34435 (MYMEDLEYSUBDIR 31913 . 32369) (GITSUBDIR 32371 .
|
||||
32814) (STRIPDIR 32816 . 33187) (STRIPHOST 33189 . 33429) (STRIPNAME 33431 . 34184) (STRIPWHERE 34186
|
||||
. 34433)) (34436 36338 (GFILE4MFILE 34446 . 34809) (MFILE4GFILE 34811 . 35380) (GIT-REPO-FILENAME
|
||||
35382 . 36336)) (36387 46175 (GIT-COMMIT 36397 . 37223) (GIT-PUSH 37225 . 37869) (GIT-PULL 37871 .
|
||||
38483) (GIT-APPROVAL 38485 . 38834) (GIT-GET-FILE 38836 . 40767) (GIT-FILE-EXISTS? 40769 . 41043) (
|
||||
GIT-REMOTE-UPDATE 41045 . 41769) (GIT-REMOTE-ADD 41771 . 42078) (GIT-FILE-DATE 42080 . 43011) (
|
||||
GIT-FILE-HISTORY 43013 . 44947) (GIT-PRINT-FILE-HISTORY 44949 . 45999) (GIT-FETCH 46001 . 46173)) (
|
||||
46205 54905 (GIT-BRANCH-DIFF 46215 . 50967) (GIT-COMMIT-DIFFS 50969 . 51522) (GIT-BRANCH-RELATIONS
|
||||
51524 . 54903)) (54950 64659 (GIT-BRANCH-NUM 54960 . 55533) (GIT-CHECKOUT 55535 . 56594) (
|
||||
GIT-WHICH-BRANCH 56596 . 56894) (GIT-MAKE-BRANCH 56896 . 58640) (GIT-BRANCHES 58642 . 60240) (
|
||||
GIT-BRANCH-EXISTS? 60242 . 60946) (GIT-PICK-BRANCH 60948 . 61276) (GIT-PRC-MENU 61278 . 63026) (
|
||||
GIT-PULL-REQUESTS 63028 . 64045) (GIT-SHORT-BRANCH-NAME 64047 . 64338) (GIT-LONG-NAME 64340 . 64657))
|
||||
(64689 68024 (GIT-MY-CURRENT-BRANCH 64699 . 65069) (GIT-MY-BRANCHP 65071 . 65576) (GIT-MY-NEXT-BRANCH
|
||||
65578 . 66072) (GIT-MY-BRANCHES 66074 . 68022)) (68070 72022 (GIT-ADD-WORKTREE 68080 . 69564) (
|
||||
GIT-REMOVE-WORKTREE 69566 . 70496) (GIT-LIST-WORKTREES 70498 . 71302) (WORKTREEDIR 71304 . 72020)) (
|
||||
72070 102052 (GIT-GET-DIFFERENT-FILES 72080 . 77905) (GIT-BRANCHES-COMPARE-DIRECTORIES 77907 . 83749)
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES 83751 . 88497) (GIT-COMPARE-WORKTREE 88499 . 92477) (GITCDOBJBUTTONFN
|
||||
92479 . 96969) (GIT-CD-LABELFN 96971 . 98053) (GIT-CD-MENUFN 98055 . 100262) (
|
||||
GIT-WORKING-COMPARE-FILES 100264 . 100884) (GIT-BRANCHES-COMPARE-FILES 100886 . 102050)) (102122
|
||||
109488 (CDGITDIR 102132 . 102692) (GIT-COMMAND 102694 . 104702) (GITORIGIN 104704 . 105401) (
|
||||
GIT-INITIALS 105403 . 105707) (GIT-COMMAND-TO-FILE 105709 . 109486)))))
|
||||
(FILEMAP (NIL (3626 18158 (GIT-CLONEP 3636 . 4899) (GIT-MAKE-PROJECT 4901 . 12999) (GIT-GET-PROJECT
|
||||
13001 . 14926) (GIT-PROJECT-PATH 14928 . 15972) (FIND-ANCESTOR-DIRECTORY 15974 . 16323) (
|
||||
GIT-FIND-CLONE 16325 . 17406) (GIT-MAINBRANCH 17408 . 17803) (GIT-MAINBRANCH? 17805 . 18156)) (24475
|
||||
27263 (ALLSUBDIRS 24485 . 25771) (MEDLEYSUBDIRS 25773 . 26466) (GITSUBDIRS 26468 . 27261)) (27264
|
||||
32054 (TOGIT 27274 . 28680) (FROMGIT 28682 . 29663) (GIT-DELETE-FILE 29665 . 30511) (
|
||||
MYMEDLEY-DELETE-FILES 30513 . 32052)) (32055 34587 (MYMEDLEYSUBDIR 32065 . 32521) (GITSUBDIR 32523 .
|
||||
32966) (STRIPDIR 32968 . 33339) (STRIPHOST 33341 . 33581) (STRIPNAME 33583 . 34336) (STRIPWHERE 34338
|
||||
. 34585)) (34588 36490 (GFILE4MFILE 34598 . 34961) (MFILE4GFILE 34963 . 35532) (GIT-REPO-FILENAME
|
||||
35534 . 36488)) (36539 46327 (GIT-COMMIT 36549 . 37375) (GIT-PUSH 37377 . 38021) (GIT-PULL 38023 .
|
||||
38635) (GIT-APPROVAL 38637 . 38986) (GIT-GET-FILE 38988 . 40919) (GIT-FILE-EXISTS? 40921 . 41195) (
|
||||
GIT-REMOTE-UPDATE 41197 . 41921) (GIT-REMOTE-ADD 41923 . 42230) (GIT-FILE-DATE 42232 . 43163) (
|
||||
GIT-FILE-HISTORY 43165 . 45099) (GIT-PRINT-FILE-HISTORY 45101 . 46151) (GIT-FETCH 46153 . 46325)) (
|
||||
46357 57089 (GIT-BRANCH-DIFF 46367 . 53151) (GIT-COMMIT-DIFFS 53153 . 53706) (GIT-BRANCH-RELATIONS
|
||||
53708 . 57087)) (57134 67092 (GIT-BRANCH-NUM 57144 . 57717) (GIT-CHECKOUT 57719 . 58778) (
|
||||
GIT-WHICH-BRANCH 58780 . 59078) (GIT-MAKE-BRANCH 59080 . 60824) (GIT-BRANCHES 60826 . 62424) (
|
||||
GIT-BRANCH-EXISTS? 62426 . 63130) (GIT-PICK-BRANCH 63132 . 63460) (GIT-PRC-MENU 63462 . 65210) (
|
||||
GIT-PULL-REQUESTS 65212 . 66478) (GIT-SHORT-BRANCH-NAME 66480 . 66771) (GIT-LONG-NAME 66773 . 67090))
|
||||
(67122 70457 (GIT-MY-CURRENT-BRANCH 67132 . 67502) (GIT-MY-BRANCHP 67504 . 68009) (GIT-MY-NEXT-BRANCH
|
||||
68011 . 68505) (GIT-MY-BRANCHES 68507 . 70455)) (70503 74455 (GIT-ADD-WORKTREE 70513 . 71997) (
|
||||
GIT-REMOVE-WORKTREE 71999 . 72929) (GIT-LIST-WORKTREES 72931 . 73735) (WORKTREEDIR 73737 . 74453)) (
|
||||
74503 104485 (GIT-GET-DIFFERENT-FILES 74513 . 80338) (GIT-BRANCHES-COMPARE-DIRECTORIES 80340 . 86182)
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES 86184 . 90930) (GIT-COMPARE-WORKTREE 90932 . 94910) (GITCDOBJBUTTONFN
|
||||
94912 . 99402) (GIT-CD-LABELFN 99404 . 100486) (GIT-CD-MENUFN 100488 . 102695) (
|
||||
GIT-WORKING-COMPARE-FILES 102697 . 103317) (GIT-BRANCHES-COMPARE-FILES 103319 . 104483)) (104555
|
||||
112262 (CDGITDIR 104565 . 105125) (GIT-COMMAND 105127 . 106685) (GITORIGIN 106687 . 107384) (
|
||||
GIT-INITIALS 107386 . 107690) (GIT-COMMAND-TO-FILE 107692 . 111036) (PROCESS-COMMAND 111038 . 111651)
|
||||
(GIT-RESULT-TO-LINES 111653 . 112260)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -58,6 +58,7 @@ This compares the files in branch1 and branch2, for example
|
||||
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.
|
||||
If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by
|
||||
rmk15 > rmk14
|
||||
Note that the prc comparison is 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:
|
||||
@@ -89,6 +90,6 @@ TIMESROMAN $ TERMINAL MODERN
|
||||
If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.
|
||||
Note that the menu item for deleting 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 Medley files is also accomplished by renaming to a {Wprojectname}<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)))))
|
||||
(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 È È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD TERMINAL
|
||||
MODERN
|
||||
MODERN
|
||||
@@ -1,297 +0,0 @@
|
||||
(FILECREATED "11-Oct-84 14:34:16" {ERIS}<LISPCORE>LIBRARY>UPCSTATS.;3 9157
|
||||
|
||||
changes to: (FNS UPCSTATS)
|
||||
|
||||
previous date: "12-NOV-82 12:47:49" {ERIS}<LISPCORE>LIBRARY>UPCSTATS.;1)
|
||||
|
||||
|
||||
(* Copyright (c) by NIL. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT UPCSTATSCOMS)
|
||||
|
||||
(RPAQQ UPCSTATSCOMS ((VARS IMSIZE)
|
||||
(FNS GATHERUPCSTATS PRINTCUMULATIVEPERCENT PRINTUPC UPCSTATS)
|
||||
(FNS READMBFILE READNAME)
|
||||
(FNS PLOTPCS)
|
||||
(INITVARS (STATSBUFFER)
|
||||
(VIRTOREAL)
|
||||
(VIRTONAME))
|
||||
(VARS (UPCTHRESHOLD 0 (* lower threshold for percentage to show up on Microcode
|
||||
PC Sample histogram)))
|
||||
(MACROS BIN2 UPCCOUNT)))
|
||||
|
||||
(RPAQQ IMSIZE 4096)
|
||||
(DEFINEQ
|
||||
|
||||
(GATHERUPCSTATS
|
||||
[LAMBDA (FORM) (* lmm "12-NOV-82 12:45")
|
||||
(DECLARE (GLOBALVARS STATSBUFFER))
|
||||
(OR STATSBUFFER (SETQ STATSBUFFER (\ALLOCLOCKED IMSIZE)))
|
||||
[\ZEROWORDS STATSBUFFER (\ADDBASE STATSBUFFER (SUB1 (ITIMES IMSIZE (PROG1 2
|
||||
(* words per fixp)]
|
||||
[RESETVARS ((STRF T)
|
||||
(LCFIL))
|
||||
(COMPILE1 (QUOTE STATSDUMMYFUNCTION)
|
||||
(BQUOTE (LAMBDA NIL ((OPCODES UPCTRACE)
|
||||
STATSBUFFER)
|
||||
, FORM ((OPCODES UPCTRACE)
|
||||
NIL]
|
||||
(STATSDUMMYFUNCTION])
|
||||
|
||||
(PRINTCUMULATIVEPERCENT
|
||||
[LAMBDA NIL (* lmm "29-SEP-80 15:56")
|
||||
(PROGN (PRIN1 "(" NIL)
|
||||
(PRIN1 (FQUOTIENT (FPLUS (FTIMES 65536. CUHI)
|
||||
CULO)
|
||||
TOTAL)
|
||||
NIL)
|
||||
(PRIN1 ")" NIL])
|
||||
|
||||
(PRINTUPC
|
||||
[LAMBDA NIL (* lmm "12-NOV-82 11:40")
|
||||
(COND
|
||||
(UPCSEEN (do (PRIN1 "Use .MB file: " T)
|
||||
(SETQ MBFILE (READ T T)) repeatuntil (OR (EQ (NTHCHAR MBFILE 1)
|
||||
(QUOTE {))
|
||||
(EQ MBFILE (QUOTE NIL:))
|
||||
(INFILEP MBFILE)))
|
||||
(READMBFILE MBFILE)
|
||||
(PRIN1 "Microcode PC Sample: ")
|
||||
(PLOTPCS)))
|
||||
(STATSDUMMYFUNCTION])
|
||||
|
||||
(UPCSTATS
|
||||
[LAMBDA (FORM DOLISTFLG) (* gbn "11-Oct-84 14:33")
|
||||
(PROG ((STRF T)
|
||||
(LCFIL))
|
||||
(DECLARE (SPECVARS STRF LCFIL))
|
||||
(IF (NOT (EQ (MACHINETYPE)
|
||||
(QUOTE DORADO)))
|
||||
THEN (PRINTOUT T " UPCSTATS only runs on Dorados")
|
||||
(RETURN))
|
||||
(GATHERUPCSTATS FORM)
|
||||
(READMBFILE)
|
||||
(PLOTPCS])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(READMBFILE
|
||||
[LAMBDA (MBFILE) (* lmm "12-NOV-82 12:31")
|
||||
(OR MBFILE (do (PRIN1 "Use .MB file: " T)
|
||||
(SETQ MBFILE (READ T T)) repeatuntil (INFILEP MBFILE)))
|
||||
(PROG ((INX (GETOFD (SETQ MBFILE (OPENFILE MBFILE (QUOTE INPUT)
|
||||
(QUOTE OLD)
|
||||
8))
|
||||
(QUOTE INPUT)))
|
||||
(CURMEMWIDTH 0)
|
||||
(CURMEM 0)
|
||||
(CURLOC 0)
|
||||
IM BLOCKTYPE)
|
||||
(SETQ MEMORIES)
|
||||
(OR VIRTOREAL (SETQ VIRTOREAL (ARRAY IMSIZE (QUOTE SMALLP)
|
||||
0 0)))
|
||||
(OR VIRTONAME (SETQ VIRTONAME (ARRAY IMSIZE (QUOTE POINTER)
|
||||
NIL 0)))
|
||||
LP (SELECTQ (SETQ BLOCKTYPE (BIN2 INX))
|
||||
(0 (RETURN))
|
||||
[1 (COND
|
||||
((EQ CURMEM IM)
|
||||
(BIN2 INX) (* source line #)
|
||||
(BIN2 INX) (* bits 0 to 15)
|
||||
(BIN2 INX) (* bits 16 to 31)
|
||||
(BIN2 INX) (* bits 32 to 47)
|
||||
(FASTSETAW VIRTOREAL (PROG1 CURLOC (add CURLOC 1))
|
||||
(LOGAND (BIN2 INX)
|
||||
4095)) (* bits 48 to 63)
|
||||
)
|
||||
(T (BIN2 INX)
|
||||
(FRPTQ CURMEMWIDTH (BIN2 INX]
|
||||
(2 (SETQ CURMEM (BIN2 INX))
|
||||
(SETQ CURLOC (BIN2 INX))
|
||||
(SETQ CURMEMWIDTH (IQUOTIENT (IPLUS (CADR (OR (FASSOC CURMEM MEMORIES)
|
||||
(HELP)))
|
||||
15)
|
||||
16)))
|
||||
[3 (* FIXUP MEM# LOC FIRSTBIT,,LASTBIT VALUE)
|
||||
(COND
|
||||
((EQ (BIN2 INX)
|
||||
IM)
|
||||
(HELP))
|
||||
(T (BIN2 INX)
|
||||
(BIN2 INX)
|
||||
(BIN2 INX]
|
||||
[4 (push MEMORIES (LIST (BIN2 INX)
|
||||
(BIN2 INX)
|
||||
(READNAME INX)))
|
||||
(COND
|
||||
((EQ (CADDR (CAR MEMORIES))
|
||||
(QUOTE IM))
|
||||
(SETQ IM (CAAR MEMORIES))
|
||||
(OR (EQ (CADAR MEMORIES)
|
||||
64)
|
||||
(HELP (QUOTE IM)
|
||||
"wrong # bits"]
|
||||
[5 (* symbol location)
|
||||
(COND
|
||||
((EQ (BIN2 INX)
|
||||
IM)
|
||||
(FASTSETA VIRTONAME (BIN2 INX)
|
||||
(READNAME INX)))
|
||||
(T (BIN2 INX)
|
||||
(READNAME INX T]
|
||||
(6 (BIN2 INX)
|
||||
(BIN2 INX)
|
||||
(BIN2 INX)
|
||||
(READNAME INX T))
|
||||
(HELP))
|
||||
(GO LP))
|
||||
(CLOSEF MBFILE])
|
||||
|
||||
(READNAME
|
||||
[LAMBDA (J FLG) (* lmm "16-MAY-81 16:51")
|
||||
(bind EVENBYTE CH CHARS do (COND
|
||||
[(ZEROP (SETQ CH (\BIN J)))
|
||||
(RETURN (PROG1 (OR FLG (PACKC (DREVERSE CHARS)))
|
||||
(COND
|
||||
((NOT EVENBYTE)
|
||||
(\BIN J]
|
||||
(T (SETQ EVENBYTE (NOT EVENBYTE))
|
||||
(push CHARS CH])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(PLOTPCS
|
||||
[LAMBDA (ALLFLG) (* lmm "12-NOV-82 12:29")
|
||||
(PROG (NAME (INC 0)
|
||||
LASTPRINTEDNAME V CNTPERSTAR (BIGGEST 0)
|
||||
(2NDBIGGEST 0)
|
||||
(3RDBIGGEST 0)
|
||||
(TOTHI 0)
|
||||
(TOTLO 0)
|
||||
CUM HALFSTAR MAXSTARS LASTSTARPOS NSTARS TABPOS THRESHOLD TOTAL (CUHI 0)
|
||||
(CULO 0))
|
||||
(PRIN1 "Microcode PC Sample: ")
|
||||
[for I from 0 to (SUB1 IMSIZE) do (COND
|
||||
((NEQ (SETQ V (UPCCOUNT I))
|
||||
0)
|
||||
(add TOTHI (LRSH V 16))
|
||||
(add TOTLO (LOGAND V 65535))
|
||||
(COND
|
||||
((IGREATERP V 3RDBIGGEST)
|
||||
(COND
|
||||
[(IGREATERP V 2NDBIGGEST)
|
||||
(COND
|
||||
((IGREATERP V BIGGEST)
|
||||
(SETQ BIGGEST V))
|
||||
(T (SETQ 2NDBIGGEST V]
|
||||
(T (SETQ 3RDBIGGEST V]
|
||||
(* Each line has (NAME 14) (+nnn 4)
|
||||
(%| 1) stars ((nn.nnnn%%) 10) + 2 for luck)
|
||||
(SETQ MAXSTARS (IDIFFERENCE [SETQ LASTSTARPOS (IDIFFERENCE (LINELENGTH)
|
||||
(COND
|
||||
(ALLFLG 20)
|
||||
(T 12]
|
||||
20))
|
||||
(SETQ CNTPERSTAR (IQUOTIENT 3RDBIGGEST MAXSTARS))
|
||||
(SETQ HALFSTAR (IQUOTIENT CNTPERSTAR 2))
|
||||
(SETQ TOTAL (FPLUS TOTLO (FTIMES TOTHI 65536.0)))
|
||||
[SETQ THRESHOLD (COND
|
||||
(ALLFLG 0)
|
||||
(T (IMAX HALFSTAR (FIX (QUOTIENT (TIMES UPCTHRESHOLD CNTPERSTAR)
|
||||
TOTAL]
|
||||
(SETQ TOTAL (FQUOTIENT TOTAL 100.0))
|
||||
(printout NIL " Each * = " CNTPERSTAR " count, or " .F8.2 (FQUOTIENT CNTPERSTAR TOTAL)
|
||||
"%%")
|
||||
[for VPC from 0 to (SUB1 IMSIZE)
|
||||
do [COND
|
||||
((SETQ V (FASTELT VIRTONAME VPC))
|
||||
(SETQ NAME V)
|
||||
(SETQ INC 0))
|
||||
(T (SETQ INC (ADD1 INC]
|
||||
(SETQ V (UPCCOUNT (FASTELTW VIRTOREAL VPC)))
|
||||
(COND
|
||||
(ALLFLG (COND
|
||||
[(NEQ NAME LASTPRINTEDNAME)
|
||||
(COND
|
||||
(LASTPRINTEDNAME (* don't do it the first time)
|
||||
(TAB LASTSTARPOS)
|
||||
(PRINTCUMULATIVEPERCENT)))
|
||||
(TERPRI)
|
||||
(PRIN1 (COND
|
||||
((IGREATERP (SETQ TABPOS (NCHARS (SETQ LASTPRINTEDNAME NAME)))
|
||||
14)
|
||||
(SUBSTRING NAME 1 (SETQ TABPOS 14)))
|
||||
(T NAME]
|
||||
(T (TERPRI)
|
||||
(SPACES TABPOS)))
|
||||
(add CUHI (LRSH V 16))
|
||||
(add CULO (LOGAND V 65535))
|
||||
(COND
|
||||
((NEQ INC 0)
|
||||
(printout NIL "+" .I3...T INC)))
|
||||
(TAB 18)
|
||||
(printout NIL "#" .I8.4 (FASTELTW VIRTOREAL VPC)
|
||||
" " .I10 V))
|
||||
((IGREATERP V THRESHOLD)
|
||||
(COND
|
||||
[(NEQ NAME LASTPRINTEDNAME)
|
||||
(COND
|
||||
(LASTPRINTEDNAME (* don't do it the first time)
|
||||
(TAB LASTSTARPOS)
|
||||
(PRINTCUMULATIVEPERCENT)))
|
||||
(TERPRI)
|
||||
(PRIN1 (COND
|
||||
((IGREATERP (SETQ TABPOS (NCHARS (SETQ LASTPRINTEDNAME NAME)))
|
||||
14)
|
||||
(SUBSTRING NAME 1 (SETQ TABPOS 14)))
|
||||
(T NAME]
|
||||
(T (TERPRI)
|
||||
(SPACES TABPOS)))
|
||||
(add CUHI (LRSH V 16))
|
||||
(add CULO (LOGAND V 65535))
|
||||
(COND
|
||||
((NEQ INC 0)
|
||||
(printout NIL "+" .I3...T INC)))
|
||||
(TAB 18)
|
||||
(PRIN1 "|")
|
||||
(FRPTQ (COND
|
||||
((IGEQ (SETQ NSTARS (IQUOTIENT (IPLUS V HALFSTAR)
|
||||
CNTPERSTAR))
|
||||
MAXSTARS)
|
||||
(printout NIL "(" .I4 NSTARS ")")
|
||||
(IDIFFERENCE MAXSTARS 6))
|
||||
(T NSTARS))
|
||||
(PRIN1 "*"]
|
||||
(TAB LASTSTARPOS)
|
||||
(PRINTCUMULATIVEPERCENT)
|
||||
(TERPRI)
|
||||
(SETQ CUHI (IDIFFERENCE TOTHI CUHI))
|
||||
(SETQ CULO (IDIFFERENCE TOTLO CULO))
|
||||
(printout NIL T T "Not shown: ")
|
||||
(PRINTCUMULATIVEPERCENT)
|
||||
(TERPRI])
|
||||
)
|
||||
|
||||
(RPAQ? STATSBUFFER )
|
||||
|
||||
(RPAQ? VIRTOREAL )
|
||||
|
||||
(RPAQ? VIRTONAME )
|
||||
|
||||
(RPAQ UPCTHRESHOLD 0 (* lower threshold for percentage to show up on Microcode PC Sample histogram))
|
||||
(DECLARE: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS BIN2 MACRO ((INX)
|
||||
(IPLUS (LLSH (\BIN INX)
|
||||
8)
|
||||
(\BIN INX))))
|
||||
|
||||
(PUTPROPS UPCCOUNT MACRO [OPENLAMBDA (N)
|
||||
(\MAKENUMBER (\GETBASE STATSBUFFER (ADD1 (LLSH N 1)))
|
||||
(\GETBASE STATSBUFFER (LLSH N 1])
|
||||
)
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (698 2431 (GATHERUPCSTATS 708 . 1305) (PRINTCUMULATIVEPERCENT 1307 . 1533) (PRINTUPC
|
||||
1535 . 1979) (UPCSTATS 1981 . 2429)) (2432 4989 (READMBFILE 2442 . 4644) (READNAME 4646 . 4987)) (4990
|
||||
8641 (PLOTPCS 5000 . 8639)))))
|
||||
STOP
|
||||
Binary file not shown.
Reference in New Issue
Block a user