Compare commits
4 Commits
medley-260
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
4de89a6e94 | ||
|
ceccadacef | ||
|
|
6159c64b84 | ||
|
|
eb6ee87170 |
@@ -1,16 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "20-Feb-2024 23:45:56" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4 18445
|
||||
(FILECREATED " 2-May-2026 17:38:46" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;4 18684
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS DUMPDB)
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-2024 16:29:44" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
|
||||
:PREVIOUS-DATE "29-Apr-2026 17:43:56" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;2
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||
@@ -164,7 +165,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 20-Feb-2024 23:45 by mth")
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 2-May-2026 17:32 by mth")
|
||||
(* ; "Edited 29-Apr-2026 17:42 by mth")
|
||||
(* ; "Edited 20-Feb-2024 23:45 by mth")
|
||||
(* ; "Edited 7-Feb-2024 18:26 by mth")
|
||||
(* ; "Edited 27-Oct-2021 10:51 by larry")
|
||||
(* ; "Edited 24-Oct-2021 16:24 by rmk:")
|
||||
@@ -180,7 +183,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
|
||||
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
|
||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
|
||||
(FNS (FILEFNSLST FILE)))
|
||||
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
||||
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
||||
@@ -230,7 +233,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
(PRETTYDEF NIL DBFN
|
||||
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
|
||||
(ERROR!)))
|
||||
(E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
|
||||
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
|
||||
(DUMPDATABASE ',FNS]
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
@@ -375,9 +378,9 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024 2026))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
|
||||
. 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB
|
||||
11875 . 16750) (MAKEDB 16752 . 17836)))))
|
||||
(FILEMAP (NIL (1783 6808 (DBFILE 1793 . 3438) (DBFILE1 3440 . 4950) (DBFILE2 4952 . 6174) (LOAD 6176
|
||||
. 6406) (LOADFROM 6408 . 6596) (MAKEFILE 6598 . 6806)) (6864 18072 (DUMPDB 6874 . 12107) (LOADDB
|
||||
12109 . 16984) (MAKEDB 16986 . 18070)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "31-Mar-2026 10:50:22" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;287 138875
|
||||
(FILECREATED "28-Apr-2026 23:41:24" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;289 139726
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS CDBROWSER-COPY)
|
||||
:CHANGES-TO (FNS CDFILES.PATS CDFILES.MATCH CDBROWSER-COPY)
|
||||
|
||||
:PREVIOUS-DATE "10-Feb-2026 21:28:55" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;286)
|
||||
:PREVIOUS-DATE "28-Apr-2026 21:38:49" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;288)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
@@ -507,32 +507,37 @@
|
||||
UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME])
|
||||
|
||||
(CDFILES.MATCH
|
||||
[LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 26-Jan-2022 15:33 by rmk")
|
||||
[LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 28-Apr-2026 23:40 by rmk")
|
||||
(* ; "Edited 26-Jan-2022 15:33 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 21:47 by rmk")
|
||||
(thereis P in PATTERNS suchthat
|
||||
|
||||
(* ;; "True if the components of the fullname match at least one of the patterns")
|
||||
(* ;; "The SUBDIR test is tricky. If the exclusion pattern was internal/fonts/**, this shows up as (* * internal/fonts 65535), it has to match internal/fonts/display/completed/. Below we test for an initial substring")
|
||||
|
||||
(THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P)
|
||||
FILEDIRCASEARRAY)
|
||||
(EQ '* (CAR P))
|
||||
(AND (EQ (CHARCODE %.)
|
||||
(CHCON1 (CAR P)))
|
||||
(EQ (CHARCODE %.)
|
||||
(CHCON1 NAME))
|
||||
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
||||
2))
|
||||
(EQ (CHARCODE *)
|
||||
(NTHCHARCODE (CAR P)
|
||||
2]
|
||||
(OR (STRING.EQUAL EXT (CADR P))
|
||||
(EQ '* (CADR P)))
|
||||
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
||||
(NULL (CADDR P))
|
||||
(EQ '* (CADDR P)))
|
||||
(ILEQ THISDEPTH (CADDDR P])
|
||||
(AND [OR (STRING.EQUAL NAME (CAR P)
|
||||
FILEDIRCASEARRAY)
|
||||
(EQ '* (CAR P))
|
||||
(AND (EQ (CHARCODE %.)
|
||||
(CHCON1 (CAR P)))
|
||||
(EQ (CHARCODE %.)
|
||||
(CHCON1 NAME))
|
||||
(OR (STRING.EQUAL NAME (SUBATOM (CAR P)
|
||||
2))
|
||||
(EQ (CHARCODE *)
|
||||
(NTHCHARCODE (CAR P)
|
||||
2]
|
||||
(OR (STRING.EQUAL EXT (CADR P))
|
||||
(EQ '* (CADR P)))
|
||||
(ILEQ THISDEPTH (CADDDR P))
|
||||
(OR (STRING.EQUAL SUBDIR (CADDR P))
|
||||
(NULL (CADDR P))
|
||||
(EQ '* (CADDR P))
|
||||
(STRPOS (CADDR P)
|
||||
SUBDIR 1 NIL T])
|
||||
|
||||
(CDFILES.PATS
|
||||
[LAMBDA (PATTERNS) (* ; "Edited 17-Jun-2023 23:36 by rmk")
|
||||
[LAMBDA (PATTERNS) (* ; "Edited 28-Apr-2026 23:01 by rmk")
|
||||
(* ; "Edited 17-Jun-2023 23:36 by rmk")
|
||||
(* ; "Edited 23-Dec-2021 17:02 by rmk")
|
||||
|
||||
(* ;; "Returns (NAME EXT SUBDIR DEPTH) items where NAME or EXT may be the wildcard *, SD is the subdirectory (if any) and DEPTH is the number of / or > in the subdirectory")
|
||||
@@ -544,15 +549,15 @@
|
||||
(* * NIL 1)
|
||||
)
|
||||
ELSE (FOR P N E SD DEPTH UNPACK INSIDE PATTERNS
|
||||
JOIN (SETQ UNPACK (UNPACKFILENAME.STRING P)) (* ;
|
||||
JOIN (SETQ UNPACK (UNPACKFILENAME P)) (* ;
|
||||
"String so we can tell the difference between x and x.")
|
||||
[SETQ SD (MKATOM (LISTGET UNPACK 'SUBDIRECTORY]
|
||||
(SETQ SD (LISTGET UNPACK 'SUBDIRECTORY))
|
||||
|
||||
(* ;; "Count the subdirectory depth")
|
||||
|
||||
[SETQ DEPTH (IF (EQ SD '*)
|
||||
THEN MAX.SMALLP
|
||||
ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I)
|
||||
[SETQ DEPTH (if (EQ SD '*)
|
||||
then MAX.SMALLP
|
||||
else (for I (CNT _ 1) from 1 do (SELCHARQ (NTHCHARCODE SD I)
|
||||
((/ >)
|
||||
(ADD CNT 1))
|
||||
(NIL (RETURN CNT))
|
||||
@@ -560,28 +565,31 @@
|
||||
(SETQ N (LISTGET UNPACK 'NAME))
|
||||
(SETQ N (if (NULL N)
|
||||
then '*
|
||||
elseif (EQ N '**)
|
||||
then (SETQ DEPTH MAX.SMALLP)
|
||||
'*
|
||||
elseif (NEQ 0 (NCHARS N))
|
||||
then (MKATOM N)))
|
||||
then N))
|
||||
(SETQ E (LISTGET UNPACK 'EXTENSION))
|
||||
(SETQ E (if (NULL E)
|
||||
then '*
|
||||
elseif (NEQ 0 (NCHARS E))
|
||||
then (MKATOM E)))
|
||||
(if [OR (AND (STRING.EQUAL N 'COM)
|
||||
then E))
|
||||
(if [OR (AND (EQ N 'COM)
|
||||
(NULL E))
|
||||
(AND (STRING.EQUAL E 'COM)
|
||||
(AND (EQ E 'COM)
|
||||
(MEMB N ' (* NIL)]
|
||||
THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD DEPTH))
|
||||
ELSE (CONS (IF N
|
||||
THEN (LIST N E SD DEPTH)
|
||||
ELSEIF E
|
||||
THEN
|
||||
then (for CE in *COMPILED-EXTENSIONS* collect (LIST '* CE SD DEPTH))
|
||||
else (CONS (if N
|
||||
then (LIST N E SD DEPTH)
|
||||
elseif E
|
||||
then
|
||||
|
||||
(* ;; "This is the case .XXX, which presumably identifies a dotted file. If this is supposed to be all files with extension XXX, it shoud be specified as *.XXX, the case above. So we move .E into the N field.")
|
||||
|
||||
(LIST (PACK* '%. E)
|
||||
NIL SD DEPTH)
|
||||
ELSE `
|
||||
else `
|
||||
|
||||
(* * (\, SD) (\, DEPTH))
|
||||
])
|
||||
@@ -2146,7 +2154,8 @@
|
||||
NIL])
|
||||
|
||||
(CDBROWSER-COPY
|
||||
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 31-Mar-2026 10:49 by rmk")
|
||||
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Apr-2026 18:54 by rmk")
|
||||
(* ; "Edited 31-Mar-2026 10:49 by rmk")
|
||||
(* ; "Edited 28-Oct-2025 17:39 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
||||
(* ; "Edited 24-May-2022 15:49 by rmk")
|
||||
@@ -2185,7 +2194,8 @@
|
||||
(PRIN3 "No source file to copy" T)
|
||||
(RETURN NIL))
|
||||
(CL:WHEN [AND (EQ DATERELBAD (FETCH (CDENTRY DATEREL) OF CDENTRY))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(PROGN (GIVE.TTY.PROCESS T)
|
||||
(FLASHWINDOW T)
|
||||
(EQ 'N (ASKUSER NIL NIL
|
||||
"Target is newer than source. Really copy? "]
|
||||
(RETURN NIL))
|
||||
@@ -2195,6 +2205,7 @@
|
||||
))
|
||||
'VERSION))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(GIVE.TTY.PROCESS T)
|
||||
(EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE
|
||||
" is not the newest version. Really copy? "
|
||||
]
|
||||
@@ -2326,25 +2337,25 @@
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2658 23637 (COMPAREDIRECTORIES 2668 . 8003) (COMPAREDIRECTORIES.INFOS 8005 . 11234) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11236 . 14621) (CDENTRIES.SELECT 14623 . 19525) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19527 . 20871) (MATCHNAME 20873 . 21553) (CD.INSURECDVALUE 21555 . 23169
|
||||
) (CD.UPDATEWIDTHS 23171 . 23635)) (23638 34343 (CDFILES 23648 . 29745) (CDFILES.MATCH 29747 . 31372)
|
||||
(CDFILES.PATS 31374 . 34341)) (34344 52362 (CDPRINT 34354 . 36871) (CDPRINT.HEADER 36873 . 37770) (
|
||||
CDPRINT.LINE 37772 . 41201) (CDPRINT.MAXWIDTHS 41203 . 45318) (CDPRINT.COLHEADERS 45320 . 46605) (
|
||||
CDPRINT.COLUMNS 46607 . 51727) (CDTEDIT 51729 . 52360)) (52363 61484 (CDMAP 52373 . 53805) (CDENTRY
|
||||
53807 . 54116) (CDSUBSET 54118 . 55557) (CDMERGE 55559 . 59543) (CDMERGE.COMMON 59545 . 60860) (
|
||||
CD.SORT 60862 . 61482)) (61485 69023 (BINCOMP 61495 . 65784) (EOLTYPE 65786 . 68348) (EOLTYPE.SHOW
|
||||
68350 . 69021)) (69551 82078 (FIND-UNCOMPILED-FILES 69561 . 73204) (FIND-UNSOURCED-FILES 73206 . 75590
|
||||
) (FIND-SOURCE-FILES 75592 . 77330) (FIND-COMPILED-FILES 77332 . 79209) (FIND-UNLOADED-FILES 79211 .
|
||||
80064) (FIND-LOADED-FILES 80066 . 80494) (FIND-MULTICOMPILED-FILES 80496 . 82076)) (82079 90510 (
|
||||
CREATED-AS 82089 . 86886) (SOURCE-FOR-COMPILED-P 86888 . 89815) (COMPILE-SOURCE-DATE-DIFF 89817 .
|
||||
90508)) (90511 101274 (FIX-DIRECTORY-DATES 90521 . 93971) (FIX-EQUIV-DATES 93973 . 95498) (
|
||||
COPY-COMPARED-FILES 95500 . 97321) (COPY-MISSING-FILES 97323 . 99480) (COMPILED-ON-SAME-SOURCE 99482
|
||||
. 101272)) (101468 109346 (CDBROWSER 101478 . 105445) (CDBROWSER.STRINGS 105447 . 109344)) (109508
|
||||
111244 (CD.TABLEITEM 109518 . 109738) (CD.TABLEITEM.PRINTFN 109740 . 109939) (CD.TABLEITEM.COPYFN
|
||||
109941 . 110999) (CDTABLEBROWSER.HEADING.REPAINTFN 111001 . 111242)) (111245 138359 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 111255 . 111723) (CD.COMMANDSELECTEDFN 111725 . 117898) (CD-MENUFN
|
||||
117900 . 124377) (CD-COMPARE-FILES 124379 . 127906) (CDBROWSER-COPY 127908 . 133233) (
|
||||
CDBROWSER-DELETE-FILE 133235 . 137838) (CD-SWAPDIRS 137840 . 138357)))))
|
||||
(FILEMAP (NIL (2683 23662 (COMPAREDIRECTORIES 2693 . 8028) (COMPAREDIRECTORIES.INFOS 8030 . 11259) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 11261 . 14646) (CDENTRIES.SELECT 14648 . 19550) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 19552 . 20896) (MATCHNAME 20898 . 21578) (CD.INSURECDVALUE 21580 . 23194
|
||||
) (CD.UPDATEWIDTHS 23196 . 23660)) (23663 34971 (CDFILES 23673 . 29770) (CDFILES.MATCH 29772 . 31782)
|
||||
(CDFILES.PATS 31784 . 34969)) (34972 52990 (CDPRINT 34982 . 37499) (CDPRINT.HEADER 37501 . 38398) (
|
||||
CDPRINT.LINE 38400 . 41829) (CDPRINT.MAXWIDTHS 41831 . 45946) (CDPRINT.COLHEADERS 45948 . 47233) (
|
||||
CDPRINT.COLUMNS 47235 . 52355) (CDTEDIT 52357 . 52988)) (52991 62112 (CDMAP 53001 . 54433) (CDENTRY
|
||||
54435 . 54744) (CDSUBSET 54746 . 56185) (CDMERGE 56187 . 60171) (CDMERGE.COMMON 60173 . 61488) (
|
||||
CD.SORT 61490 . 62110)) (62113 69651 (BINCOMP 62123 . 66412) (EOLTYPE 66414 . 68976) (EOLTYPE.SHOW
|
||||
68978 . 69649)) (70179 82706 (FIND-UNCOMPILED-FILES 70189 . 73832) (FIND-UNSOURCED-FILES 73834 . 76218
|
||||
) (FIND-SOURCE-FILES 76220 . 77958) (FIND-COMPILED-FILES 77960 . 79837) (FIND-UNLOADED-FILES 79839 .
|
||||
80692) (FIND-LOADED-FILES 80694 . 81122) (FIND-MULTICOMPILED-FILES 81124 . 82704)) (82707 91138 (
|
||||
CREATED-AS 82717 . 87514) (SOURCE-FOR-COMPILED-P 87516 . 90443) (COMPILE-SOURCE-DATE-DIFF 90445 .
|
||||
91136)) (91139 101902 (FIX-DIRECTORY-DATES 91149 . 94599) (FIX-EQUIV-DATES 94601 . 96126) (
|
||||
COPY-COMPARED-FILES 96128 . 97949) (COPY-MISSING-FILES 97951 . 100108) (COMPILED-ON-SAME-SOURCE 100110
|
||||
. 101900)) (102096 109974 (CDBROWSER 102106 . 106073) (CDBROWSER.STRINGS 106075 . 109972)) (110136
|
||||
111872 (CD.TABLEITEM 110146 . 110366) (CD.TABLEITEM.PRINTFN 110368 . 110567) (CD.TABLEITEM.COPYFN
|
||||
110569 . 111627) (CDTABLEBROWSER.HEADING.REPAINTFN 111629 . 111870)) (111873 139210 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 111883 . 112351) (CD.COMMANDSELECTEDFN 112353 . 118526) (CD-MENUFN
|
||||
118528 . 125005) (CD-COMPARE-FILES 125007 . 128534) (CDBROWSER-COPY 128536 . 134084) (
|
||||
CDBROWSER-DELETE-FILE 134086 . 138689) (CD-SWAPDIRS 138691 . 139208)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
165
lispusers/GITFNS
165
lispusers/GITFNS
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "16-Mar-2026 12:05:55" {WMEDLEY}<lispusers>GITFNS.;578 134065
|
||||
(FILECREATED "29-Apr-2026 12:51:53" {MEDLEY}<lispusers>GITFNS.;592 137200
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-BRANCH-WHENSELECTEDFN PRC-COMMAND)
|
||||
:CHANGES-TO (FNS GIT-GWC-COMMAND)
|
||||
(COMMANDS gwc)
|
||||
(VARS GITFNSCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 2-Mar-2026 14:00:13" {WMEDLEY}<lispusers>GITFNS.;576)
|
||||
:PREVIOUS-DATE "29-Apr-2026 09:00:33" {MEDLEY}<lispusers>GITFNS.;588)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -51,7 +53,7 @@
|
||||
(INITVARS (GIT-MERGE-COMPARES T)
|
||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
||||
(FNS PRC-COMMAND)
|
||||
(FNS PRC-COMMAND GIT-GWC-COMMAND)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -60,7 +62,7 @@
|
||||
|
||||
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
|
||||
(FNS TOGIT FROMGIT)
|
||||
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||
(FNS WORKINGSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
||||
|
||||
(* ;; "")
|
||||
@@ -169,6 +171,9 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 29-Apr-2026 09:00 by rmk")
|
||||
(* ; "Edited 17-Apr-2026 12:33 by rmk")
|
||||
(* ; "Edited 15-Apr-2026 16:33 by rmk")
|
||||
(* ; "Edited 25-Feb-2026 23:25 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 16:53 by rmk")
|
||||
(* ; "Edited 22-Oct-2025 12:45 by rmk")
|
||||
@@ -275,7 +280,8 @@
|
||||
"for " PROJECTNAME]
|
||||
(SETQ PROJECT (create GIT-PROJECT
|
||||
PROJECTNAME ← PROJECTNAME
|
||||
GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
GITHOST ← (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
|
||||
CLONEPATH)
|
||||
"}")
|
||||
WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
PROJECTNAME)
|
||||
@@ -439,18 +445,7 @@
|
||||
|
||||
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
|
||||
|
||||
(DEFCOMMAND gwc (SUBDIR . OTHERS)
|
||||
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project")
|
||||
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
PROJECT)
|
||||
(SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL)
|
||||
NIL T)
|
||||
THEN (SETQ PROJECT (CAR STAIL))
|
||||
(GO $$OUT))
|
||||
(CAR STAIL)))
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
|
||||
(DEFCOMMAND gwc (SUBDIR . OTHERS) (GIT-GWC-COMMAND SUBDIR OTHERS))
|
||||
|
||||
(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
|
||||
|
||||
@@ -616,6 +611,32 @@
|
||||
PROJECT))
|
||||
else (CONCAT "No open " (OR REMOTEBRANCH "")
|
||||
" pull requests"])
|
||||
|
||||
(GIT-GWC-COMMAND
|
||||
[LAMBDA (SUBDIR OTHERS) (* ; "Edited 29-Apr-2026 12:51 by rmk")
|
||||
|
||||
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project, which may be followed by - and some excluded files")
|
||||
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
EXCLUDEDFILES PROJECT)
|
||||
(SETQ SUBDIRS (for STAIL on SUBDIRS unless (CL:WHEN (AND (NULL PROJECT)
|
||||
(SETQ PROJECT (GIT-GET-PROJECT
|
||||
(CAR STAIL)
|
||||
NIL T)))
|
||||
(CL:UNLESS (EQ '- (CADR STAIL))
|
||||
(RETURN $$VAL))
|
||||
T) collect (CL:WHEN (EQ '- (CAR STAIL))
|
||||
(SETQ EXCLUDEDFILES
|
||||
(CDR STAIL))
|
||||
(RETURN $$VAL))
|
||||
(CAR STAIL)))
|
||||
(CL:UNLESS PROJECT
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT)))
|
||||
(if (AND (fetch GITHOST of PROJECT)
|
||||
(fetch WHOST of PROJECT))
|
||||
then (GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL EXCLUDEDFILES NIL T PROJECT)
|
||||
else (PRINTOUT T "gwc requires " (fetch PROJECTNAME of PROJECT)
|
||||
" to have both git and working directories" T T])
|
||||
)
|
||||
|
||||
|
||||
@@ -727,7 +748,7 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MYMEDLEYSUBDIR
|
||||
(WORKINGSUBDIR
|
||||
[LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 7-May-2022 23:15 by rmk")
|
||||
(UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT)
|
||||
@@ -1398,13 +1419,12 @@
|
||||
" branches"])
|
||||
|
||||
(GIT-BRANCH-MENU
|
||||
[LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 1-May-2024 14:36 by rmk")
|
||||
[LAMBDA (BRANCHES TITLE) (* ; "Edited 18-Apr-2026 21:36 by rmk")
|
||||
(* ; "Edited 1-May-2024 14:36 by rmk")
|
||||
(* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(create MENU
|
||||
TITLE ← (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
@@ -1950,6 +1970,8 @@
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 29-Apr-2026 08:46 by rmk")
|
||||
|
||||
(* ;; "Edited 28-Oct-2025 14:00 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Oct-2025 23:32 by rmk")
|
||||
@@ -1960,18 +1982,12 @@
|
||||
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
|
||||
(* ;; "Edited 10-May-2022 10:41 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
|
||||
|
||||
@@ -1991,7 +2007,8 @@
|
||||
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
"ALL subdirectories"
|
||||
else SUBDIRS)))
|
||||
else SUBDIRS))
|
||||
(EXCLUSIONS))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
T)))
|
||||
(NENTRIES ← 0)
|
||||
@@ -1999,11 +2016,12 @@
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (WORKINGSUBDIR SUBDIR T PROJECT)
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
'(*.* *>*.* .* *>.*)
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
(for E DPOS in (APPEND (MKLIST EXCLUDEDFILES)
|
||||
(GIT-GET-PROJECT PROJECT 'EXCLUSIONS))
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
'DIRECTORY)
|
||||
1 NIL T T FILEDIRCASEARRAY))
|
||||
@@ -2216,7 +2234,7 @@
|
||||
(OR LABEL2 FILE2])
|
||||
|
||||
(GIT-CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 by rmk")
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:30 by rmk")
|
||||
(* ; "Edited 25-Oct-2025 23:44 by rmk")
|
||||
(* ; "Edited 21-Sep-2022 21:34 by rmk")
|
||||
(* ; "Edited 22-May-2022 19:13 by rmk")
|
||||
@@ -2225,9 +2243,32 @@
|
||||
|
||||
(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom")
|
||||
|
||||
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW))
|
||||
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA))
|
||||
(SELECTQ (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM))
|
||||
(Delete% -> (FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "]
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T)))
|
||||
(|Delete ALL <-|
|
||||
(FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(if (NAMEFIELD LABEL1 T)
|
||||
then (CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of "
|
||||
(NAMEFIELD LABEL1 T)
|
||||
" ? "]
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T))
|
||||
else (PRINTOUT T "Nothing to delete")))
|
||||
(Delete% BOTH (FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT
|
||||
"Delete all Medley and git versions of "
|
||||
(NAMEFIELD LABEL1 T)
|
||||
" ? ")))
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T)
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T T)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
|
||||
(SHOULDNT])
|
||||
|
||||
@@ -2429,33 +2470,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4197 21075 (GIT-CLONEP 4207 . 5638) (GIT-INIT 5640 . 6270) (GIT-MAKE-PROJECT 6272 .
|
||||
14129) (GIT-GET-PROJECT 14131 . 16056) (GIT-PUT-PROJECT-FIELD 16058 . 17699) (GIT-PROJECT-PATH 17701
|
||||
. 18745) (FIND-ANCESTOR-DIRECTORY 18747 . 19098) (GIT-FIND-CLONE 19100 . 20183) (GIT-MAINBRANCH 20185
|
||||
. 20580) (GIT-MAINBRANCH? 20582 . 21073)) (26538 31832 (PRC-COMMAND 26548 . 31830)) (31888 34676 (
|
||||
ALLSUBDIRS 31898 . 33184) (MEDLEYSUBDIRS 33186 . 33879) (GITSUBDIRS 33881 . 34674)) (34677 37082 (
|
||||
TOGIT 34687 . 36095) (FROMGIT 36097 . 37080)) (37083 40093 (MYMEDLEYSUBDIR 37093 . 37549) (GITSUBDIR
|
||||
37551 . 37994) (STRIPDIR 37996 . 38374) (STRIPHOST 38376 . 38616) (STRIPNAME 38618 . 39371) (
|
||||
STRIPWHERE 39373 . 40091)) (40094 42329 (GFILE4MFILE 40104 . 40800) (MFILE4GFILE 40802 . 41371) (
|
||||
GIT-REPO-FILENAME 41373 . 42327)) (42378 52635 (GIT-COMMIT 42388 . 43214) (GIT-PUSH 43216 . 43976) (
|
||||
GIT-PULL 43978 . 44730) (GIT-APPROVAL 44732 . 45081) (GIT-GET-FILE 45083 . 46998) (GIT-FILE-EXISTS?
|
||||
47000 . 47274) (GIT-REMOTE-UPDATE 47276 . 48111) (GIT-REMOTE-ADD 48113 . 48420) (GIT-FILE-DATE 48422
|
||||
. 49469) (GIT-FILE-HISTORY 49471 . 51405) (GIT-PRINT-FILE-HISTORY 51407 . 52459) (GIT-FETCH 52461 .
|
||||
52633)) (52665 64617 (GIT-BRANCH-DIFF 52675 . 59564) (GIT-COMMIT-DIFFS 59566 . 60457) (
|
||||
GIT-BRANCH-RELATIONS 60459 . 64143) (GIT-MODIFIED 64145 . 64615)) (64662 83597 (GIT-BRANCH-NUM 64672
|
||||
. 65245) (GIT-CHECKOUT 65247 . 66533) (GIT-WHICH-BRANCH 66535 . 66942) (GIT-MAKE-BRANCH 66944 . 69523
|
||||
) (GIT-BRANCHES 69525 . 72122) (GIT-BRANCH-EXISTS? 72124 . 72995) (GIT-PICK-BRANCH 72997 . 73487) (
|
||||
GIT-BRANCH-MENU 73489 . 74378) (GIT-BRANCH-WHENSELECTEDFN 74380 . 76087) (GIT-PULL-REQUESTS 76089 .
|
||||
79974) (GIT-SHORT-BRANCH-NAME 79976 . 80267) (GIT-LONG-NAME 80269 . 80586) (GIT-PRC-BRANCHES 80588 .
|
||||
83595)) (83627 88381 (GIT-MY-CURRENT-BRANCH 83637 . 84007) (GIT-MY-BRANCHP 84009 . 84627) (
|
||||
GIT-MY-NEXT-BRANCH 84629 . 86429) (GIT-MY-BRANCHES 86431 . 88379)) (88427 92511 (GIT-ADD-WORKTREE
|
||||
88437 . 90044) (GIT-REMOVE-WORKTREE 90046 . 90978) (GIT-LIST-WORKTREES 90980 . 91791) (WORKTREEDIR
|
||||
91793 . 92509)) (92559 125597 (GIT-GET-DIFFERENT-FILES 92569 . 99477) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 99479 . 107118) (GIT-WORKING-COMPARE-DIRECTORIES 107120 . 112922) (
|
||||
GIT-COMPARE-WORKTREE 112924 . 116902) (GITCDOBJBUTTONFN 116904 . 121402) (GIT-CD-LABELFN 121404 .
|
||||
122490) (GIT-CD-MENUFN 122492 . 123578) (GIT-WORKING-COMPARE-FILES 123580 . 124200) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124202 . 125366) (GIT-PR-COMPARE 125368 . 125595)) (125667 133998 (CDGITDIR
|
||||
125677 . 126364) (GIT-COMMAND 126366 . 127924) (GITORIGIN 127926 . 128623) (GIT-INITIALS 128625 .
|
||||
128929) (GIT-COMMAND-TO-FILE 128931 . 132416) (GIT-RESULT-TO-LINES 132418 . 133331) (STRIPLOCAL 133333
|
||||
. 133996)))))
|
||||
(FILEMAP (NIL (4257 21537 (GIT-CLONEP 4267 . 5698) (GIT-INIT 5700 . 6330) (GIT-MAKE-PROJECT 6332 .
|
||||
14591) (GIT-GET-PROJECT 14593 . 16518) (GIT-PUT-PROJECT-FIELD 16520 . 18161) (GIT-PROJECT-PATH 18163
|
||||
. 19207) (FIND-ANCESTOR-DIRECTORY 19209 . 19560) (GIT-FIND-CLONE 19562 . 20645) (GIT-MAINBRANCH 20647
|
||||
. 21042) (GIT-MAINBRANCH? 21044 . 21535)) (26309 33483 (PRC-COMMAND 26319 . 31601) (GIT-GWC-COMMAND
|
||||
31603 . 33481)) (33539 36327 (ALLSUBDIRS 33549 . 34835) (MEDLEYSUBDIRS 34837 . 35530) (GITSUBDIRS
|
||||
35532 . 36325)) (36328 38733 (TOGIT 36338 . 37746) (FROMGIT 37748 . 38731)) (38734 41743 (
|
||||
WORKINGSUBDIR 38744 . 39199) (GITSUBDIR 39201 . 39644) (STRIPDIR 39646 . 40024) (STRIPHOST 40026 .
|
||||
40266) (STRIPNAME 40268 . 41021) (STRIPWHERE 41023 . 41741)) (41744 43979 (GFILE4MFILE 41754 . 42450)
|
||||
(MFILE4GFILE 42452 . 43021) (GIT-REPO-FILENAME 43023 . 43977)) (44028 54285 (GIT-COMMIT 44038 . 44864)
|
||||
(GIT-PUSH 44866 . 45626) (GIT-PULL 45628 . 46380) (GIT-APPROVAL 46382 . 46731) (GIT-GET-FILE 46733 .
|
||||
48648) (GIT-FILE-EXISTS? 48650 . 48924) (GIT-REMOTE-UPDATE 48926 . 49761) (GIT-REMOTE-ADD 49763 .
|
||||
50070) (GIT-FILE-DATE 50072 . 51119) (GIT-FILE-HISTORY 51121 . 53055) (GIT-PRINT-FILE-HISTORY 53057 .
|
||||
54109) (GIT-FETCH 54111 . 54283)) (54315 66267 (GIT-BRANCH-DIFF 54325 . 61214) (GIT-COMMIT-DIFFS 61216
|
||||
. 62107) (GIT-BRANCH-RELATIONS 62109 . 65793) (GIT-MODIFIED 65795 . 66265)) (66312 85259 (
|
||||
GIT-BRANCH-NUM 66322 . 66895) (GIT-CHECKOUT 66897 . 68183) (GIT-WHICH-BRANCH 68185 . 68592) (
|
||||
GIT-MAKE-BRANCH 68594 . 71173) (GIT-BRANCHES 71175 . 73772) (GIT-BRANCH-EXISTS? 73774 . 74645) (
|
||||
GIT-PICK-BRANCH 74647 . 75137) (GIT-BRANCH-MENU 75139 . 76040) (GIT-BRANCH-WHENSELECTEDFN 76042 .
|
||||
77749) (GIT-PULL-REQUESTS 77751 . 81636) (GIT-SHORT-BRANCH-NAME 81638 . 81929) (GIT-LONG-NAME 81931 .
|
||||
82248) (GIT-PRC-BRANCHES 82250 . 85257)) (85289 90043 (GIT-MY-CURRENT-BRANCH 85299 . 85669) (
|
||||
GIT-MY-BRANCHP 85671 . 86289) (GIT-MY-NEXT-BRANCH 86291 . 88091) (GIT-MY-BRANCHES 88093 . 90041)) (
|
||||
90089 94173 (GIT-ADD-WORKTREE 90099 . 91706) (GIT-REMOVE-WORKTREE 91708 . 92640) (GIT-LIST-WORKTREES
|
||||
92642 . 93453) (WORKTREEDIR 93455 . 94171)) (94221 128732 (GIT-GET-DIFFERENT-FILES 94231 . 101139) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 101141 . 108780) (GIT-WORKING-COMPARE-DIRECTORIES 108782 . 114597) (
|
||||
GIT-COMPARE-WORKTREE 114599 . 118577) (GITCDOBJBUTTONFN 118579 . 123077) (GIT-CD-LABELFN 123079 .
|
||||
124165) (GIT-CD-MENUFN 124167 . 126713) (GIT-WORKING-COMPARE-FILES 126715 . 127335) (
|
||||
GIT-BRANCHES-COMPARE-FILES 127337 . 128501) (GIT-PR-COMPARE 128503 . 128730)) (128802 137133 (CDGITDIR
|
||||
128812 . 129499) (GIT-COMMAND 129501 . 131059) (GITORIGIN 131061 . 131758) (GIT-INITIALS 131760 .
|
||||
132064) (GIT-COMMAND-TO-FILE 132066 . 135551) (GIT-RESULT-TO-LINES 135553 . 136466) (STRIPLOCAL 136468
|
||||
. 137131)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED "27-Jan-2026 13:21:10" {WMEDLEY}<lispusers>HELPSYS.;21 88654
|
||||
(FILECREATED "20-Apr-2026 08:07:50" {MEDLEY}<lispusers>HELPSYS.;24 89018
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DOCS.LOOKUP GENERIC.MAN.LOOKUP)
|
||||
(VARS HELPSYSCOMS)
|
||||
:CHANGES-TO (FNS REPO.LOOKUP)
|
||||
|
||||
:PREVIOUS-DATE " 5-May-2025 22:04:32" {WMEDLEY}<lispusers>HELPSYS.;15)
|
||||
:PREVIOUS-DATE "27-Jan-2026 13:21:10" {MEDLEY}<lispusers>HELPSYS.;21)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||
@@ -340,21 +339,27 @@
|
||||
else "git web--browse"])
|
||||
|
||||
(REPO.LOOKUP
|
||||
[LAMBDA (ENTRY TYPES) (* ; "Edited 13-Jan-2023 10:46 by lmm")
|
||||
[LAMBDA (ENTRY TYPES) (* ; "Edited 20-Apr-2026 08:06 by rmk")
|
||||
(* ; "Edited 13-Jan-2023 10:46 by lmm")
|
||||
(* ; "Edited 16-Aug-2022 16:26 by lmm")
|
||||
(for FL in (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
|
||||
T)
|
||||
(LIST ENTRY)) bind POS FND
|
||||
(for FL POS FND TSTREAM in (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
|
||||
T)
|
||||
(LIST ENTRY))
|
||||
when [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
|
||||
(AND (SETQ POS (STRPOS "-" FL))
|
||||
(FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
|
||||
NIL
|
||||
'(TEDIT TXT TTY TED]
|
||||
join (CL:WITH-OPEN-FILE (STR (PATHNAME FND)
|
||||
:DIRECTION :INPUT)
|
||||
(CL:WHEN (SETQ POS (FFILEPOS ENTRY STR))
|
||||
(TEDIT-SEE STR NIL NIL (CL:FORMAT NIL "~a [~a]" FL ENTRY))
|
||||
(LIST FL))])
|
||||
collect (SETQ TSTREAM (OPENTEXTSTREAM FND))
|
||||
[TEDIT TSTREAM NIL NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE
|
||||
,(CL:IF (EQ FL ENTRY)
|
||||
FL
|
||||
(CONCAT ENTRY " on " FL))]
|
||||
(CL:UNLESS (EQ FL ENTRY)
|
||||
(CL:WHEN (SETQ POS (TEDIT.FIND TSTREAM ENTRY))
|
||||
(TEDIT.SETSEL TSTREAM POS (NCHARS ENTRY))
|
||||
(TEDIT.NORMALIZECARET TSTREAM)))
|
||||
FL])
|
||||
)
|
||||
|
||||
(RPAQQ CLHS.INDEX
|
||||
@@ -1716,14 +1721,14 @@
|
||||
|
||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4640 10992 (HELPSYS 4650 . 6491) (IRM.LOOKUP 6493 . 8131) (GENERIC.MAN.LOOKUP 8133 .
|
||||
10001) (IRM.SMART.LOOKUP 10003 . 10159) (IRM.RESET 10161 . 10570) (DOCS.LOOKUP 10572 . 10990)) (11249
|
||||
18568 (CLHS.INDEX 11259 . 14223) (CLHS.LOOKUP 14225 . 16231) (CLHS.OPENER 16233 . 17556) (REPO.LOOKUP
|
||||
17558 . 18566)) (71663 73181 (IRM.GET.DINFOGRAPH 71673 . 72548) (IRM.DISPLAY.REF 72550 . 73179)) (
|
||||
73183 73545 (IRM.LOAD-GRAPH 73183 . 73545)) (73870 79374 (IRM.DISPLAY.CREF 73880 . 75594) (
|
||||
IRM.CREF.BOX 75596 . 76423) (IRM.PUT.CREF 76425 . 76650) (IRM.GET.CREF 76652 . 77023) (
|
||||
IRM.CREF.BUTTONEVENTFN 77025 . 79372)) (79929 88235 (\IRM.GET.REF 79939 . 81270) (\IRM.SMART.REF 81272
|
||||
. 83199) (\IRM.CHOOSE.REF 83201 . 84452) (\IRM.WILD.REF 84454 . 85709) (\IRM.WILDCARD 85711 . 86077)
|
||||
(\IRM.WILD.MATCH 86079 . 87309) (\IRM.GET.HASHFILE 87311 . 87774) (\IRM.GET.KEYWORDS 87776 . 88233)) (
|
||||
88372 88528 (\IRM.AROUND-EXIT 88372 . 88528)))))
|
||||
(FILEMAP (NIL (4582 10934 (HELPSYS 4592 . 6433) (IRM.LOOKUP 6435 . 8073) (GENERIC.MAN.LOOKUP 8075 .
|
||||
9943) (IRM.SMART.LOOKUP 9945 . 10101) (IRM.RESET 10103 . 10512) (DOCS.LOOKUP 10514 . 10932)) (11191
|
||||
18932 (CLHS.INDEX 11201 . 14165) (CLHS.LOOKUP 14167 . 16173) (CLHS.OPENER 16175 . 17498) (REPO.LOOKUP
|
||||
17500 . 18930)) (72027 73545 (IRM.GET.DINFOGRAPH 72037 . 72912) (IRM.DISPLAY.REF 72914 . 73543)) (
|
||||
73547 73909 (IRM.LOAD-GRAPH 73547 . 73909)) (74234 79738 (IRM.DISPLAY.CREF 74244 . 75958) (
|
||||
IRM.CREF.BOX 75960 . 76787) (IRM.PUT.CREF 76789 . 77014) (IRM.GET.CREF 77016 . 77387) (
|
||||
IRM.CREF.BUTTONEVENTFN 77389 . 79736)) (80293 88599 (\IRM.GET.REF 80303 . 81634) (\IRM.SMART.REF 81636
|
||||
. 83563) (\IRM.CHOOSE.REF 83565 . 84816) (\IRM.WILD.REF 84818 . 86073) (\IRM.WILDCARD 86075 . 86441)
|
||||
(\IRM.WILD.MATCH 86443 . 87673) (\IRM.GET.HASHFILE 87675 . 88138) (\IRM.GET.KEYWORDS 88140 . 88597)) (
|
||||
88736 88892 (\IRM.AROUND-EXIT 88736 . 88892)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8)
|
||||
|
||||
(FILECREATED "31-Mar-2026 09:03:25" {WMEDLEY}<sources>UNICODE-FORMATS.;4 218013
|
||||
(FILECREATED " 7-May-2026 11:08:18" {MEDLEY}<sources>UNICODE-FORMATS.;5 218405
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2026 13:11:16" {WMEDLEY}<sources>UNICODE-FORMATS.;3)
|
||||
:CHANGES-TO (FNS SYSTEM-EXTERNALFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "31-Mar-2026 09:03:25" {MEDLEY}<sources>UNICODE-FORMATS.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNICODE-FORMATSCOMS)
|
||||
@@ -1246,7 +1248,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(SYSTEM-EXTERNALFORMAT
|
||||
[LAMBDA NIL (* ; "Edited 6-Feb-2026 11:29 by rmk")
|
||||
[LAMBDA NIL (* ; "Edited 7-May-2026 11:08 by rmk")
|
||||
(* ; "Edited 6-Feb-2026 11:29 by rmk")
|
||||
(* ; "Edited 31-Jan-2026 18:51 by rmk")
|
||||
(* ; "Edited 10-Oct-2022 11:55 by lmm")
|
||||
(* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
@@ -1254,9 +1257,13 @@
|
||||
(* ;; "Returns the name, sets the global. For now, UTF-8 or through, could be something else.")
|
||||
|
||||
(fetch (EXTERNALFORMAT NAME) of (SETQ *SYSTEM-EXTERNALFORMAT*
|
||||
(FIND-FORMAT (FOR X IN '("LC_CTYPE" "LC_ALL" "LANG")
|
||||
WHEN (STRPOS ".UTF-8" (UNIX-GETENV X))
|
||||
DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH])
|
||||
(FIND-FORMAT (for X in '("LC_CTYPE" "LC_ALL" "LANG")
|
||||
when (STRPOS "UTF" (U-CASE (UNIX-GETENV X)))
|
||||
do
|
||||
(* ;;
|
||||
"Should it check separately for 8? Would anyone ever say UTF-16 ?")
|
||||
|
||||
(RETURN :UTF-8) finally (RETURN :THROUGH])
|
||||
|
||||
(MTOSYSSTRING
|
||||
[LAMBDA (MSTRING) (* ; "Edited 6-Feb-2026 00:20 by rmk")
|
||||
@@ -2756,20 +2763,20 @@
|
||||
(64994 8322) (64995 8323) (64996 8324) (64997 8325) (64998 8326) (64999 8327) (65000 8328) (65001
|
||||
8329) (65002 8331) (65003 8330) (65004 8332) (65008 (48 824)))))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3431 19523 (UTF8.OUTCHARFN 3441 . 6457) (UTF8.SLUG.OUTCHARFN 6459 . 7123) (
|
||||
UTF8.INCCODEFN 7125 . 13404) (UTF8.PEEKCCODEFN 13406 . 18539) (\UTF8.BACKCCODEFN 18541 . 19521)) (
|
||||
19524 24439 (UTF16BE.OUTCHARFN 19534 . 20553) (UTF16BE.INCCODEFN 20555 . 21897) (UTF16BE.PEEKCCODEFN
|
||||
21899 . 23243) (\UTF16BE.BACKCCODEFN 23245 . 24437)) (24440 29171 (UTF16LE.OUTCHARFN 24450 . 25566) (
|
||||
UTF16LE.INCCODEFN 25568 . 26697) (UTF16LE.PEEKCCODEFN 26699 . 27975) (\UTF16LE.BACKCCODEFN 27977 .
|
||||
29169)) (29172 32219 (READBOM 29182 . 31251) (WRITEBOM 31253 . 32217)) (32220 36251 (
|
||||
MAKE-UNICODE-FORMATS 32230 . 36249)) (36319 40813 (UTF8.BINCODE 36329 . 39017) (\UTF8.FETCHCODE 39019
|
||||
. 40811)) (40814 46437 (UTF8.VALIDATE 40824 . 43421) (NUTF8-BYTE1-BYTES 43423 . 44160) (
|
||||
NUTF8-CODE-BYTES 44162 . 45219) (NUTF8-STRING-BYTES 45221 . 46113) (N-MCHARS 46115 . 46435)) (46501
|
||||
47775 (MTOUCODE 46511 . 46680) (UTOMCODE 46682 . 46879) (MTOUCODE? 46881 . 47260) (UTOMCODE? 47262 .
|
||||
47773)) (47776 54348 (MTOUSTRING 47786 . 48369) (UTOMSTRING 48371 . 48954) (MTOUTF8STRING 48956 .
|
||||
53235) (UTF8TOMSTRING 53237 . 54346)) (54406 60114 (XTOUCODE 54416 . 54934) (UTOXCODE 54936 . 55444) (
|
||||
XTOUCODE? 55446 . 56507) (UTOXCODE? 56509 . 57592) (XTOUSTRING 57594 . 58289) (UTOXSTRING 58291 .
|
||||
59034) (XTOUTF8STRING 59036 . 60112)) (60115 65294 (MERGE-UNICODE-TRANSLATION-TABLES 60125 . 62887) (
|
||||
UNICODE.UNMAPPED 62889 . 65292)) (69033 69286 (UNICODE-INIT 69043 . 69284)) (69307 70745 (
|
||||
SYSTEM-EXTERNALFORMAT 69317 . 70261) (MTOSYSSTRING 70263 . 70456) (SYSTOMSTRING 70458 . 70743)))))
|
||||
(FILEMAP (NIL (3476 19568 (UTF8.OUTCHARFN 3486 . 6502) (UTF8.SLUG.OUTCHARFN 6504 . 7168) (
|
||||
UTF8.INCCODEFN 7170 . 13449) (UTF8.PEEKCCODEFN 13451 . 18584) (\UTF8.BACKCCODEFN 18586 . 19566)) (
|
||||
19569 24484 (UTF16BE.OUTCHARFN 19579 . 20598) (UTF16BE.INCCODEFN 20600 . 21942) (UTF16BE.PEEKCCODEFN
|
||||
21944 . 23288) (\UTF16BE.BACKCCODEFN 23290 . 24482)) (24485 29216 (UTF16LE.OUTCHARFN 24495 . 25611) (
|
||||
UTF16LE.INCCODEFN 25613 . 26742) (UTF16LE.PEEKCCODEFN 26744 . 28020) (\UTF16LE.BACKCCODEFN 28022 .
|
||||
29214)) (29217 32264 (READBOM 29227 . 31296) (WRITEBOM 31298 . 32262)) (32265 36296 (
|
||||
MAKE-UNICODE-FORMATS 32275 . 36294)) (36364 40858 (UTF8.BINCODE 36374 . 39062) (\UTF8.FETCHCODE 39064
|
||||
. 40856)) (40859 46482 (UTF8.VALIDATE 40869 . 43466) (NUTF8-BYTE1-BYTES 43468 . 44205) (
|
||||
NUTF8-CODE-BYTES 44207 . 45264) (NUTF8-STRING-BYTES 45266 . 46158) (N-MCHARS 46160 . 46480)) (46546
|
||||
47820 (MTOUCODE 46556 . 46725) (UTOMCODE 46727 . 46924) (MTOUCODE? 46926 . 47305) (UTOMCODE? 47307 .
|
||||
47818)) (47821 54393 (MTOUSTRING 47831 . 48414) (UTOMSTRING 48416 . 48999) (MTOUTF8STRING 49001 .
|
||||
53280) (UTF8TOMSTRING 53282 . 54391)) (54451 60159 (XTOUCODE 54461 . 54979) (UTOXCODE 54981 . 55489) (
|
||||
XTOUCODE? 55491 . 56552) (UTOXCODE? 56554 . 57637) (XTOUSTRING 57639 . 58334) (UTOXSTRING 58336 .
|
||||
59079) (XTOUTF8STRING 59081 . 60157)) (60160 65339 (MERGE-UNICODE-TRANSLATION-TABLES 60170 . 62932) (
|
||||
UNICODE.UNMAPPED 62934 . 65337)) (69078 69331 (UNICODE-INIT 69088 . 69329)) (69352 71137 (
|
||||
SYSTEM-EXTERNALFORMAT 69362 . 70653) (MTOSYSSTRING 70655 . 70848) (SYSTOMSTRING 70850 . 71135)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user