github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-07 08:30:51 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into mth70--Fix_DATABASEFNS_DUMPDB_use_correct_FILEDATES

Browse Source
This commit is contained in:
Matt Heffron
2026-05-06 16:44:43 -07:00
parent 6190f31b12 6159c64b84
commit 2b66206add
16 changed files with 234 additions and 541 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
internal/loadups/LOADUP-FULL
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "14-Feb-2026 00:42:39" {WMEDLEY}<internal>loadups>LOADUP-FULL.;38 5967
(FILECREATED "28-Apr-2026 10:01:06" {WMEDLEY}<internal>loadups>LOADUP-FULL.;47 5896
:EDIT-BY rmk
:CHANGES-TO (FNS LOADUP-FULL)
:PREVIOUS-DATE "13-Feb-2026 00:47:52" {WMEDLEY}<internal>loadups>LOADUP-FULL.;37)
:PREVIOUS-DATE "16-Apr-2026 09:37:27" {WMEDLEY}<internal>loadups>LOADUP-FULL.;46)
(PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -16,7 +16,8 @@
(DEFINEQ
(LOADFULLFONTS
[LAMBDA NIL (* ; "Edited 20-Sep-2025 14:17 by rmk")
[LAMBDA NIL (* ; "Edited 16-Apr-2026 09:37 by rmk")
(* ; "Edited 20-Sep-2025 14:17 by rmk")
(* ; "Edited 2-Sep-2025 20:06 by rmk")
(* ; "Edited 13-Jul-2025 11:40 by rmk")
(* ; "Edited 30-Jun-2025 00:04 by rmk")
@@ -27,11 +28,8 @@
(* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")
(PRINTOUT T "Loading FULL fonts..." T)
(PRINTOUT T T "Loading FULL fonts..." T)
(SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
(* ;; "Previous code reset the coercion variables to NIL, which would have resulted in glyph-incomplete charsets. With Medley-formatted fonts, the completions have already been installed in the files and there is no need to deal with those variables.")
(for FAMILY in '(CLASSIC MODERN TERMINAL)
do (PRINTOUT T " Loading " FAMILY " ")
[for SIZE in '(8 10 12)
@@ -47,7 +45,8 @@
(PRINTOUT T "FULL fonts loaded" T])
(LOADUP-FULL
[LAMBDA (DRIBBLEFILE) (* ; "Edited 14-Feb-2026 00:42 by rmk")
[LAMBDA (DRIBBLEFILE) (* ; "Edited 28-Apr-2026 10:00 by rmk")
(* ; "Edited 14-Feb-2026 00:42 by rmk")
(* ; "Edited 5-Feb-2026 10:26 by rmk")
(* ; "Edited 28-Dec-2025 12:06 by rmk")
(* ; "Edited 1-Sep-2025 11:59 by rmk")
@@ -86,8 +85,7 @@
(LOADUP '(CHAT INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER THINFILES
GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT HELPSYS
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT
UNIXYCD))
DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE UNIXCOMM UNIXCHAT))
(LOADFULLFONTS)
(COND
((WINDOWP *WHO-LINE*)
@@ -103,5 +101,5 @@
(FIXMETA)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (456 5929 (LOADFULLFONTS 466 . 2601) (LOADUP-FULL 2603 . 5679) (FIXMETA 5681 . 5927)))))
(FILEMAP (NIL (456 5858 (LOADFULLFONTS 466 . 2449) (LOADUP-FULL 2451 . 5608) (FIXMETA 5610 . 5856)))))
STOP

BIN
internal/loadups/LOADUP-FULL.LCOM
View File

Binary file not shown.

27
library/UNIXUTILS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "27-Apr-2026 11:10:07" {DSK}<home>frank>il>medley>library>UNIXUTILS.;7 21772
(FILECREATED "28-Apr-2026 09:59:13" {WMEDLEY}<library>UNIXUTILS.;61 22079
:EDIT-BY "FGH"
:EDIT-BY rmk
:CHANGES-TO (FNS ShellOpen SLASHIT)
:CHANGES-TO (VARS UNIXUTILSCOMS)
:PREVIOUS-DATE "31-Mar-2026 00:14:19" {DSK}<home>frank>il>medley>library>UNIXUTILS.;3)
:PREVIOUS-DATE "27-Apr-2026 11:10:07" {MEDLEY}<library>UNIXUTILS.;60)
(PRETTYCOMPRINT UNIXUTILSCOMS)
@@ -23,6 +23,7 @@
(ShellOpener NIL RESET)))
(FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME
UNIX-TMP-FILE-NAME)
(COMMANDS "cd" cdm "ls" "pwd")
(PROPS (UNIXUTILS FILETYPE))))
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -371,10 +372,20 @@
unless (INFILEP UNAME) do (RETURN (SLASHIT (CLOSEF (OPENSTREAM UNAME 'OUTPUT 'NEW])
)
(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))
(DEFCOMMAND cdm (SUBDIR) (/CNDIR (CL:IF SUBDIR
(CONCAT '{MEDLEY}/ SUBDIR)
'{MEDLEY})))
(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST)))
(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1207 1580 (ShellCommand 1207 . 1580)) (1582 1979 (ShellWhich 1582 . 1979)) (2089 21694
(ShellBrowser 2099 . 3871) (ShellBrowse 3873 . 4558) (ShellOpener 4560 . 6248) (ShellOpen 6250 . 12197
) (PROCESS-COMMAND 12199 . 12812) (SLASHIT 12814 . 16126) (UNIX-FILE-NAME 16128 . 20013) (
UNIX-TMP-FILE-NAME 20015 . 21692)))))
(FILEMAP (NIL (1208 1581 (ShellCommand 1208 . 1581)) (1583 1980 (ShellWhich 1583 . 1980)) (2090 21695
(ShellBrowser 2100 . 3872) (ShellBrowse 3874 . 4559) (ShellOpener 4561 . 6249) (ShellOpen 6251 . 12198
) (PROCESS-COMMAND 12200 . 12813) (SLASHIT 12815 . 16127) (UNIX-FILE-NAME 16129 . 20014) (
UNIX-TMP-FILE-NAME 20016 . 21693)))))
STOP

BIN
library/UNIXUTILS.DFASL
View File

Binary file not shown.

135
lispusers/COMPAREDIRECTORIES
View File

@@ -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

BIN
lispusers/COMPAREDIRECTORIES.LCOM
View File

Binary file not shown.

165
lispusers/GITFNS
View File

@@ -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

BIN
lispusers/GITFNS.LCOM
View File

Binary file not shown.

BIN
lispusers/GITFNS.TEDIT
View File

Binary file not shown.

53
lispusers/HELPSYS
View File

@@ -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

BIN
lispusers/HELPSYS.LCOM
View File

Binary file not shown.

24
lispusers/UNIXYCD
View File

@@ -1,24 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Aug-2022 12:29:18" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1 568
:CHANGES-TO (VARS UNIXYCDCOMS)
:PREVIOUS-DATE "12-Aug-2022 11:14:47" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
(PRETTYCOMPRINT UNIXYCDCOMS)
(RPAQQ UNIXYCDCOMS ((COMMANDS "cd" "ls" "pwd")))
(DEFCOMMAND "cd" (DIR)
(/CNDIR DIR))
(DEFCOMMAND "ls" (FIRST . REST)
(DODIR (CONS FIRST REST)))
(DEFCOMMAND "pwd" ()
(DIRECTORYNAME T))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

13
lispusers/UNIXYCD.LCOM
View File

@@ -1,13 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Aug-2022 12:29:30" ("compiled on " {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
"12-Aug-2022 10:18:11" bcompl'd in "Welcome to Fuller sysout 12-Aug-2022 ..." dated
"12-Aug-2022 10:22:21")
(FILECREATED "12-Aug-2022 12:29:18" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1 568 :CHANGES-TO (VARS
UNIXYCDCOMS) :PREVIOUS-DATE "12-Aug-2022 11:14:47" {DSK}<home>larry>medley>lispusers>UNIXYCD.;1)
(PRETTYCOMPRINT UNIXYCDCOMS)
(RPAQQ UNIXYCDCOMS ((COMMANDS "cd" "ls" "pwd")))
(DEFCOMMAND "cd" (DIR) (/CNDIR DIR))
(DEFCOMMAND "ls" (FIRST . REST) (DODIR (CONS FIRST REST)))
(DEFCOMMAND "pwd" NIL (DIRECTORYNAME T))
NIL

13
lispusers/UNIXYCD.TXT
View File

@@ -1,13 +0,0 @@
UNIXYCD & .LCOM .TXT
This file implements little commands:
cd change Lisp's current directory to home
cd dir dir can be a path separated by / or >.
if no "hostname" is given, it's assumed {DSK}
ls [dir] list current directory or a directory that's given
non-feature: ls foo only prints foo; you need to
specify ls foo/
pwd print working directory

323
sources/XCCS
View File

@@ -1,323 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jul-2025 23:08:39" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;10 15413
:EDIT-BY rmk
:CHANGES-TO (VARS XCCSCOMS)
:PREVIOUS-DATE "25-Mar-2025 23:40:52"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;9)
(PRETTYCOMPRINT XCCSCOMS)
(RPAQQ XCCSCOMS
[(FNS \XCCSINCCODE \XCCSPEEKCCODE \XCCSOUTCHAR \XCCSBACKCCODE \XCCSFORMATBYTESTREAM
\XCCSCHARSETFN)
(FNS \CREATE.XCCS.EXTERNALFORMAT)
(FNS \NSIN.24BITENCODING.ERROR)
(FNS KANJICHARSETP CHINESECHARSETP)
(INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*))
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
(NSCHARSETSHIFT 255))
(MACROS \RUNCODED)))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.XCCS.EXTERNALFORMAT])
(DEFINEQ
(\XCCSINCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:28 by rmk")
(* ; "Edited 6-Aug-2021 15:57 by rmk:")
(* ;;; "Returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8.")
(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.")
(* ;;; "This doesn't do EOL conversion, \INCHAR does that")
(DECLARE (USEDFREE *BYTECOUNTER*))
(\DTEST STREAM 'STREAM)
(LET (NUMBYTES (CSET (ffetch (STREAM CHARSET) of STREAM))
(CHAR (\BIN STREAM))) (* ;
 "Error on EOF unless ENDOFSTREAMOP does something else.")
(* ;; " NUMBYTES tracks the number of \BINs. ")
(IF (EQ CHAR NSCHARSETSHIFT)
THEN (* ;
 "Shifting character sets, toss CHAR")
(SETQ CSET (\BIN STREAM))
(IF (NEQ NSCHARSETSHIFT CSET)
THEN (* ;
 "Shift to new runcode CSET: SH CS CH")
(SETQ CHAR (\BIN STREAM))
(SETQ NUMBYTES 3)
(freplace (STREAM CHARSET) of STREAM with CSET)
ELSEIF (EQ 0 (\BIN STREAM))
THEN (* ; "SH SH CSH CS CH where CSH is 0")
(* ;;
 "The high-order character set byte must be 0, because we don't support obese characters (24 bit)")
(SETQ CSET (\BIN STREAM))
(SETQ CHAR (\BIN STREAM)) (* ; "To align with below")
(SETQ NUMBYTES 5)
(freplace (STREAM CHARSET) of STREAM with \NORUNCODE)
ELSE (\NSIN.24BITENCODING.ERROR STREAM))
(* ;; "The stream now knows the new character set, runcoded or not.")
ELSEIF (EQ CSET \NORUNCODE)
THEN (* ; "2-bytes")
(SETQ CSET CHAR)
(SETQ CHAR (\BIN STREAM))
(SETQ NUMBYTES 2)
ELSE
(* ;; "Runcoded CSET and CHAR")
(SETQ NUMBYTES 1))
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* NUMBYTES))
(CL:WHEN CHAR (* ;
 "Typically NIL if ENDOFSTREAMOP returned NIL at EOF ")
(LOGOR (UNFOLD CSET 256)
CHAR))])
(\XCCSPEEKCCODE
[LAMBDA (STREAM NOERROR) (* ; "Edited 8-Dec-2023 15:32 by rmk")
(* ; "Edited 21-Jun-2021 23:44 by rmk:")
(* ;;
 "Modeled on \XCCSINCCODE, but peeks at the last byte in the sequence, leaves the stream unchanged")
(\DTEST STREAM 'STREAM)
(LET ((CSET (ffetch (STREAM CHARSET) of STREAM))
(CHAR (\PEEKBIN STREAM NOERROR)))
(* ;; "Returns a 16 bit character code. Doesn't do EOL conversion--\PEEKCCODE does that. ")
(* ;; "We don't change the charset in the stream, put the file ptr back the way it was.")
(CL:WHEN CHAR
(IF (EQ CHAR NSCHARSETSHIFT)
THEN (\BIN STREAM) (* ; "Read the peeked shifting byte")
(SETQ CSET (\BIN STREAM)) (* ; "Consume the char shift byte")
(IF (NEQ CSET NSCHARSETSHIFT)
THEN
(* ;;
 "Shift to new runcode CSET: SH CS CH. We have to BIN what we peeked, BIN, and peek again")
(SETQ CHAR (\PEEKBIN STREAM NOERROR))
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
ELSEIF (EQ 0 (\BIN STREAM))
THEN (* ; "SH SH CSH CS CH where CSH is 0")
(* ;;
 "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error")
(SETQ CSET (\BIN STREAM))
(SETQ CHAR (\PEEKBIN STREAM NOERROR))
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
ELSE (\NSIN.24BITENCODING.ERROR STREAM))
ELSEIF (EQ CSET \NORUNCODE)
THEN (* ; "2 byte runs, BIN/PEEK/BACK")
(SETQ CSET CHAR)
(\BIN STREAM)
(SETQ CHAR (\PEEKBIN STREAM NOERROR)) (* ; "One BACKFILEPTR seems OK")
(\BACKFILEPTR STREAM))
(* ;; "No need to back up for the runcoded case")
(CL:WHEN CHAR
(LOGOR (UNFOLD CSET 256)
CHAR)))])
(\XCCSOUTCHAR
[LAMBDA (STREAM CHARCODE) (* ; "Edited 13-Aug-2021 10:24 by rmk:")
(* ;; "Closed function for the :XCCS external format, also called when :XCCS is the default")
(COND
((EQ CHARCODE (CHARCODE EOL))
(FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
[COND
[(NOT (\RUNCODED STREAM)) (* ;
 "Charset is a constant 0, we put out the high-order byte.")
(\BOUT STREAM (\CHARSET (CHARCODE EOL]
((EQ (\CHARSET (CHARCODE EOL))
(ffetch (STREAM CHARSET) of STREAM)))
(T (* ;
 "We are runcoded, and not in character set 0, have to shift.")
(\BOUT STREAM NSCHARSETSHIFT)
(\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET
(CHARCODE EOL]
(* ;; "We are now in the right charset (0) for the first EOL byte. For CRLF, the CR is immediately followed by the LF byte, without the prefix 0 byte even if not runcoded, i.e. the 2 bytes are though of as a composite. The stream is left in CSET0 (the freplace above), read for another shift according to the next shift in a runcoded file.")
(\BOUTEOL STREAM))
(T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM)
(IPLUS16 1 DATUM))
(COND
((NOT (\RUNCODED STREAM))
(\BOUT STREAM (\CHARSET CHARCODE))
(\BOUT STREAM (\CHAR8CODE CHARCODE)))
((EQ (\CHARSET CHARCODE)
(ffetch (STREAM CHARSET) of STREAM))
(\BOUT STREAM (\CHAR8CODE CHARCODE)))
(T (\BOUT STREAM NSCHARSETSHIFT)
(\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET
CHARCODE))
)
(\BOUT STREAM (\CHAR8CODE CHARCODE])
(\XCCSBACKCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:34 by rmk")
(* ; "Edited 19-Jul-2022 17:12 by rmk")
(* ; "Edited 13-Aug-2021 14:08 by rmk:")
(DECLARE (USEDFREE *BYTECOUNTER*))
(LET ((BYTE (AND (\BACKFILEPTR STREAM)
(\PEEKBIN STREAM)))
(CSET (fetch (STREAM CHARSET) of STREAM)))
(CL:WHEN BYTE
(* ;; "The immediately preceding byte must be a character byte. If it is a byte in a runcode, then we are done, even if the byte before is part of a shift sequence.")
(* ;; "But if we are currently in a nonruncoded file, we have to go back one more to get the character set byte.")
(* ;; "If we can't back up, we are already at the beginning.")
(IF (EQ \NORUNCODE CSET)
THEN (IF (\BACKFILEPTR STREAM)
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
(LOGOR (UNFOLD (\PEEKBIN STREAM)
256)
BYTE)
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
NIL)
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
(LOGOR (UNFOLD CSET 256)
BYTE)))])
(\XCCSFORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 26-Mar-2024 11:00 by rmk")
(* ; "Edited 19-Mar-2024 16:02 by rmk")
(\EXTERNALFORMAT BYTESTREAM (\EXTERNALFORMAT STREAM))
(* ;; "This stream may be read as a continuation of STREAM (TTYIN, LAFITE?), and we want to make sure that the bytes are encoded properly. So let's assert (and possibly mark) that that's its current situation.")
(\XCCSCHARSETFN BYTESTREAM (fetch (STREAM CHARSET) of STREAM))
BYTESTREAM])
(\XCCSCHARSETFN
[LAMBDA (STREAM CHARSET DONTMARKSTREAM) (* ; "Edited 9-Dec-2023 11:18 by rmk")
(* ;; "This differs from \GENERIC.CHARSET in that it actually writes the shifting bytes into an output stream, unless DONTMARKSTREAM. It will do write the shifts, even if it just replicates the situation that is already there (presumably CHARSET = the old CHARSET). The client should test and avoid calling if useless shifts are not desired.")
(LET [(CSET (ffetch (STREAM CHARSET) of (\DTEST STREAM 'STREAM]
(CL:WHEN CHARSET
(CL:WHEN (EQ CHARSET T)
(SETQ CHARSET \NORUNCODE))
(CL:UNLESS (EQ CHARSET CSET)
(freplace (STREAM CHARSET) of STREAM with CHARSET)
(CL:UNLESS DONTMARKSTREAM
(CL:WHEN (\IOMODEP STREAM 'OUTPUT T)
(\BOUT STREAM NSCHARSETSHIFT)
(if (EQ CHARSET \NORUNCODE)
then (\BOUT STREAM \NORUNCODE)
(\BOUT STREAM 0)
else (\BOUT STREAM CHARSET))))))
CSET])
)
(DEFINEQ
(\CREATE.XCCS.EXTERNALFORMAT
[LAMBDA (NAME EOL) (* ; "Edited 7-Dec-2023 23:03 by rmk")
(* ; "Edited 30-Jun-2022 18:08 by rmk")
(* ; "Edited 10-Sep-2021 19:49 by rmk:")
(* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here")
(MAKE-EXTERNALFORMAT (OR NAME :XCCS)
(FUNCTION \XCCSINCCODE)
(FUNCTION \XCCSPEEKCCODE)
(FUNCTION \XCCSBACKCCODE)
(FUNCTION \XCCSOUTCHAR)
(FUNCTION \XCCSFORMATBYTESTREAM)
(OR EOL 'LF)
T NIL NIL (FUNCTION \XCCSCHARSETFN])
)
(DEFINEQ
(\NSIN.24BITENCODING.ERROR
[LAMBDA (STREAM) (* bvm%: "12-Mar-86 15:35")
(DECLARE (USEDFREE *SIGNAL-24BIT-NSENCODING-ERROR*))
(* ;;; "Called if we see the sequence shift,shift on STREAM -- means shift to 24-bit character set, which we don't support. Usually this just means we're erroneously reading a binary file as text. If this function returns, its value is taken as a character set to shift to")
(COND
(*SIGNAL-24BIT-NSENCODING-ERROR* (* ;
 "Only cause error if user/reader cares")
(ERROR "24-bit NS encoding not supported" STREAM)))
(* ; "Return charset zero")
0])
)
(DEFINEQ
(KANJICHARSETP
[LAMBDA (CHARSET) (* ; "Edited 13-Jun-2025 16:33 by rmk")
(* ;; "Returns CHARSET if it is a charset with MCCS Kanji characters")
(AND (<= 48 CHARSET 118)
CHARSET])
(CHINESECHARSETP
[LAMBDA (CHARSET) (* ; "Edited 18-Jun-2025 23:09 by rmk")
(* ; "Edited 13-Jun-2025 16:33 by rmk")
(* ;; "Returns CHARSET if it is a charset with MCCS Chinese characters")
(AND (<= 161 CHARSET 212)
CHARSET])
)
(RPAQ? *SIGNAL-24BIT-NSENCODING-ERROR* )
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(RPAQQ \NORUNCODE 255)
(RPAQQ NSCHARSETSHIFT 255)
(CONSTANTS (\NORUNCODE 255)
(NSCHARSETSHIFT 255))
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \RUNCODED MACRO (OPENLAMBDA (STREAM)
(* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented")
(* ;
 "note that neq is ok since charsets are known to be SMALLP's")
(NEQ (fetch CHARSET of STREAM)
\NORUNCODE)))
)
(* "END EXPORTED DEFINITIONS")
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\CREATE.XCCS.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (997 12253 (\XCCSINCCODE 1007 . 3986) (\XCCSPEEKCCODE 3988 . 6657) (\XCCSOUTCHAR 6659 .
8879) (\XCCSBACKCCODE 8881 . 10425) (\XCCSFORMATBYTESTREAM 10427 . 11048) (\XCCSCHARSETFN 11050 .
12251)) (12254 13027 (\CREATE.XCCS.EXTERNALFORMAT 12264 . 13025)) (13028 13859 (
\NSIN.24BITENCODING.ERROR 13038 . 13857)) (13860 14500 (KANJICHARSETP 13870 . 14126) (CHINESECHARSETP
14128 . 14498)))))
STOP

BIN
sources/XCCS.LCOM
View File

Binary file not shown.