From defd68a89208660f4d3e72f9a25ef37d657e9acc Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Mon, 17 Nov 2025 10:44:23 -0800 Subject: [PATCH 1/4] READ-BDF initial changes for XCCS to MCCS (#2360) * Verbose mode (READ-BDF) was implemented incorrectly - fixed * Cleanup DEFPACKAGE in source file using :IMPORT-FROM, and fewer imports. * Various renaming for consistency with XCCS -> MCCS changes. * Use IL:FONTSPEC record instead of using FIRST, SECOND, etc. * Fix the parsing of IL:FONTSPEC to use COMPRESSED instead of incorrect CONDENSED. * Zero-width "image" with zero-width "escapement" GLYPHS now get put into NOMAPPINGCHARSET. * Add (FILES (SYSLOAD) SYSEDIT) under existing (DECLARE: EVAL@COMPILE DONTCOPY ...) --- lispusers/READ-BDF | 197 ++++++++++++++++++++++----------------- lispusers/READ-BDF.DFASL | Bin 20898 -> 21485 bytes lispusers/READ-BDF.TEDIT | Bin 9640 -> 9819 bytes 3 files changed, 111 insertions(+), 86 deletions(-) diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF index 229d59d0..a4c28123 100644 --- a/lispusers/READ-BDF +++ b/lispusers/READ-BDF @@ -1,17 +1,19 @@ (DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF" -"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT \AVGCHARWIDTH \FGETWIDTH \FONTFACE \FONTFILENAME -\FSETOFFSET \FSETWIDTH \FONTSYMBOL \GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE -BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP -FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) -READTABLE "XCL" BASE 10) +"WRITE-BDF-TO-DISPLAYFONT-FILES") (IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT" +"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" +"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?" +"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10) -(IL:FILECREATED "30-Apr-2025 13:20:10" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;61| 47500 +(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101 :EDIT-BY "mth" - :CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME) + :CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH + WRITE-BDF-TO-DISPLAYFONT-FILES) + (FILE-ENVIRONMENTS "READ-BDF") + (IL:VARS IL:READ-BDFCOMS) - :PREVIOUS-DATE "25-Apr-2025 10:10:08" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;60| + :PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}matt>Interlisp>medley>lispusers>READ-BDF.;9| ) @@ -23,8 +25,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES) - (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP) - IL:FONT)) + (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD) + IL:SYSEDIT) + (IL:FILES (IL:LOADCOMP) + IL:FONT)) (FILE-ENVIRONMENTS "READ-BDF") (IL:PROP (IL:DATABASE) IL:READ-BDF))) @@ -40,10 +44,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SLUG NIL :TYPE GLYPH)) (DEFSTRUCT GLYPH - "This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO" + "This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO" (NAME NIL :TYPE STRING) ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP - (XCODE 0 :TYPE INTEGER) + (MCODE 0 :TYPE INTEGER) (WIDTH 0 :TYPE INTEGER) (ASCENT 0 :TYPE INTEGER) (DESCENT 0 :TYPE INTEGER)) @@ -55,6 +59,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET)) (DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE) + (IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth") (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth") (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth") @@ -98,7 +103,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST ((INTEGERP SLUG-OR-WIDTH) (SETQ SLUGWIDTH SLUG-OR-WIDTH)) (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH))) - (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL)) + (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL)) (GL (CDR XGL)) (GWIDTH (GLYPH-WIDTH GL)) @@ -112,13 +117,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST    "Is the above statement actually true?") - (SETF (GLYPH-XCODE GL) - XCODE) + (SETF (GLYPH-MCODE GL) + MCODE) (SETQ FIRSTCHAR - (MIN FIRSTCHAR XCODE + (MIN FIRSTCHAR MCODE )) (SETQ LASTCHAR - (MAX LASTCHAR XCODE) + (MAX LASTCHAR MCODE) ) (INCF TOTAL-WIDTH GWIDTH) (SETQ ASCENT @@ -133,13 +138,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (IL:* IL:|;;|  "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I TOTAL-WIDTH)) (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO)) (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH") - (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I + (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I SLUGWIDTH)) (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS) @@ -151,19 +156,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH) HEIGHT 1)) (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP) - (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GLBM + (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM (GLYPH-BITMAP GL)) (SETQ GLW (GLYPH-WIDTH GL)) - (SETQ XCODE (GLYPH-XCODE GL)) + (SETQ MCODE (GLYPH-MCODE GL)) (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL))) (+ DESCENT (GLYPH-BBYOFF0 GL)) (BITMAPWIDTH GLBM) (BITMAPHEIGHT GLBM) 'INPUT 'IL:REPLACE) - (\\FSETOFFSET OFFSETS XCODE DLEFT) - (\\FSETOFFSET WIDTHS XCODE GLW) + (IL:\\FSETOFFSET OFFSETS MCODE DLEFT) + (IL:\\FSETOFFSET WIDTHS MCODE GLW) (INCF DLEFT GLW)) (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)") @@ -185,6 +190,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth") (WHEN (AND (BDF-FONT-P BDFONT) @@ -200,18 +206,22 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE)) MAP-UNKNOWN-TO-PRIVATE))) (WHEN (LISTP FAMILY) - (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY) - (OR (SECOND FAMILY) + + (IL:* IL:|;;| "Assume this is a FONTSPEC") + + (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY) + IL:|of| FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY) SIZE) - (OR (THIRD FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY) FACE "MRR") - (OR (FOURTH FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY) ROTATION 0) - (OR (FIFTH FAMILY) + (OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY) DEVICE 'DISPLAY) MAP-UNKNOWN-TO-PRIVATE))) - (SETQ FAMILY (\\FONTSYMBOL FAMILY)) + (SETQ FAMILY (IL:\\FONTSYMBOL FAMILY)) (UNLESS (AND (INTEGERP SIZE) (PLUSP SIZE)) (ERROR "Invalid SIZE: ~S~%" SIZE)) @@ -236,7 +246,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (INTERN (STRING-UPCASE DEVICE) "IL")) (T (IL:\\ILLEGAL.ARG DEVICE)))) - (SETQ FACE (\\FONTFACE FACE NIL DEV)) + (SETQ FACE (IL:\\FONTFACE FACE NIL DEV)) (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)) (UNLESS SLUGWIDTH @@ -268,15 +278,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST GBCS CSET (OR SLUG (1+ SLUGWIDTH )))) - (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET) + (IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET + ) (LIST CSET))))) (LIST FONTDESC CHARSETS)))) (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL) FAMILY) (GBCS-TO-FONTDESC (SECOND GBCSL) - (\\FONTSYMBOL (CONCATENATE 'STRING - (SYMBOL-NAME FAMILY) - "-UNMAPPED"))) + (IL:\\FONTSYMBOL (CONCATENATE 'STRING + (SYMBOL-NAME FAMILY) + "-UNMAPPED"))) (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL) :TEST #'EQL))))))))) @@ -311,8 +322,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST '((#\R . REGULAR) (#\N . REGULAR) (#\B . BOLD) - (#\S . CONDENSED) - (#\C . CONDENSED))))) + (#\S . COMPRESSED) + (#\C . COMPRESSED))))) 'REGULAR)) (IL:* IL:\;  "S is for \"SemiCondensed\", Assuming \"Condensed\"") @@ -336,17 +347,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (FIRST (BF-SIZE BDFONT)))))) (DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth") + (IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth") (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth") (IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth") (LET* ((NCSETS (+ MAXCHARSET 2)) (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL)))) - (UTOXFN (COND + (UTOMFN (COND (RAW-UNICODE-MAPPING #'IDENTITY) - (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE) - (T #'UTOXCODE?))) + (MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE) + (T #'UTOMCODE?))) (SLUG (BF-SLUG FONT)) (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG))) - NOMAPPINGCSETS ENC XCODE XCS) + NOMAPPINGCSETS ENC MCODE MCS) (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING) (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))) @@ -358,7 +371,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST :UNLESS (EQ GL SLUG) :DO - (SETQ XCS NIL) + (SETQ MCS NIL) (SETQ ENC (GLYPH-ENCODING GL)) (WHEN (LISTP ENC) @@ -372,9 +385,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST  "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it") ) - (SETQ XCODE (AND (INTEGERP ENC) + (SETQ MCODE (AND (INTEGERP ENC) (PLUSP ENC) - (FUNCALL UTOXFN ENC))) + (FUNCALL UTOMFN ENC))) (IF RAW-UNICODE-MAPPING (COND ((> ENC 65535) @@ -394,7 +407,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (CONS ENC GL))) (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS))) (COND - ((NULL XCODE) + ((AND (ZEROP (GLYPH-BBW GL)) + (ZEROP (FIRST (GLYPH-DWIDTH GL)))) + + (IL:* IL:|;;| + "This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET") + + (TCONC (AREF CSETS NOMAPPINGCHARSET) + (CONS ENC GL))) + ((NULL MCODE) (IL:* IL:|;;| "These assoc with the Unicode encoding") @@ -408,37 +429,37 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (TCONC (AREF CSETS NOMAPPINGCHARSET) (CONS ENC GL))) (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS)))) - ((AND (INTEGERP XCODE) - (<= 0 XCODE 65535)) + ((AND (INTEGERP MCODE) + (<= 0 MCODE 65535)) (IL:* IL:|;;|  "These assoc with the 8 bit character code within the charset") - (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS) + (PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS) (IL:* IL:|;;| "Default SLUG width is width of A.") (WHEN (AND (NOT SLUGWIDTH) (= ENC (CHAR-CODE #\A))) - (IL:* IL:|;;| "A is the same code in XCCS and UNICODE ") + (IL:* IL:|;;| "A is the same code in MCCS and UNICODE ") (IL:* IL:|;;| - "Comparing with ENC, not XCODE, to look only in charset 0") + "Comparing with ENC, not MCODE, to look only in charset 0") (SETQ SLUGWIDTH (GLYPH-WIDTH GL)))) - ((LISTP XCODE) + ((LISTP MCODE) (IL:* IL:|;;|  "These assoc with the 8 bit character code within the charset (like above)") - (LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS - (LRSH XC 8)) - XCS) + (LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS + (LRSH MC 8)) + MCS) :DO - (PUSH CS XCS) - (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS))) - (T (ERROR "Invalid XCODE: ~A~%")))))) + (PUSH CS MCS) + (PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS))) + (T (ERROR "Invalid MCODE: ~A~%")))))) (IL:* IL:|;;| "Extract the lists from the TCONC pointers") @@ -488,7 +509,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST X)) Y)))) -(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") +(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth") + (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth") (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth") (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth") (LET @@ -603,15 +625,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETF (BF-SLUG FONT) GL)))))) (ENDFONT (SETQ FONT-COMPLETE T)))))))) - (WHEN VERBOSE - (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) - SIZE) - (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) + (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION) + SIZE) + (GET-FAMILY-FACE-SIZE-FROM-NAME FONT) + (WHEN VERBOSE (FORMAT *STANDARD-OUTPUT* "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%" (BF-NAME FONT) - FAMILY SIZE WEIGHT SLANT EXPANSION))) - FONT))) + FAMILY SIZE WEIGHT SLANT EXPANSION)) + (VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE))))) (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\])) (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth") @@ -699,7 +721,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH)) (SETQ BYTEPOS (* 16 (1- NWORDS))) (LOOP :REPEAT NWORDS :DO - (\\PUTBASE BM.BASE WORDINDEX + (IL:\\PUTBASE BM.BASE WORDINDEX (LDB (BYTE 16 BYTEPOS) BITS)) (INCF WORDINDEX) @@ -744,12 +766,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (CHAR-SETS T) MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED RAW-UNICODE-MAPPING) + (IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth") (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth") (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth") (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth") (IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth") (UNLESS (TYPEP BDFONT 'BDF-FONT) - (ERROR "Not a BDF-FONT: ~S~%" BDFONT)) + (ERROR "Not a BDF-FONT: ~S ~%" BDFONT)) (COND ((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets") ) @@ -769,7 +792,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT) (SETQ FAMILY (OR FAMILY FN-FAMILY)) (WHEN RAW-UNICODE-MAPPING - (SETQ FAMILY (\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) + (SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY))))) (SETQ FACE (OR FACE FN-FACE)) (SETQ SIZE (OR SIZE FN-SIZE)) (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS) @@ -780,16 +803,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS))) (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (\\FONTFILENAME FAMILY SIZE FACE + (IL:\\FONTFILENAME FAMILY SIZE FACE "DISPLAYFONT" CS)))) (IF WRITE-UNMAPPED (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE UNMAPPED-FONTDESC CS (PACKFILENAME.STRING :BODY DEST-DIR :NAME - (\\FONTFILENAME (FONTPROP - UNMAPPED-FONTDESC - 'IL:FAMILY) + (IL:\\FONTFILENAME (FONTPROP + UNMAPPED-FONTDESC + 'IL:FAMILY) SIZE FACE "DISPLAYFONT" CS)))) (SETQ UNICODE-CSETS NIL)) @@ -801,6 +824,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)))) (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY +(IL:FILESLOAD (IL:SYSLOAD) + IL:SYSEDIT) + + (IL:FILESLOAD (IL:LOADCOMP) IL:FONT) ) @@ -808,25 +835,23 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST (DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP") (:EXPORT "READ-BDF" "WRITE-BDF-TO-DISPLAYFONT-FILES") - (:IMPORT \\AVGCHARWIDTH \\FGETWIDTH \\FONTFACE - \\FONTFILENAME \\FSETOFFSET \\FSETWIDTH - \\FONTSYMBOL \\GETSTREAM - \\INSTALLCHARSETINFO \\PUTBASE BITBLT - BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH - BLACKSHADE BLTSHADE BOLD CONDENSED - CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP - FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM - REGULAR TCONC UTOXCODE UTOXCODE? - WRITESTRIKEFONTFILE)) + (:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" + "BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE" + "BLTSHADE" "BOLD" "COMPRESSED" + "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR" + "FONTP" "FONTPROP" "INPUT" "ITALIC" + "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" + "UTOMCODE" "UTOMCODE?" + "WRITESTRIKEFONTFILE")) :READTABLE "XCL" :COMPILER :COMPILE-FILE) (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO) (IL:DECLARE\: IL:DONTCOPY - (IL:FILEMAP (NIL (2316 10275 (BDF-TO-CHARSETINFO 2316 . 10275)) (10277 16147 (BDF-TO-FONTDESCRIPTOR -10277 . 16147)) (16149 19687 (GET-FAMILY-FACE-SIZE-FROM-NAME 16149 . 19687)) (19689 26500 ( -GLYPHS-BY-CHARSET 19689 . 26500)) (26502 27927 (PACKFILENAME.STRING 26502 . 27927)) (27929 34733 ( -READ-BDF 27929 . 34733)) (34735 35058 (READ-DELIMITED-LIST-FROM-STRING 34735 . 35058)) (35060 41548 ( -READ-GLYPH 35060 . 41548)) (41550 42291 (SPLIT-FONT-NAME 41550 . 42291)) (42293 46075 ( -WRITE-BDF-TO-DISPLAYFONT-FILES 42293 . 46075))))) + (IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR +10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 ( +GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 ( +READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 ( +READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 ( +WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827))))) IL:STOP diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL index 1974ed35938ba59ce1aee8f097126b0f96dea634..927778eaf9838aafa5ba0d1b7cc9d57d42e6156d 100644 GIT binary patch delta 7924 zcmcgxX>?S_m45Yl(Y_!Fv>=Q?Vl%Ws5<*DAR=@6kEj_8bU#t5`LXJQPOaeY^0|wh; za5s#zV7J9mhV-+g0WUbmPI3~Em)Mgz#CT#4-qT3r z)zmC=g|_Z;H7sdps%dC!tzXjGRG;ftqJhaYW5dqvJ8m1kdr{4@8sM+rymtNe8Z5LZ zRqEtF_*kqmc`%Wu1;cv8aQP#8Fqx3GKr-RY|EuO19X)M!+NM4q=(iA2?yp@sZ40veM|( zLTIFkisFzCqY&0Y9l~zIZ0DEl^Qtj#s>kPd8MvKUBP~hv1y1A&!B^{Nb){9_lG?*V42vwNb@*}Ta=E^d|H8S6weXIt9Wi%p z@<5_EYD9XyMsGxQ>7FjtYm}I7X1ZX5)x?uzh zf=aiFqe_DYg9uh1PT0lZA&P3Z!Y~5L^XR=HA55%AUrCBsZcsHMniu>OW*Hc{VQ@M% zVrXiV(#|OPyTHB-&Jy~1%E%HKR-&&DMo<^7V-ILi zBW~VhF|58@j6|F&J03UhhWtXPVe*Jrvp*;O+`JbEIZ#b{V6Du9m>IJ&ef=>EGca0K?jg*@afkyWH(eZu++rL~ zG4@)F%%oTho?`5?7@3)}7!Repv9A%@`a8>-^dwreBXLs^%=>_W^B|^{`}3BuZ}L5P z^GY919+k4)FGD3#u|$SH%vVjVWNv;T??$$nf0j2~?9QiUCP|}2*gw8Ge~hvHJg@NC zSUdLh8tMN9;d=yshVWH_mk@rR;6;R-;Dx(MoF5`_P9^bHGl@6nka(k%#OsX2YpK>p z!C?qQ=~}OHFry>9(70KBejgF#U$&h8#D`qv9_@D4ECO#hzHp z0`qV3&F#(>bH`Hij>V=@Ywj#D6=o_JMv5^eD3Vy>iWNN+D|#qSOK-&t#flk<6*Cko zW+)~21DE@!{VqBqaealqPMJTSMA~P?htotD& zTMfak0t?Y>C*1*aUkrxsASDjb=VAKfK(={2{j~l8phKg>cvk9u|B_Tp@M2j^$4h7dkzn{tgca@ zff-5#8e)wJ2mf~@i}F@HwP=4zEvEN@QP>f~UC)&nmsD-E$t6&Ci|yTNW3E4_ElTC2>}BG zPAa5b9sjqfd2+|q8Irtj0)D7;l8a(zsqkxXBF?O4Z08*5&(r4x`n*V=m-xbp1{UP2 zD_SWyvnZ-rD}E>hTM#ZLh!(RM1e+1s2rdIC{f1x@LTZXFMffaf8xcN2umRy-gwmz2 zk+>KnaiQ6)MeTVJ&CgLZXZ4e#Idk&X%BOB}!Xz@Q*9?xuUq~*hmze~YAOXL zgklB4`|P>b4Kot~@3Jfg_&pd|5%t-8ez|Hs-&^Ic^fA-Nrot%=COsPt-BCk<;Iz&3 z0i&n7Ba52ol#5K2!5Dz#6dHSo-1wT6QO~hY$_{+o47xdIVC^E7;(m z5(wyC5Bztd?gWw7t|KvQn1P!FngN-%7oY&#Y~a4+RWU8xV;#bykR@(Mkc!#hP=eZx zLJSB|Lsb!dI>FnJ2u0 zB(EXJo~J6=cZE161Q%kd5EVi=Nl2f8H#X0jk>$2STWo-TWmX^S8b3A5FS9QGX|2lo z`A=q6^5EiWd`sQ*sXNi4X*9BUZHf*A;S$OZ)wPudu>7--lQW1pei%glvpOSo59*gu zABGXqX@>1WXg9k+NKXhc24&NiQPhu6q1Zh_Y!ISXhz=l&8*Cm>Ww9p5u+k?WCw1+G zbhh+4mDtPo%xTY3W}5CPaJ+hX&YJQB7Mvmcp5<iS4nep)a)L=Fz+qKy7}=1TI^xW zS_@S<18S(l=)|N!%u%f7Q^>KY0cztEsmC@8u?EXT)S%v{eg$BW7;cxpH{>-mJydP> z6cTZ`2&)`7-6)a}X!E;zL)|X){eIOKL+utK9!IF*2w69HOuHdXZwZ*FC*Gp~r7u9A zgMO)a;WCPv-)1tOC-^vOPXNz)8rUwhePFBuOWxcA#>DJ~8a1YxZrOA@u#MSp!G>Gx zNJLbJFqDBFf{&p#dSue;257vKG}!t(Np81}VC>N^)vAGEnz5E1GoY|eNlanEqi}G_ z@Si|PaUVPgpfHHwbq4t|wgtce>3O7kq$ZocreilZ0#Jqs`8AJdE3P)XOv zhflHx_^pe+>SeV-y`*!KZ7Z}dZE&4F$x3e5OPrWGTR3s5ES+!;m7Uhh*hGB8sj|*3 zOnMH=Rpla&pIh_+8ytV$wT@K<3LwH*yN*4Xu;aob3)71>Rs~(Pi9L@a+yGN!kHWJQ zCPW-OhES9v*aeg+!s}eVUU(w$!W&f-Np#6!L=rIvtCU}$CVztP8G=ZVMX2o|EF$Sk zs6LuuM8R*w`w?b{?VLiye-UR0wCp~DXAshnnw{Y@mXxz0-n3+H?3kF2V}tDoJ57MuYu zp;DA9hU4dH1%wGCU8fMP{&PORp$6XSw1&6Y+kAGT7Q+b;_g?lc!Y8R9PPue|;BJIp zM<|VT35{E%8nFv7*8O_K7p|kMp>iSYdvL^idUZqHNSa@^3c+9uO2hEd>DM4kDnY*4 zk>5cY8z*qy&*I&k>)UJeke4w&ZR@Bc}QsX6Xzgm?h+c>&ZGmV85EixXuSw6ob)IL zgl6Uzj3%n(0W1S=q#&eUlIB5#FA2?aP>Tq9?c<{>K4Ak_WS}GMx{1X{Uatxh+q66z z%l%sRXlbprSA2kknI#rWcyS~+4%dnJPu3j{`Ot4M3}qO(cY9yxDL0M zahH3KzZ_2gV#%RD#aTWTs)Pd$R#hcQ@KSDrXGdJcV!_C@=ExM7=K+^ zbkh~Okzmn`kEe%X*)p3rqyCvpW!HF}r@8I_?M8Dl!D{A>tda+*W3@EYa^0vI9zW_i zY-3@*z(2SKk2|u6*0cmDJj+v1OQ#E2Lg=7wJ%R@QAp_|)$ku>X`q;#iuyu>0>7tkg z-Fwep7Lyrfj#5c%MG_0`8p3apb@Cn(64@$U?IY?JVi><@5UCm=3Wc}{3a1YBtHff_ zgzyS6SBM%@X+dh4NWxVZQ{q4^e+n~$%MXt~Vr6|u`SMC?I3ff*jbR=>)WU-nyrN@jyHMVal}WTRg{7>QG_*211xLhUTA7VPvyeCk@d=IH zAXL*xMN3m6jdYbXf5Q4N2+a#%K@QwEBSyMY()W-h&(KY`2vC=9Hr>rs^5R0%J%`YR zO4Ci3X6bwuzQ1CX=kT7vFLwTj_3#I@J+U4;*pj(8(^m;j5&D<`;VnC?M>Ra`ie2iM z3u|FxWVRd>m!M+~vVoltll$Z?u+uxpUg6y*#O3%&+wu|D+z}TWae?DR=%hCO&91F7 zi}0&~1yjyKF{fV%YJmYV^>tn!yd#FYQh!9lBWy(LR_Sg78x;1QA_cpQPyt$jxcG?O ziwMHYVn`4!HiX8LyUT+Je@DH+8rTO2!L&{61lx(7Z};2STH-s7lW)Id9e)NNV6yuqv3C>VBz7=%Y_C6KvsKk^ zbmWV7KMk*{tN*U9uCA^=c<1}<^aJeZz>RHxRJ2ZBSQrPzTWOY$d_2H2dxkY@&>xPH7irf9q2M*R+lfJ5ta&iM2q>N zC~yySnVMyE;a4^VCesuup{dy)^&1hY1huA>NNK((6sHg9G1KxzBG@;y(qml)h;s(w zNz3muQM=2pTmA?t&Ic~)iw6>#&%zqJ9Mbge5Z1e8eWvF;f5aD9Wrln~1m}Q`4Da+C zsYnonxd9^<)MBQF1@~kdvV*!AkNEnbW(p1=sF{I;9=D7HNU~582PTJ@gn@jP9s{$1 zap^E5J%FN!ZJRTaFww8Bs20?d(e&bxq3nd#os9TModt#} z@t062&7FYB?e!&epFg6R>0?8AQD2{Jw+KPm4P`5&$52LsqL=|bi|a9(UU0Dp@lI#m zECiSMgI!+B@J=2c0QNhpS0G?&ccecaGQIwO@5D}~$HB2(b^t7f*#zy>Sq@B1&n|%L{mbaW($gKS}OLHLBC=j{-wDp zQlM(`AM`K-%vR&3(7{&)QQs;J{YUOWhvb9QnQ_yQ)700H!ywj;WGo1N_ZxlW)>K|p zgNX>3G{xxmI7FqEuyoBNfXk$XA^G4qpDpE$RFN$!>_TrZc+ik>_ZXDD>8#&3fHuCu30g3%OfO0|In7?hn$l!sLM0~?WjLm|L zIFV6t2mpCwDsVPz#K{cen>J#6zHCG~gE(v>#wU@x0^}$$X-s$8#*EFct>~UX5thKa z0D>x%SzT7imk ziU7l-7u?@wY?$vZIFkyYPd_2~e<1rNvA;t0=fqw__MeG;9a&E7h1-dozmdpm8j)Aq ziM&!v*+!-5V}+7d|&w-F#T|0 zQ?Ab3q~$rtGIjiqh5nR(fw(na+~&GY>}?UZFA?Et@zrS}%tRP7OcADwup(D~*iI~A zJF$daw%kr9VLP3K?Q{~h(@9vS6A`wvN!ZRNVaO&a>R^VgsKTbRY&wV14K)A1|1jmy zune@zysOkt*DeKOQMP_+Uz7do|0TXGoZy_r^3L)eU}Qd|5JmIXk;=P%QaUKM?=6w zLq>fEM0o)t-tV=CMu`VzD3f>yby^1apAanDPtHA`W){<*0WqaJg}b45+%FkzV@v;S zfaOa?e`oc}&fXcveD3=H3t$Q+>X9iRCB2?8>hd`1^V7h)qJl{B5aVF0et`<+lgb5A~7lEkZI-z z(v=?q(k;!-#F4GcISKdCI4%=pHZE%t?tjL69*aO5=t5wXqS!ru3`l!|#^Mv=vX2Lg zm+=F|Rkfc;3x7H|I4Cn8%lq48$?_;!h9OxlUiKC&Ek!tB_Z)Q0qRDw-Dv@8xfPK+X zCLmQ{s>vj?t1_9f&-icL*N@&+@^6e?IR9R3>RaMm_Chch>SaKjg`-w_Fv8#Qt6*A!UY0S zZ5Yz`+<6n6$z($Ny(-;!3H&FsI`i^y#eDwf@~-kI6H!(I2Q-+}95{%>g#?n%9uWmZ z&#Xu`brDqyMU24@fh38E7=OHC_53kFkuVtiO2+{P%zZ*mljCXLHgi{5_tvMjKE3ss z?boh7y90)*{CF*XD@V`HY;v#!S1XgLABuV41;;T_h2$Xl#IaA*V5v+Bv!zfWq52RW zkhEAZ4hVIhmxM&Zd^vd5C2x7jIudfzk%AM)>$IC znAml*q1N#OJTfOVxC;d|EDurL24oM5#Yk=uVI*rL2}?rZ%LtZFF!e*KP=71QFC}?S zl2J(xi3KT8rEU}pkSvv?KoXS*`$&?9sRcVF$x%tZAxW(yxkQwYBzZ@YLol3aPRE4H z9-d#TBe45Jmn_V?t9qF^dS6wS%1r+IYK;x>g*D-vU1(6Ln9aXc)0vY*=owMYFVBNm_U>VCHc1SVrf`-_X+Q2;Y|u}w^-x`nJNSPG`4wA)FbLsQO`$f zS7e7Pg+3L|Bp=tVEjxtJ+4h>x-TdU{r&gYRRJqD;o_CXa?JN9^c`sFeKqqCNX`zna zib^D}2%2^}eX+Is_@%n}g{TVLh~ME;!Wx}D|0TvO{`LZW<}nnm2R$yh-gjGgLSq&o zkMnqaY0k(^R2bpg>#K^^Op${wMARtQd4GLnDvbqQG$UCl>X0;2N%;&spNoF?1>p7t z70RDv#p9#~KgvU*X{RjpV%Q>jc@JbVr=^)ziO^M{XQ9fuX`Tf)wc&(lMiP_6FY4A~ z(G>HM1jKyQ`JZ@ihHD8S?FPD7f(Sz_LBt8z$+4IaO-Q1W#3TWwC=5yx5e>X((VV>G zNqb%2$Coa8HUBF{5xa3(_}ycVvemrI`=vtVa@3d>+UB5DzS+xv;{5|VI{NV94U8pu ze!~okswJs%=-xrekPRW*f>UV1qYM^g#yyFwhnzxeDL|$sw5ZXmd4ox~Ob6gO1Vhas zmmGrBR|t&N<0D@6-P7@g1AI%J=xN=hm#WMu=I zyV{qCLACOttmexa=cP^tr6Rd3PA;I*6BR_BEC#fr9-2A=K8yoLEzGcEmDZ2^Opr6& zS{(VnWobQ0Uj$1s4c`ka@j~{u;IL_~72#f?heg{8(b@=R zZ(X--%SI2KKRP`7efw*%ihsSS#r0F*)J6Q+rcQR4f7~>;y#>0X_E^I%5&Q4s0%`OF zK};feZ?lJm_-)M>*$X`0qNi{M zjYKdmH_x?Ygjnmm1O45TG%RfkNnY-dgu%L<_~gT9wB7=bF5haM@9w2-mA$}3FMqbR z0%HGS>%YSH?luhY@3r-_ipScYayXR7bpAv~9sgZNwYs^2mvt_W?{PDQG9NpPFFo*s zE3aW$M%3Hb-ZB%cbryp`?p|LcshM7U005ce8pvE-Mk4B?;`4$?r|9QrIv29z{LRi1 zxSf8~*$W4n*s}71<9l%X8i@9y0={EeMG?EAlP@4WfI@bKi)A$_cBPm~ALN35Cq7wK zU~iWxMjVg8$sikcSbQiGm=j?W#Nct*dmW@{D5)0!MkxzkT(JBoi5VUi3*k_auqM76 z0D!$E0l%g}D3m#0lp3E5}hX0O|PX^72l~ z;45WyD>XQZ)$lF`1U3o$V$xThmy#cWu}(S8(cdk9kM+H!0vurz<_Vwh0-Cq+y4D@X)hXD8>rn>0T7u!4HxRcHp=4}TW7{dw$FKA6 zg>ZPxUvvFH8gG;lJ*r#I2q}J7W~$vQu%w)xhPL<;-N`5{crP8B#2(nesFD{47J1(S zn?A=OO%2VCnWXh?vXs5gw+Grg|KCxxr-zuQZukau02{*)h?JfZ{iAOLjyYIA-_<>k z!f8^;OomgeQf^fp$dY~R3bI+$KL?gw8E4PYu~2ze^g)GvQl|-%SAf$f{RP2EO2Nk7 zL#aGDK!u~|E;V_$vy*+Ae-f%owSbxSmWAN~>j+P&>;XyS zUcl~@r4%THrwe#WMaWJm+=_{s~cPp&@jcu`VtbdONjzeWB26iMvoPbotnIJ{w=! zP~~fQlI5Q86KoCtRrrq78YkF7mrF{s^q%bcB0|}F7Ua8}xM9NnXT;=&bJ9yyBV@L^ zVk(tRW|0l-9yz)9UJu)57TGH!{T_RNb}SwC&Kvf!VJ}3^7wC*MdVbXom3@J0u?16K zf@ZERUsR9uld0!;Dz-Z;+Hs&VO}v7vPhk30o9NK2%Fv;6#}$IIx5*}ivOf@%Jx7wY z{3fHa9Zw@{8woI0*_Y`E4u?`Ym)q+dE9^Co>=a?~pBqgDRYg!zr3X^n6|Y%`*DCfh zYEyfVZ9!I{6*D4p=0U1lbu*DL9idd6PR(kF2Bmf{rMj+qBHAn@$~hXB8sz^F{~2UL zqo=g0IJRTAXPqbWZVm?ubAK&E@PAXw5`MU6z0+SL{QRAsDyH$m#LOIx!T*&wMF($6 z^l5WNsVEaOM7gLCGsP@1Tg(xa!Xv80Tv07*M6H-7>co7pK-7zcVv+EQ#bSwQ5RIZq gG>aC|D%wOlKWPT1X<{p6QZ;5M_kaQFo@>|s7v@Ibo&W#< diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT index 8f6e2ec54277d7d0aa52a6e7c53c832eb004d43b..891c14cc161b6a178923a02d5d7af4e2a55e0467 100644 GIT binary patch delta 2044 zcmbtVO-~bH5T2K{C77cQPnJel|pd}rF3@=etqcBjugGxN+x+IO?x^B-R*8X6$opl@q zFb1*dv|%*CHpxy-UTtJ=ir=80YbJez-f}oSepIjL0iME4G#XD>L7<~AgT3R0T;9?4 zT;`re%V}-|Wtfee%Q~jL|4LKSGNk@hiL_HsQT_X7%=S;-XJgtZc3pscH z!Bh{suRRygVZI%Ij(b+xdLrErZbAD(&dbgRe%wnJAbDg=R7s@TOb6!E0`1Ya#GtaG zUx}nVFX+eJ?2j2%3aM7~N)IP@!75EKy3jyk8yZ%$qerWVAp~Z!wPQl$G$Pmyq7+94 zj^ivNs0t&;890Ro@)jBCL<8X-Mo0ptaB9d%qm~+A66wLmAR*D)p{@HENaMuqBq0+GzacT>X_x$x|h}tA~YCGL_@`I6uw9AZO$`{1}0l( zgtREA0`xH?>yTn~62K&Ly3xR5qzsD*M`kUEaAXu)7*5^Sm*}y2rT4ooB4Bz_wW~2- z7y*qgOhe;GIUfj#RI<-p=|HmY4tjZd>Nk1KgMQ|bFJh(XDdI%a$syXwB@Usx!w{KM z99@{Z7Y!^V{arbL(7?E3e4BzT6jWv|X+a%f4KX`m<#3frqMU|sXhNBjNS2Ebfpn%A zEf;Z(E66M>?-`P?4MtczccEm*=)uFmQGsRK^jDfKxPB&Am^QzRp6kv#jzfR06NWO9 UNiSq49_{>mZnn__pPqgG0~Z delta 1879 zcmb_bO>0w85S^RaYHM4yN^I1mH}zHWVp}S>5JBPf+e zyqmwivvTbBY+RFd*jpO%^<7>BZ*^5 zDxxyQV^u#6>R8Oo*vu0|PpM;`7xJc8$cCk43i{H9@9Wa7$_<@H{Eb^??`NtaXMRCg=!F+i^-WJ`hb_;#ixRAX=ko83M(l z-rHc~v-`cwT^pa;k7@7LX{K9iMz=fd=3>wyZ!fy}v9zj``M2cRv#JN@BmHo}_G>>G znzZLCLS_EwWiJJ*fMI*sj){rWjF^pLIR+8Ae9034au^7_vkndp(DzaMO@8&OUU9%7 z1gNp)kU0c^PdS7wKmvbYD|3EOOPzHj_JiXbBj#_h$3A(OPzW7Uka>ql$(BQoAVAg` zhe&roxfgC6V%!5ti(oR`I2i})*aat9((o`MbK_B?4qF8*o-aF{Wdsnr?+|u~tXv<7 z2TPJ-Lb~SC77!qfouQa;WCMZ-M+VeGIy>*L)|pqDSE5Yb%dLQr1rv>E1VDIRDE)~M zv+d>9(o)i6vQtZP)5|bTneSeax4g&#_TZP69s(6`g}l=UkSE?R3?V!WX8|&{hYTk@ zaaT6>iscFX({z~&bBOi%tjmLdjaw_=B%A+n|Ki%E&pq&_%AvNj((2v*acm23+) ZcmixqRf2AG^}){ Date: Mon, 17 Nov 2025 13:31:59 -0800 Subject: [PATCH 2/4] Fix Tedit promptwindow overlap when given a title-less window (#2375) Fix promptwindow overlap when given a title-less window --- library/tedit/TEDIT-WINDOW | 93 ++++++++++++++++---------------- library/tedit/TEDIT-WINDOW.LCOM | Bin 62647 -> 62636 bytes 2 files changed, 48 insertions(+), 45 deletions(-) diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 9ce843a2..00ea577e 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Oct-2025 10:33:08" {WMEDLEY}TEDIT>TEDIT-WINDOW.;878 230780 +(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}TEDIT>TEDIT-WINDOW.;881 231034 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION) + :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE) - :PREVIOUS-DATE "24-Oct-2025 09:11:52" {WMEDLEY}tedit>TEDIT-WINDOW.;874) + :PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}TEDIT>TEDIT-WINDOW.;878) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -354,7 +354,8 @@ (DEFINEQ (\TEDIT.WINDOW.CREATE - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 23-Oct-2025 18:22 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 15-Nov-2025 01:27 by rmk") + (* ; "Edited 23-Oct-2025 18:22 by rmk") (* ; "Edited 21-Jul-2025 11:55 by rmk") (* ; "Edited 9-May-2025 12:11 by rmk") (* ; "Edited 25-Apr-2025 21:24 by rmk") @@ -377,24 +378,26 @@ (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) (PHEIGHT 0) - TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ) + REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT) + (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) (CL:WHEN (WINDOWP WINDOW) (CL:WHEN (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) TEXTOBJ) - (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape.%" ") + (* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape. Make sure it has a title%" ") (TEDIT.KILL WINDOW) (\TEDIT.CLOSESPLITS (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) T)) - [SETQ TITLE (OR (LISTGET PROPS 'TITLE) - (WINDOWPROP WINDOW 'TITLE]) + + (* ;; "Every tedit window has a title bar, maybe one that it had already?") + + (WINDOWPROP WINDOW 'TITLE (OR (LISTGET PROPS 'TITLE) + (WINDOWPROP WINDOW 'TITLE) + (\TEDIT.DEFAULT.TITLE FILE PROPS)))) (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE) (AND (LITATOM WINDOW) WINDOW))) - (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) - (CL:UNLESS TITLE - (SETQ TITLE (\TEDIT.DEFAULT.TITLE FILE PROPS))) (SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW)) (* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.") @@ -421,7 +424,8 @@ REGION)) (add (fetch (REGION HEIGHT) of REGION) (IMINUS PHEIGHT)) - (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS)) + (SETQ WINDOW (CREATEW REGION (\TEDIT.DEFAULT.TITLE FILE PROPS) + NIL NIL PROPS)) (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.") @@ -451,7 +455,6 @@ (FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS)) (* ; "This should be PANE") - (WINDOWPROP WINDOW 'TITLE TITLE) WINDOW]) (\TEDIT.WINDOW.GETREGION @@ -3659,36 +3662,36 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17103 17999 (TEDIT.DEFER.UPDATES 17113 . 17997)) (18000 44835 (\TEDIT.WINDOW.CREATE -18010 . 24616) (\TEDIT.WINDOW.GETREGION 24618 . 29322) (\TEDIT.WINDOW.SETUP 29324 . 33654) ( -\TEDIT.MINIMAL.WINDOW.SETUP 33656 . 41467) (\TEDIT.CLEARPANE 41469 . 42186) (\TEDIT.FILL.PANES 42188 - . 44833)) (44836 68537 (\TEDIT.CURSORMOVEDFN 44846 . 50456) (\TEDIT.CURSOROUTFN 50458 . 51146) ( -\TEDIT.ACTIVE.WINDOWP 51148 . 52218) (\TEDIT.EXPANDFN 52220 . 52783) (\TEDIT.MAINW 52785 . 54065) ( -\TEDIT.MAINSTREAM 54067 . 54401) (\TEDIT.PRIMARYPANE 54403 . 55173) (\TEDIT.PANELIST 55175 . 55671) ( -\TEDIT.NEWREGIONFN 55673 . 58189) (\TEDIT.SET.WINDOW.EXTENT 58191 . 63173) (\TEDIT.SHRINK.ICONCREATE -63175 . 65908) (\TEDIT.SHRINKFN 65910 . 66319) (\TEDIT.PANEREGION 66321 . 68535)) (68569 101615 ( -\TEDIT.BUTTONEVENTFN 68579 . 81552) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81554 . 88817) ( -\TEDIT.BUTTONEVENTFN.GETOPERATION 88819 . 90661) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90663 . 94333) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 94335 . 96765) (\TEDIT.BUTTONEVENTFN.INTITLE 96767 . 98602) ( -\TEDIT.COPYINSERTFN 98604 . 99736) (\TEDIT.FOREIGN.COPY 99738 . 101613)) (101616 119179 ( -\TEDIT.PANE.SPLIT 101626 . 105574) (\TEDIT.SPLITW 105576 . 113635) (\TEDIT.UNSPLITW 113637 . 117836) ( -\TEDIT.LINKPANES 117838 . 118601) (\TEDIT.UNLINKPANE 118603 . 119177)) (120613 121504 (TEDITWINDOWP -120623 . 121502)) (121541 124644 (TEDIT.GETINPUT 121551 . 123994) (\TEDIT.MAKEFILENAME 123996 . 124642 -)) (124693 132343 (TEDIT.PROMPTWINDOW 124703 . 125017) (TEDIT.PROMPTPRINT 125019 . 127646) ( -TEDIT.PROMPTCLEAR 127648 . 129390) (TEDIT.PROMPTFLASH 129392 . 130650) (\TEDIT.PROMPT.PAGEFULLFN -130652 . 132341)) (132581 143159 (\TEDIT.FILENAME 132591 . 133363) (\TEDIT.DEFAULT.TITLE 133365 . -135744) (\TEDIT.WINDOW.TITLE 135746 . 137915) (\TEDIT.LIKELY.FILENAME 137917 . 140641) ( -\TEDIT.UPDATE.TITLE 140643 . 143157)) (143202 155686 (TEDIT.DEACTIVATE.WINDOW 143212 . 148785) ( -\TEDIT.RESHAPEFN 148787 . 150872) (\TEDIT.REPAINTFN 150874 . 151098) (\TEDIT.CLOSESPLITS 151100 . -153545) (\TEDIT.CLOSEPANE 153547 . 155684)) (155687 198486 (\TEDIT.SCROLLFN 155697 . 157928) ( -\TEDIT.SCROLLCH.TOP 157930 . 160041) (\TEDIT.SCROLLCH.BOTTOM 160043 . 164373) (\TEDIT.SCROLLUP 164375 - . 170101) (\TEDIT.TOPLINE.YTOP 170103 . 171772) (\TEDIT.SCROLLDOWN 171774 . 178813) ( -\TEDIT.SCROLL.CARET 178815 . 181653) (\TEDIT.VISIBLECARETP 181655 . 183949) (\TEDIT.VISIBLECHARP -183951 . 185042) (\TEDIT.BITMAPLINES 185044 . 188964) (\TEDIT.SETPANE.TOPLINE 188966 . 189578) ( -\TEDIT.SHIFTLINES 189580 . 198484)) (198487 209356 (\TEDIT.ONSCREEN? 198497 . 203048) ( -\TEDIT.ONSCREEN.REGION 203050 . 206701) (\TEDIT.AFTERMOVEFN 206703 . 207600) (OFFSCREENP 207602 . -209354)) (209398 212212 (\TEDIT.PROCIDLEFN 209408 . 211068) (\TEDIT.PROCENTRYFN 211070 . 211515) ( -\TEDIT.PROCEXITFN 211517 . 212210)) (212291 225516 (\TEDIT.DOWNCARET 212301 . 213094) ( -\TEDIT.FLASHCARET 213096 . 215207) (\TEDIT.UPCARET 215209 . 216313) (TEDIT.NORMALIZECARET 216315 . -219533) (\TEDIT.SETCARET 219535 . 224886) (\TEDIT.CARET 224888 . 225514))))) + (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE +18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) ( +\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442 + . 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) ( +\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) ( +\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) ( +\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE +63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 ( +\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) ( +\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 ( +\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) ( +\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP +120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896 +)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) ( +TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN +130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 . +135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) ( +\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) ( +\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 . +153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) ( +\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629 + . 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) ( +\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP +184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) ( +\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) ( +\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 . +209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) ( +\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) ( +\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 . +219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 439ef3627bd97586ed03d67642bfef80a505c0be..4b6b6bdf22914d269b4975f40b6b5279127616a6 100644 GIT binary patch delta 1397 zcmZuxPiq@T6t}dFYbk9A*eQy0$U}9AT`IBjXSK6}64}g148 z2!RlazCy$vbIhfO970`_ONe{Tt%Y9t5lo?^U!d*VnXxN{EYj@T_ul;8@BNv1d15_3 zv7T(t5vLY?_pnB7>VQp})NQiSz2<@-%TTToHfHpiXm`ly_2T|o&tH)~+`SLg&L9k7 z+^=4*S0TOg;G6V402DE*%jKm`5c(RV4b}Hh5TnP-B|(5PVl$pSD%3yL?#s|jdj1zd zJm}Zj$RQ(zN})XZ;nPE_xL4@9fYziJZzU2EXh5p>i$$k01? z#WlfCYAo_rlKo9p7^Od^*0XeUuu$03DL|x9 z)S@Fr*{|m+GZ&|pxDeTgGgt2jNCr}ON0py9oOd*pm+OY2Djly=Bo^o61q`#vZ z$b@s|&s;D2`};YMIXD9oaTxPdoBPu5)v(ikyJqHrQ2~0$wt;0ghm~pC@F06pstl>) zz*?N#0?LIM5*!z9pT(n$LDvt~yE5n)dK3>-Cyt~!E7W%K49?gRA9+$}Ukl^D-%r9o_Ccu9nd;`#-w>d^ zHUm7*4$GsBng34}4=;DAah~i)!_Hp)cG&@r)k;>@{rqa^MA$nQ-FIZXx&fRx6I<(f zg@D^`b~1a#VxE&dnZ4A;N=zU#oQ-xIU6;UkL+?MmJSYx^Ca!mAKuV|rq_&NK^Ft!o z>8U3gOClJ-G$-N^MvR-94DdXVfy7(GV@7au`a7~O@dDfe?2?giEXMQ*bDA*C#q6K0 KYtLSm{`?Pd^;F9M delta 1444 zcmZux&u<$=6t=x7)JC-&B|&Kd(yK*DEU>lnV}BVzZ6}*}9oxG&8{8^st->Ob9FUMA zE+9qp!nM|1kPrvd147~emQ*IoDfmA7n*mvZ8# zley7srj;Hz&=1|~q2Fjh05%|U(DOS%h%*ZU6@+6GVzxLipyzISeiw%vy<=B=2RLQP zN_ZoP9Vvuf*cSJ+w^yFzQYo$eM+%=|{mc3b@!-Lt{2b2S$=0&5;pe(2%#?QhMJVcmjFH*PStIne^Mr7aeX1Y;IC^Jk_ZzI}IYfpPLo zN=CUjefV+#7-679-v?^y;-8bt$CR6}<_9-W=}sad)DL@#ODTt@>uokeZzG{W2};uM zh6)P^7Ku#HSP^SdMIu*X@-v!*+tbc7K$s~$e{u23`N|vydtP^Yr{^X)Elb?JGk+Tk z##G53#o9Li^5Q#{2hKS3@ z#KHbeH9dhO7N4AcVi+-4h-iefbIw4pTNAECr%6az-U~J^;kDp`EdF}99pVMp0q#ID RLIs3b)Rvl#zR14u-~ZXZU3>rl From 0fdcbe0590eb62724f16c6e76c36beb874d297f9 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 17 Nov 2025 13:32:50 -0800 Subject: [PATCH 3/4] Extend GITFNS/COMPAREDIRECTORIES so that the See and Compare commands work after files have been rearranged (#2331) * COMPAREDIRECTORIES and GITFNS keep information for seeing and comparing even after files have moved --- lispusers/COMPAREDIRECTORIES | 190 +++++++++++++++++++----------- lispusers/COMPAREDIRECTORIES.LCOM | Bin 42070 -> 42843 bytes lispusers/EXAMINEDEFS | 19 +-- lispusers/EXAMINEDEFS.LCOM | Bin 5695 -> 5735 bytes lispusers/GITFNS | 156 ++++++++---------------- lispusers/GITFNS.LCOM | Bin 51656 -> 50970 bytes 6 files changed, 180 insertions(+), 185 deletions(-) diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index cfe48dc5..2531735b 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Oct-2025 23:59:24" {MEDLEY}COMPAREDIRECTORIES.;2 135376 +(FILECREATED " 8-Nov-2025 13:07:39" {WMEDLEY}COMPAREDIRECTORIES.;285 138536 :EDIT-BY rmk - :CHANGES-TO (FNS CDBROWSER-COPY) + :CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY) - :PREVIOUS-DATE "22-Oct-2025 08:32:01" {WMEDLEY}COMPAREDIRECTORIES.;272) + :PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}COMPAREDIRECTORIES.;280) (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS) @@ -1707,6 +1707,8 @@ (CDBROWSER [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS) + (* ;; "Edited 28-Oct-2025 14:49 by rmk") + (* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.") (* ;; "Creates a table browser for the differences in CDVALUE.") @@ -1752,7 +1754,7 @@ [SETQ BROWSER (TB.MAKE.BROWSER (FOR PAIR IN STRINGS COLLECT (CD.TABLEITEM PAIR)) WINDOW `(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA - ,(APPEND BROWSERPROPS (LIST 'CDVALUE CDVALUE] + (,@BROWSERPROPS (CDVALUE ,@CDVALUE] (ATTACHMENU (CREATE MENU TITLE _ " CD commands " MENUFONT _ DEFAULTFONT @@ -1893,7 +1895,8 @@ 'DON'T]) (CD.COMMANDSELECTEDFN - [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 6-Mar-2022 19:52 by rmk") + [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 28-Oct-2025 14:34 by rmk") + (* ; "Edited 6-Mar-2022 19:52 by rmk") (* ; "Edited 24-Feb-2022 19:52 by rmk") (* ; "Edited 5-Feb-2022 17:23 by rmk") (* ; "Edited 27-Jan-2022 17:46 by rmk") @@ -1944,7 +1947,8 @@ (LABEL1 (OR (CAR LABELS) FILE1)) (LABEL2 (OR (CADR LABELS) - FILE2))) + FILE2)) + TEMP) (DECLARE (SPECVARS . T)) (* ;; @@ -1958,6 +1962,16 @@ OF (FETCH (CDENTRY INFO2) OF CDENTRY))) (SETQ FILE2 NIL)) + (CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER + TBUSERDATA) + of CDBROWSER) + 'ORIGINALFILES FILE1)) + (SETQ FILE1 TEMP)) + (CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER + TBUSERDATA) + of CDBROWSER) + 'ORIGINALFILES FILE2)) + (SETQ FILE2 TEMP)) (* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.") @@ -1969,6 +1983,10 @@ (CD-MENUFN [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) + (* ;; "Edited 8-Nov-2025 13:06 by rmk") + + (* ;; "Edited 28-Oct-2025 17:35 by rmk") + (* ;; "Edited 26-Mar-2025 09:39 by rmk") (* ;; "Edited 18-Feb-2025 23:36 by rmk") @@ -1996,7 +2014,8 @@ (Compare (IF (AND FILE1 FILE2) THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP WINDOW - 'REGION)) + 'REGION) + CDBROWSER) ELSE (FLASHWINDOW T) (PRIN3 "Only one file" T))) (See% left (IF FILE1 @@ -2060,18 +2079,20 @@ NIL)))) (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT)) (Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT)) - (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T)) + (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT T)) (|Delete ALL <-| - (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL)) - (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T)) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT NIL)) + (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT T)) (|Delete ALL ->| - (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL)) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT NIL)) (SHOULDNT))) (CLOSEWITH CHILDREN WINDOW) (MOVEWITH CHILDREN WINDOW]) (CD-COMPARE-FILES - [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION) (* ; "Edited 22-May-2022 14:41 by rmk") + [LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION CDBROWSER) + (* ; "Edited 28-Oct-2025 10:42 by rmk") + (* ; "Edited 22-May-2022 14:41 by rmk") (PROG NIL (SETQ FILE1 (OR (STREAMP FILE1) (INFILEP FILE1))) @@ -2094,7 +2115,7 @@ `(,PARENTREGION 0.125) (IPLUS (FETCH (REGION BOTTOM) OF PARENTREGION ) - 20) + 70) NIL)))) (COMPILED (FLASHWINDOW T) (PRIN3 "Cannot compare compiled files" T)) @@ -2123,7 +2144,8 @@ NIL]) (CDBROWSER-COPY - [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 25-Oct-2025 23:58 by rmk") + [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Oct-2025 17:39 by rmk") + (* ; "Edited 25-Oct-2025 23:58 by rmk") (* ; "Edited 24-May-2022 15:49 by rmk") (* ; "Edited 25-Apr-2022 09:24 by rmk") (* ; "Edited 5-Feb-2022 17:27 by rmk") @@ -2137,7 +2159,7 @@ (* ;; "Returns NIL if the copy fails.") (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) - (PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER) + (PROG* ((CDVALUE (GETMULTI (TB.USERDATA CDBROWSER) 'CDVALUE)) (SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE)) (DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE)) @@ -2178,7 +2200,9 @@ (CL:UNLESS DESTFILE (SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR))) [SETQ RESULT (if UNIXDEST - then [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY + then (SPUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER) + 'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE)) + [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY (COPYFILE SOURCEFILE (PACKFILENAME 'HOST 'UNIX @@ -2197,7 +2221,8 @@ (RETURN RESULT)))]) (CDBROWSER-DELETE-FILE - [LAMBDA (CDBROWSER TBITEM SIDE ONLYONE SAVE) (* ; "Edited 25-Apr-2022 09:06 by rmk") + [LAMBDA (CDBROWSER TBITEM KEY SIDE ONLYONE SAVE DONTMARK) (* ; "Edited 28-Oct-2025 13:30 by rmk") + (* ; "Edited 25-Apr-2022 09:06 by rmk") (* ; "Edited 5-Feb-2022 17:46 by rmk") (* ; "Edited 18-Jan-2022 23:02 by rmk") (* ; "Edited 19-Dec-2021 23:33 by rmk") @@ -2210,38 +2235,58 @@ (* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.") + (DECLARE (USEDFREE LABEL1 LABEL2 PWINDOW)) (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) - [LET ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) - FILE OTHERFILE) - (SETQ FILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY))) - (SETQ OTHERFILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY))) - (CL:WHEN (EQ SIDE 'RIGHT) - (SWAP FILE OTHERFILE)) - (CL:WHEN FILE - (FOR F INSIDE (IF (FILENAMEFIELD.STRING FILE 'VERSION) - THEN [IF ONLYONE - THEN FILE - ELSE (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*" - 'BODY FILE] - ELSE FILE) - COLLECT + [LET + ((CDENTRY (CADR (fetch TIDATA of TBITEM))) + FILE OTHERFILE DELFILES) + (SETQ FILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO1) of CDENTRY))) + (SETQ OTHERFILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO2) of CDENTRY))) + (CL:WHEN (EQ SIDE 'RIGHT) + (SWAP FILE OTHERFILE) + (SWAP LABEL1 LABEL2)) + (SETQ DELFILES (if (FILENAMEFIELD.STRING FILE 'VERSION) + then [if ONLYONE + then (MKLIST FILE) + else (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*" + 'BODY FILE] + else FILE)) + (CL:WHEN DELFILES + (GIVE.TTY.PROCESS PWINDOW) + (CLEARW T) + (FLASHWINDOW T) + (CL:WHEN [OR (EQ KEY 'MIDDLE) + (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " (CL:IF (CDR DELFILES) + "ALL versions of " + "") + LABEL1 " ? "] + (for F in DELFILES + collect (* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).") - (IF SAVE - THEN (CL:UNLESS (RENAMEFILE F (PACKFILENAME.STRING - 'DIRECTORY - (CONCAT "deleted>" (FILENAMEFIELD.STRING - F - 'DIRECTORY)) - 'BODY F)) - (ERROR "Could not delete " F)) - ELSE (DELFILE FILE)) - F FINALLY + (* ;; "Save copies locally in this browser, for potential Undelete. Undelete would have to match all of the versions") + + (CL:UNLESS (if SAVE + then (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER + ) + 'ORIGINALFILES + (RENAMEFILE F (PACKFILENAME.STRING + 'DIRECTORY + (CONCAT "deleted>" + (FILENAMEFIELD.STRING + F + 'DIRECTORY)) + 'BODY F))) + else (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER) + 'ORIGINALFILES FILE (COPYFILE FILE '{NODIRCORE})) + (DELFILE FILE)) + (ERROR "Could not delete " F)) + F finally (* ;; "Perhaps only mark it as deleted if both files are gone?") - (TB.DELETE.ITEM CDBROWSER TBITEM)))])]) + (CL:UNLESS DONTMARK (TB.DELETE.ITEM CDBROWSER TBITEM)))))])]) (CD-SWAPDIRS [LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk") @@ -2258,38 +2303,43 @@ (RPAQ? CD-LINELENGTH NIL) -(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) - (Copy% -> CD-MENUFN) - (Copy% <- CD-MENUFN) - (See% left CD-MENUFN) - (See% right CD-MENUFN) - (See% both CD-MENUFN) - (See CD-MENUFN))) +(RPAQQ CDTABLEBROWSER.MENUITEMS + ((Compare CD-MENUFN) + (Copy% -> CD-MENUFN) + (Copy% <- CD-MENUFN) + (See% left CD-MENUFN) + (See% right CD-MENUFN) + (See% both CD-MENUFN) + (See CD-MENUFN) + (Delete% <- CD-MENUFN) + (|Delete ALL <-| CD-MENUFN) + (Delete% -> CD-MENUFN) + (|Delete ALL ->| CD-MENUFN))) (FILESLOAD (SYSLOAD) COMPARESOURCES COMPARETEXT) (MOVD? 'NILL 'TEDIT.FILEDATE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2655 23634 (COMPAREDIRECTORIES 2665 . 8000) (COMPAREDIRECTORIES.INFOS 8002 . 11231) ( -COMPAREDIRECTORIES.CANDIDATES 11233 . 14618) (CDENTRIES.SELECT 14620 . 19522) ( -COMPAREDIRECTORIES.INFOS.TYPE 19524 . 20868) (MATCHNAME 20870 . 21550) (CD.INSURECDVALUE 21552 . 23166 -) (CD.UPDATEWIDTHS 23168 . 23632)) (23635 34340 (CDFILES 23645 . 29742) (CDFILES.MATCH 29744 . 31369) -(CDFILES.PATS 31371 . 34338)) (34341 52359 (CDPRINT 34351 . 36868) (CDPRINT.HEADER 36870 . 37767) ( -CDPRINT.LINE 37769 . 41198) (CDPRINT.MAXWIDTHS 41200 . 45315) (CDPRINT.COLHEADERS 45317 . 46602) ( -CDPRINT.COLUMNS 46604 . 51724) (CDTEDIT 51726 . 52357)) (52360 61481 (CDMAP 52370 . 53802) (CDENTRY -53804 . 54113) (CDSUBSET 54115 . 55554) (CDMERGE 55556 . 59540) (CDMERGE.COMMON 59542 . 60857) ( -CD.SORT 60859 . 61479)) (61482 69020 (BINCOMP 61492 . 65781) (EOLTYPE 65783 . 68345) (EOLTYPE.SHOW -68347 . 69018)) (69548 82075 (FIND-UNCOMPILED-FILES 69558 . 73201) (FIND-UNSOURCED-FILES 73203 . 75587 -) (FIND-SOURCE-FILES 75589 . 77327) (FIND-COMPILED-FILES 77329 . 79206) (FIND-UNLOADED-FILES 79208 . -80061) (FIND-LOADED-FILES 80063 . 80491) (FIND-MULTICOMPILED-FILES 80493 . 82073)) (82076 90507 ( -CREATED-AS 82086 . 86883) (SOURCE-FOR-COMPILED-P 86885 . 89812) (COMPILE-SOURCE-DATE-DIFF 89814 . -90505)) (90508 101271 (FIX-DIRECTORY-DATES 90518 . 93968) (FIX-EQUIV-DATES 93970 . 95495) ( -COPY-COMPARED-FILES 95497 . 97318) (COPY-MISSING-FILES 97320 . 99477) (COMPILED-ON-SAME-SOURCE 99479 - . 101269)) (101465 109303 (CDBROWSER 101475 . 105402) (CDBROWSER.STRINGS 105404 . 109301)) (109465 -111201 (CD.TABLEITEM 109475 . 109695) (CD.TABLEITEM.PRINTFN 109697 . 109896) (CD.TABLEITEM.COPYFN -109898 . 110956) (CDTABLEBROWSER.HEADING.REPAINTFN 110958 . 111199)) (111202 134851 ( -CDTABLEBROWSER.WHENSELECTEDFN 111212 . 111680) (CD.COMMANDSELECTEDFN 111682 . 116783) (CD-MENUFN -116785 . 123011) (CD-COMPARE-FILES 123013 . 126365) (CDBROWSER-COPY 126367 . 131115) ( -CDBROWSER-DELETE-FILE 131117 . 134330) (CD-SWAPDIRS 134332 . 134849))))) + (FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) ( +COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) ( +COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179 +) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382) +(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) ( +CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) ( +CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY +53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) ( +CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW +68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600 +) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 . +80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 ( +CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 . +90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) ( +COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492 + . 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518 +111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN +109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 ( +CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN +117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) ( +CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 0fb8ccd9401cc917cbd3dd6e39301f4bf3f71ba5..7569b3987074290cd824519929ad9eea44eb7ce9 100644 GIT binary patch delta 3656 zcmZ`+U5p!7752;~*^S$5y_=QmxFJ0;`SBvWntSKRGpnfDS$mwFtaq+E9>-Z!$+WSP zU9^cqScp(V9icWs&{QPTh9FQ0Meu-l$R_LqrH!AEh>$8F5E6w45C|lsLJCiPp`1H2 z-t{_RA3XQobIv{I-us>Joc-M|#Xr0!ezTqhJ?FH)l%o<=fymQRep)s%kjvS7rZ<@X6uGiGNkdr1Z@=h%&9xX-UmM zJhT#Z>Fxtz_48tS$v^dlzwIoPr_D;ma*B7o)m!ml9XxBH0{*{WYE2nXt6FZ+^h_uL zk$@k=Mlqien70=BfI`WcgxI~E{>z<1x$)C6{5!lp9DLugkJZOlhRRQjj**cCVSUKH zw;B9E7w^*?zLA)uB`2Tt3aObl;%sBsfe{4)J zo55io+|jz;oljKnq`hkGczxUr4s(CU?5<(1xh779$LqHFbU83z6Zb^6=e_kOA0Zb$ z3U;~a1)nwHA6|23%zxu@QTV?9{^d;KrBGar#BKlaD|5mjzjo!*>5rnt*n@Czvp4^f z|D7v^&UZt{Z_dsHgU5mxW0!k}d9&LuxP2xHbNB2_As8<2+RiO*dp(0Y6KE02mLi${ z|BRkCPoLn{556~G^705@UTnI-?bzWb5zA^CfdzKls@vWiX!y#7GOI>21tBoUYUQHi zfu=~ldF#m`ji|v_HNv^7Q9kdeavloB2pzcst1N6D1PH z9Z6(E*%Zh+;=3ov8+`&5k!uxgFNb1~6+8-a3Z@6LtUeT;OvylaR5v;g#YfRW&l%0r zO=ncYkX+l5fuh?|*{se*$E4Kg3xiU8j4%v}H#vAq#L)Y~IK{7tXxc+z5Owo1h|+gv zqL3&If^Pf6AQGwt0UG%&0$uk%{QB;3qt9>fI+~ySMz$l%fOIg2P@ythEVfo!t1U2* zvvbc}1WnQ-sfwG1!h%8}an z<6K(J_VInkxadBB%^pOx0B)efEjeV#e@{P`9F5{g#Itd+eIb3EivP&65`(v%9h zyhJ7uV+1lBY!{Z#Hrp5ARQo)ZESV^Q(j-Ddhm6yPQ&=!zwGHRaFP~k_042EmkQp%u zWC1syj3WuFk1`~Z?EmW3)yK5WjP#FOofn4vuU+j3rMn}qZ5tZNgDFv>fxq+GFZPR1 zkH=!$X3T&uuCEF21(Y)r&|y*>`}HpWpVzK*1a&r8545oS41IMi_WOu!+31fQ`&dAK zShWgotqJj&vHgiazX5D-RJa1u^(@;vCX6vyO0!HPNH>z*Xu^^ci7rcy3ypnUHj2jk z#K3HF{VBGuk?sa|X))bMby>Q}QhU0hz(zMC+q2uhb$wQ7`G2{d+4k1j$HV@xzhC_C zU;R({$4V+zvJmeaS5eBTRN8`lRl?Vwohn*o%d@6}TCNx>YF8FH>wx0la#J1E0JA#J zYd@lGBYhQR>s|`gfg3sI0+N|kE+SrZu$_p$hzu38FyGUd!jfz|M30kSH=9IGOiBZq`)nAgSXJd(Q-Noa?{ ziw?u{6_{&blR41rP?c=$Y$$d%TiPLtt= zaDxhYzj{O8g82#nqlIJqA>RC z_Bl}y7Ux8q2%iaa{K4x@`|ZU`_D_rcfp5v3xU)WL{U|bLqluv(I*p0$(q%`$k0aj0 zT;CPudYUDBP3rmqmK+mCSsL@aM*!)cN5gqc@_EehRM&2#SxQWvi&HxkHJYabtE5QLB2ZraHfM;7O|X6i6LJ8p zglGAdUY)l$TNV^~0IfPj$Nv4B^eKvsKVqwgx@K6%vGgd$-Q>6b7=I43z4DC}H;&X0 f{*N{Z+5V!>%Xh!5XM^>)f4ScT`vm{*KWP6Ciy4A_ delta 2867 zcmZuzU2Ggz751#t{J4p+OE4h;^<>)AUeUGY-aCJ5MIqze+3v)%Gt10uwnhPycsKQe z<8{rV3aGNJ1W6>6w$2UIYD8Nq0fML4u0euQQyx(J01^@)R1olh;3-w#c;Erfo!RkE z5;gwR&bz!IV`1rUCjq@FJ zc|SLrDrX1AN{(w60^5r0BFOg-O@y)+2-BFs7ok7o?J z{$Hu{bY|`-fBGx`+JDZfR&B3H*T2|#eSjb6&gM+0Vbnz{vY-TcsMuc3iR=mI&O+u|<^b!+LM;p}oRzH6tf+Znnj-72jUX9OD1J^6=1|*mNa|msRO+ zeB^3b`VODDDi19ss<5Y;<;$o#%HO~G_|ZE(Vc$QK%}RRy1BYvc?n_Bj-8H%>!30Qt`k;6zZMkY zn^jPW388K0s>KrSy996}e4<7{eDyReuWT!ri6BfBhPFeYnt+YyL^)IgQyCO|uV6*M z7`Z1rMvS|{qo&rqCq9Y~q>oYE+xslysak=ZOA2Tt zwK}-7So}xd9_wOx0_TY`B1g%?v&H6ov(p3%sWNx!Sqx}qAY%k&PVaUb8C<_#C%U&BU;$(tO8y1&Z z3mq9KLGeA;h-oC(25?#+hl+bcyD#SReExcee{j7l?d8S`UFq=p&tBNm&wsQ0Ymi<; zTH15kikacYs^p!Hc`l}r(c$k8@E_l}`su!(PR4@RXl7_*rbndy;7>f~Ow4ODgPVmn zR{LJ$f98|YEI)Qr&a6Gpt((U)|C`~Bn`g=@eqI7B6_cB`7*2zo=wpTf(d2m1cJ0U> zk7pFqv8p(31>%6|l)rQ2V`b5rRyZZ58ZfGFxg&SELoyKeJgb7lVY@}3_@Lt@R6$Jx zosD!we};Cg=%=PY5r0*yFtshvkj>H{C}L>0R>i1;TFg!2DIkb&Y?iQYRf|p#B3zJE zdb1EQp1Ms!Vxmjak0A)|oe2?BG|3tfgxd3=^HblIyG+wy(l1UUXXW9n9fX2E8PmbT z&os6q6tNnc2~tYUsH*gYOx+gJJk&hrNuX4PvL8kWIkRVmBfJ<+fgqz;L-b4L)8EN=< zrks(a>2d}S(&rKse|WRu{CxU3=S_=$u)@0grZyhzU3Q21e=vnep1U$7;WCx^MRDyj z{$Py#_@9Q}KJJ6~Csz4`@l1{d>mxnG`1CC&?xszD@a@XR0dMZ;=ij=0!+Y$Px3ACP z_@xSg;v=>z@PL?6!43jHK(vUlm|#{Y42`dz8##mt?R5>&OuihB^dsl+%ddRtQGy7L wD@+iX2spbC`N1?072T&Ne*TtuOmGDzHcfdW;bj>u_4PMz{dIu<=ZB5|10K}Se*gdg diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index 0ec8b973..5c5ef0f1 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Oct-2025 10:24:30" {WMEDLEY}EXAMINEDEFS.;59 17123 +(FILECREATED "28-Oct-2025 14:24:17" {WMEDLEY}EXAMINEDEFS.;60 17313 :EDIT-BY rmk - :CHANGES-TO (FNS EXAMINEDEFS) + :CHANGES-TO (FNS EXAMINEFILES) - :PREVIOUS-DATE " 6-Apr-2025 23:54:50" {WMEDLEY}EXAMINEDEFS.;57) + :PREVIOUS-DATE "25-Oct-2025 10:24:30" {WMEDLEY}EXAMINEDEFS.;59) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -173,7 +173,8 @@ (EDITE DEF2]) (EXAMINEFILES - [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk") + [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 28-Oct-2025 14:23 by rmk") + (* ; "Edited 19-Jul-2023 13:48 by rmk") (* ; "Edited 1-Feb-2022 23:15 by rmk") (* ; "Edited 25-Jan-2022 10:08 by rmk") (* ; "Edited 2-Jan-2022 23:15 by rmk") @@ -183,7 +184,8 @@ (CL:UNLESS REGION (SETQ REGION (GETREGION))) - (LIST (AND (INFILEP FILE1) + (LIST (AND (OR (STREAMP FILE1) + (INFILEP FILE1)) (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) REGION 'RIGHT @@ -191,7 +193,8 @@ `(,REGION 0.5) (FETCH (REGION TOP) OF REGION)) NIL TITLE1)) - (AND (INFILEP FILE2) + (AND (OR (STREAMP FILE2) + (INFILEP FILE2)) (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) REGION 'LEFT @@ -284,6 +287,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT VERSIONDEFS) (DECLARE%: DONTCOPY - (FILEMAP (NIL (665 16892 (EXAMINEDEFS 675 . 11290) (EXAMINEFILES 11292 . 12774) (TEDITDEF 12776 . -15098) (EXVV 15100 . 16890))))) + (FILEMAP (NIL (666 17082 (EXAMINEDEFS 676 . 11291) (EXAMINEFILES 11293 . 12964) (TEDITDEF 12966 . +15288) (EXVV 15290 . 17080))))) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 4db3ff8c8dcb30b16ff0ffbf65926f996960a94c..afc886acbce4571a7eaec1dc69d45b8adbe246e0 100644 GIT binary patch delta 435 zcmZvXzfQtX7{%Mchy*92gNgB^E;OM{zuW(H0p)^CDs9?g+zg6?A#q~&2{e*E1g?a| zjnyac6?_eE(IAOT-=F*a&N+9{_-edf?|E8$H`bWJY>*W&DcyV zL;?Ae_oG24jCh8JM<|_s6k+{L*L4NM!T5f-k!QZ5R_i5yp7K`C+fdks2*pf3*>((& zYf^C|*Y}r>DuN{CS7F@Gw6=hYWBGLcDZf<@3Q3Z-+S7_C(rsnY+$o!B@my=k)8eCc z_GA%+S(s}X=OEKU%A=nIDes1H51xmxSGpwd2w5)DT_$ktHO%q;QH-r9vR9OYE*Ao& yuJ|k&KAL%)fD8)}@8qydl(Q-H!tO;bZa@OB8@jE+cb5%Fh2{V5Oq$PjUn<`RAZf<{ delta 382 zcmZvXze>YU6vl}nNQs*+g76WSM3Rtub8pf{2aCC>kGITFNS.;565 135222 +(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}GITFNS.;569 131593 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-CD-MENUFN GIT-MAKE-PROJECT GIT-CLONEP) + :CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES) - :PREVIOUS-DATE "25-Oct-2025 10:37:40" {WMEDLEY}GITFNS.;562) + :PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}GITFNS.;568) (PRETTYCOMPRINT GITFNSCOMS) @@ -59,7 +59,7 @@ (* ;; "File correspondents") (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) - (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) + (FNS TOGIT FROMGIT) (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) @@ -720,46 +720,6 @@ (CONCAT GF " cannot be copied")) T) DEST]) - -(GIT-DELETE-FILE - [LAMBDA (FILE PROJECT) (* ; "Edited 8-May-2022 09:27 by rmk") - (* ; "Edited 18-Jan-2022 23:07 by rmk") - (* ; "Edited 19-Dec-2021 16:11 by rmk") - (* ; "Edited 16-Dec-2021 13:00 by rmk") - - (* ;; "This deletes a file in the local checkout git directory {UNIX}... FILE has to already be a full file name, for safety.") - - (* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ") - - (* ;; "We could make this undoable by copying it to deleted/, but git also can restore.") - - (GIT-CLONEP FILE NIL T) - (DELFILE FILE]) - -(MYMEDLEY-DELETE-FILES - [LAMBDA (FILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") - (* ; "Edited 8-May-2022 23:31 by rmk") - - (* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.") - - (* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.") - - (SETQ FILE (CONTRACT.PH FILE (FETCH WHOST OF PROJECT))) - (CL:WHEN (EQ (FILENAMEFIELD (FETCH WHOST OF PROJECT) - 'HOST) - (FILENAMEFIELD FILE 'HOST)) - (FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE))) - COLLECT - - (* ;; - "Delete the earlier ones first, if it goes bad, you don't want them to persist") - - (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>" - (FILENAMEFIELD F - 'DIRECTORY)) - 'BODY F)) - (ERROR "Could not delete " F)) - F))]) ) (DEFINEQ @@ -1846,7 +1806,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 2-Oct-2025 23:12 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 28-Oct-2025 14:01 by rmk") + (* ; "Edited 2-Oct-2025 23:12 by rmk") (* ; "Edited 12-Jun-2024 22:52 by mth") (* ; "Edited 10-Jun-2024 18:42 by mth") (* ; "Edited 1-May-2024 14:58 by rmk") @@ -1938,8 +1899,10 @@ (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE)) " files") (LIST SHORT1 SHORT2) - `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT - ,PROJECT) + `((LABELFN . GIT-CD-LABELFN) + (BRANCH1 ,@BRANCH1) + (BRANCH2 ,@BRANCH2) + (PROJECT ,@PROJECT)) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See)) (SETQ NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE))) @@ -1952,6 +1915,8 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 28-Oct-2025 14:00 by rmk") + (* ;; "Edited 25-Oct-2025 23:32 by rmk") (* ;; "Edited 29-Apr-2025 15:14 by rmk") @@ -2031,9 +1996,12 @@ do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) " files")) - [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) - `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN - GIT-CD-LABELFN PROJECT ,PROJECT) + [CDBROWSER CDVAL TITLE `(,WPROJ ,@BRANCH2) + `((BRANCH1 ,@WPROJ) + (BRANCH2 ,@BRANCH2) + (SUBDIR ,@SUBDIR) + (LABELFN . GIT-CD-LABELFN) + (PROJECT ,@PROJECT)) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) @@ -2213,7 +2181,8 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 25-Oct-2025 23:44 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 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") (* ; "Edited 8-May-2022 09:26 by rmk") @@ -2221,35 +2190,9 @@ (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") - (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY)) + (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW)) (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 " ? "] - (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) - (|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) - " ? "] - (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM)) - 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) - " ? "))) - (GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT)) - (MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM))) (SHOULDNT]) @@ -2451,33 +2394,32 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4243 21049 (GIT-CLONEP 4253 . 5684) (GIT-INIT 5686 . 6316) (GIT-MAKE-PROJECT 6318 . -14107) (GIT-GET-PROJECT 14109 . 16034) (GIT-PUT-PROJECT-FIELD 16036 . 17677) (GIT-PROJECT-PATH 17679 - . 18723) (FIND-ANCESTOR-DIRECTORY 18725 . 19074) (GIT-FIND-CLONE 19076 . 20157) (GIT-MAINBRANCH 20159 - . 20554) (GIT-MAINBRANCH? 20556 . 21047)) (26512 31441 (PRC-COMMAND 26522 . 31439)) (31497 34285 ( -ALLSUBDIRS 31507 . 32793) (MEDLEYSUBDIRS 32795 . 33488) (GITSUBDIRS 33490 . 34283)) (34286 39076 ( -TOGIT 34296 . 35702) (FROMGIT 35704 . 36685) (GIT-DELETE-FILE 36687 . 37533) (MYMEDLEY-DELETE-FILES -37535 . 39074)) (39077 42080 (MYMEDLEYSUBDIR 39087 . 39543) (GITSUBDIR 39545 . 39988) (STRIPDIR 39990 - . 40361) (STRIPHOST 40363 . 40603) (STRIPNAME 40605 . 41358) (STRIPWHERE 41360 . 42078)) (42081 44316 - (GFILE4MFILE 42091 . 42787) (MFILE4GFILE 42789 . 43358) (GIT-REPO-FILENAME 43360 . 44314)) (44365 -54620 (GIT-COMMIT 44375 . 45201) (GIT-PUSH 45203 . 45963) (GIT-PULL 45965 . 46717) (GIT-APPROVAL 46719 - . 47068) (GIT-GET-FILE 47070 . 48985) (GIT-FILE-EXISTS? 48987 . 49261) (GIT-REMOTE-UPDATE 49263 . -50098) (GIT-REMOTE-ADD 50100 . 50407) (GIT-FILE-DATE 50409 . 51456) (GIT-FILE-HISTORY 51458 . 53392) ( -GIT-PRINT-FILE-HISTORY 53394 . 54444) (GIT-FETCH 54446 . 54618)) (54650 66130 (GIT-BRANCH-DIFF 54660 - . 61549) (GIT-COMMIT-DIFFS 61551 . 62442) (GIT-BRANCH-RELATIONS 62444 . 66128)) (66175 84914 ( -GIT-BRANCH-NUM 66185 . 66758) (GIT-CHECKOUT 66760 . 68046) (GIT-WHICH-BRANCH 68048 . 68455) ( -GIT-MAKE-BRANCH 68457 . 71036) (GIT-BRANCHES 71038 . 73633) (GIT-BRANCH-EXISTS? 73635 . 74506) ( -GIT-PICK-BRANCH 74508 . 74998) (GIT-BRANCH-MENU 75000 . 75881) (GIT-BRANCH-WHENSELECTEDFN 75883 . -77422) (GIT-PULL-REQUESTS 77424 . 81295) (GIT-SHORT-BRANCH-NAME 81297 . 81588) (GIT-LONG-NAME 81590 . -81907) (GIT-PRC-BRANCHES 81909 . 84912)) (84944 88392 (GIT-MY-CURRENT-BRANCH 84954 . 85324) ( -GIT-MY-BRANCHP 85326 . 85944) (GIT-MY-NEXT-BRANCH 85946 . 86440) (GIT-MY-BRANCHES 86442 . 88390)) ( -88438 92513 (GIT-ADD-WORKTREE 88448 . 90055) (GIT-REMOVE-WORKTREE 90057 . 90987) (GIT-LIST-WORKTREES -90989 . 91793) (WORKTREEDIR 91795 . 92511)) (92561 126762 (GIT-GET-DIFFERENT-FILES 92571 . 99479) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 99481 . 106920) (GIT-WORKING-COMPARE-DIRECTORIES 106922 . 112559) ( -GIT-COMPARE-WORKTREE 112561 . 116539) (GITCDOBJBUTTONFN 116541 . 121031) (GIT-CD-LABELFN 121033 . -122115) (GIT-CD-MENUFN 122117 . 124743) (GIT-WORKING-COMPARE-FILES 124745 . 125365) ( -GIT-BRANCHES-COMPARE-FILES 125367 . 126531) (GIT-PR-COMPARE 126533 . 126760)) (126832 135155 (CDGITDIR - 126842 . 127529) (GIT-COMMAND 127531 . 129089) (GITORIGIN 129091 . 129788) (GIT-INITIALS 129790 . -130094) (GIT-COMMAND-TO-FILE 130096 . 133581) (GIT-RESULT-TO-LINES 133583 . 134488) (STRIPLOCAL 134490 - . 135153))))) + (FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 . +14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632 + . 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112 + . 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 ( +ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 ( +TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR +37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) ( +STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) ( +GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) ( +GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS? +46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973 + . 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 . +52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) ( +GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324 + . 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197 +) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) ( +GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME +78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 ( +GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004) + (GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE +87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 ( +GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) ( +GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) ( +GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) ( +GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) ( +GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 . +125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 . +129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index bab7dfcc933210d33787ba9e69c4647ac1d9dff4..da2bc98b7f8783b479ba3cdfc38fb8c749b7fedc 100644 GIT binary patch delta 1725 zcmZ`)T}&KR6lQ=Dx@jY6F~XMA!vL~No$cH^{~J=-otcF#+a1_lerjSOvP&VYK!6k) zFccyFycqR92rX)S^ucJmzydGzsWCC8(b)KAjL(|b8XtTyo|)xm(RP!ad*=M!`e0j0sAP>6@@&4jB zPEXht`<{bp1BgTvLt+umVzt*BT7wYoN!k5zr!Os780>DlG*}8tG)z=CnA7u*xgYp^ zee3T|?M78)S*3Zr41cdxb!=9=d53$K`DZt{-`IoMSGaeWFsGcEaLrfTM~B~ABE`k@ zkFw>tbKE@pa<1MlLT5bVq~e|NBuIt?2|L-D=>kbt^S{m&xERqPJ2o=92Wt3mf(OYsvyT)%QWt zaGR!+G$R?%R1HiknsNrxb_z6E&v!4~=lbPRw5CCm6fh?yZ?r(W02;Cu&xR{z**mKy zDhGI~28DEA)QYD-)s+KiRZVAaEqD4f1^DwkXo}2!T8?re^RF~FiNK>uMD(7D6^pJ! zkNH3%BD**LEc25`Q=M!E5$p75i>2u!zk{cR76tD~SZ9^sq;Q>GWI%YN#bD z%TCxCTX2UNsN389h6+b4iUyH%cc0s6iag(A0F@~uBbV%0+)h|Psf;A;U$jG+%;gY{ zh-s(OKyjL4iAcI@AfB|G0iYtmcE^(hh;BTk9KjLWFGp0eUydlGq#VJc9Tq1#NUdL0~)#cp>k670DhL!3mkcq|nzAPySf?a-C+=Ge1Sl>$O1iIBt-=wRip z7fK6!s<&1%t}3Cv)O1Yt{~65C_19M5Kg5l9ocT z67|vplyoHidZ5QjRe!)XX)9HzhgL1eiuO{er%F|kTG6VfR#p3UHcm`RBW3oRnKy6V zy!XvFzICPZE7p1S;7T>>93PERkt!f2k|dr~l&Mo8OY_J-7Xf3g`jeDv|53utXJevBpA+EIa7DdRLL~Zs67HPDe_IGE^b_? z0Fe|*DZ4Bfi*zHJH|>Fp&89wF9o2J=Z5ASsEV$-=%NZy}4Rq#3th7ZeCM7K?i&Gas zpmn9=o6zDus}wcNoLMrX?1ymo5igJk1eOH?fsWq6p~d(O^e*z+Wq~k}0Bt=J(7;E$~j4=R4KW(IEsq$HxL3pY$*v z=$(U)8{^Bx4&I+@dY5>nJSg6LWLJdcLT5j>81d$O$er#6dAUGoB#}?uV^_oND^e7VhJeaU-X95A`sF?#)d0!dSnzT z)#2)B6+)1ZAmn!{dyuNF8ne%PV)flU)6S|-7jy->bY6*L3woQKlXrwS*}}1g@H_i# z?1*rMts7T1%~g*hzr-ny^}%lZW2eTq%VT^1`^$KJX4*hlCaT9b$F=$_3?2`RsqZUg z5z_jD@oAw#WvC3DI8i-YJ$<}-4rDCJTpuJg0R`9Di#b9pLE25(dX|EuXfv1~raq^Q zXfBmTn&U>Y1}#iA%BJpZVn4m28VLxCZSK!SK*og5ACuxLgmqMgqi3s7tX3nKbxbjw z7#gmg3$cmw8-yUceSR-{bbgBvtUvqeZ9yp4Ke%wPW6|F{4|f88vZa@d9heW^w|MJw z+mU%^t}%HQyV=W^CZwPFu$RU_I4-HJWNFBa8J=oLOWjDj&Vi!oB1hHw_S%<1O(E^a z0!@}cA31Zr2X;k4!z1D;K%?ko=2RM{xs_K9sn0cGE`O?5sF_@<2@1u5H0M4hrd0to zF3wg!W&0*}2jj@MogvUv%5F@gg*f|uVoO&XLLnBKOtb3bcFfw-k9P~(+CKM0}BFOs5wHjD5Xne7*EEm)yvA zFzfyh+i`u3z*lbA{6rx0U9i`#hikG7#jG=sGi;hRqqigT1!wgeVO)q;(z1u zM6*4fgf>5jgtw~19^A;*km)%ygE=K0<-L0l-2)U!-Qqk&CeLC`g)%<;GT11q6bvq) zJt)AaQv|)X3<)ejbwVi25P)u+}!0^y8Z1oqoq74O;B zdW7w(#}U0z-^Lns5z&wJ7+cx!#`+sQ?4^c==-oz?eb?}27c_y1L498U9DR6C@Ad*b;JE#k-G{`@7gDYn_4tS3 iOufCH<);a&O|M1c8`HgPD!q#RGQ9$Y^PlN;OaBG_C2ynv From 696d34cb9d7f83b90ae56cd1bebf36cea61ea4e9 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Tue, 18 Nov 2025 11:17:46 -0800 Subject: [PATCH 4/4] Add BACKGROUND-YIELD to Lisp.sysout (and thus to FULL.SYSOUT) so you don't need to load it in INITs. (#2357) * Add BACKGROUND-YIELD to Lisp.sysout (and thus to FULL.SYSOUT) so you don't need to load it in INITs. * remove CAUSE-INTERRUPT subr call; doesn't add value --- internal/loadups/LOADUP-LISP | 15 ++++++++++----- internal/loadups/LOADUP-LISP.LCOM | Bin 3607 -> 3704 bytes lispusers/BACKGROUND-YIELD | 15 ++++++++------- lispusers/BACKGROUND-YIELD.LCOM | Bin 1215 -> 1239 bytes 4 files changed, 18 insertions(+), 12 deletions(-) diff --git a/internal/loadups/LOADUP-LISP b/internal/loadups/LOADUP-LISP index a84822fe..23875a66 100644 --- a/internal/loadups/LOADUP-LISP +++ b/internal/loadups/LOADUP-LISP @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Oct-2025 16:55:27" |{WMEDLEY}loadups>LOADUP-LISP.;22| 7104 +(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333 - :EDIT-BY |rmk| + :EDIT-BY "lmm" :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE "18-Aug-2025 12:09:49" |{WMEDLEY}loadups>LOADUP-LISP.;21|) + :PREVIOUS-DATE "16-Oct-2025 16:55:27" +|{DSK}larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -19,7 +20,8 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA (DRIBBLEFILE) (* \; "Edited 16-Oct-2025 16:55 by rmk") + (LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm") + (* \; "Edited 16-Oct-2025 16:55 by rmk") (* \; "Edited 18-Aug-2025 12:08 by rmk") (* \; "Edited 15-Jun-2025 14:39 by rmk") (* \; "Edited 24-May-2025 10:20 by rmk") @@ -126,7 +128,10 @@ (* |;;| " Added late, LOAD late to avoid any dependencies") + (* |;;| "prevent medley from pinning CPU") + (LOADUP '(XCL-LOOP XCL-HASH-LOOP)) + (LOADUP '(BACKGROUND-YIELD)) (* |;;| " networking code -- should make it optional but too many cross dependencies") @@ -144,5 +149,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (640 6898 (LOADUP-LISP 650 . 6896))))) + (FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125))))) STOP diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM index 4662329ca85cfa8e28932042e3f6c814cc40c491..3a1d86082e364029f635560cfc3fcdf3f8043af9 100644 GIT binary patch delta 548 zcmbu5F;Bu!6ope!GALXLIp00!VfB0UcK;eSWT$^FBL!`MvZ*Voj!OcF!co6_ z+KIw8^m`xxA74_hdbQmchJ&FIwFZL=qZ1i6qZSJc)A5<>5X*@At@hdJ(6DNRHtMov zdiAv}6iaD>`iCi&^di!+DnNXg8-%~4IHeq&w0g(k=)JH=>U9q$uF>bp^*;fsCP=)v zV_K}@GU79uQvNM7)$gETjQJ(d88v;m9DopYy8bvs|_qs0hJi$MM4KGq;R2ut}A9f#(oAm2vVq7jeY|W$z2BqJdZ@mFlir zYdBO6OlDCjdCU4a9&ibPSg|e7CazE1T~A8Z<`43G>Ts*H=}3T!>4k6FOiCW-!#N(1 KhQ^tNT=oYNvYdYVX zQQl-{<)~&-;8=-YPGbx?C4KqlJhhq=H<>s)~`u0nd$Q)A@K3g)obO z1Nzu^iRF;N)A=}FL`giHq@~>95+N!8%gO2*M8`Hj zijM7ffsSJeT(jpmu+FGftC>9^H!JG2a>le65zbcP2f_@3XQ7mS>x$ zLsnk?lPMt$T%$$&f!{V<0t!m^3KK?3Y2h{Hi+&kubp(9Fb$r+G0>iuT1vY&yUL62$ ddM&Hp7N90)iokYBcKInrJAgFAuEO1N;TPGJd)WX0 diff --git a/lispusers/BACKGROUND-YIELD b/lispusers/BACKGROUND-YIELD index 00d4ded4..aa634972 100644 --- a/lispusers/BACKGROUND-YIELD +++ b/lispusers/BACKGROUND-YIELD @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Jul-2023 09:49:24" {DSK}larry>il>medley>lispusers>BACKGROUND-YIELD.;2 1770 +(FILECREATED " 9-Nov-2025 11:52:07" {DSK}larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;2 1882 :EDIT-BY "lmm" :CHANGES-TO (FNS BACKGROUND-YIELD) - :PREVIOUS-DATE "14-Nov-2021 22:05:58" {DSK}larry>il>medley>lispusers>BACKGROUND-YIELD.;1 + :PREVIOUS-DATE "28-Jul-2023 09:49:24" {DSK}larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;1 ) @@ -26,13 +26,14 @@ (DEFINEQ (BACKGROUND-YIELD - [LAMBDA NIL (* ; "Edited 28-Jul-2023 09:11 by lmm") + [LAMBDA NIL (* ; "Edited 9-Nov-2025 11:50 by lmm") + (* ; "Edited 28-Jul-2023 09:11 by lmm") (* ; "Edited 20-Sep-2021 11:37 by larry") (LET ((\BACKGROUND T)) - (DECLARE (SPECVARS \BACKGROUND)) + (DECLARE (SPECVARS \BACKGROUND) + (GLOBALVARS BACKGROUND-YIELD)) (IF (FIXP BACKGROUND-YIELD) - THEN (SUBRCALL YIELD BACKGROUND-YIELD) - (SUBRCALL CAUSE-INTERRUPT]) + THEN (SUBRCALL YIELD BACKGROUND-YIELD]) (INIT-YIELD [LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry") @@ -51,5 +52,5 @@ (RPAQQ BACKGROUND-YIELD 833333) (DECLARE%: DONTCOPY - (FILEMAP (NIL (806 1655 (BACKGROUND-YIELD 816 . 1271) (INIT-YIELD 1273 . 1653))))) + (FILEMAP (NIL (808 1767 (BACKGROUND-YIELD 818 . 1383) (INIT-YIELD 1385 . 1765))))) STOP diff --git a/lispusers/BACKGROUND-YIELD.LCOM b/lispusers/BACKGROUND-YIELD.LCOM index 3e46012bd7930d3cffd5490382a1dd3abd3e84e5..c44c58fca41aea5dc4fafa0b867de795b1733bec 100644 GIT binary patch delta 439 zcmdnbd7X1YxQK$Ku3vtcu91O}se+-Qm8p@Hf%(L2$@R6q1Tk zlk;;6GILT>6u6Qz67$kii&d=@(2Y>Y%u`Tu3{Hd{!%csurQiDfzidr$U@hvGzSz| z#tH_ORwkBKMnLaz5oPpbekN-*O$7#VMg|6kOhHD51R%{|tgwX(%&5J@D8S(7>BFUA UXg+x%i?9$z@MvysV6tZd0RAL&e*gdg delta 429 zcmcc4xu0`FxQLO3u2*S}u91O}v4Vl6m5HU5k;%kt$@+}^+*G@q#G;}~yUZNB+|-nu z)JnUY%;JL5;?$yIJ10kHZ}%YoP(K&lNKaQE7d>kuO$8+*BNW37O|1+Jl@yYSQj_y@ z3o>(3QxuXj67$kii&d?-6wr-O$jnnvatrnGQ2-iK4|kNFo}Q9IN@596GdA;0l{C3D z+&q0;or7E*LtI^eim>=dNuk;$*t^z-XkYQcy`^AiZf-Dn5~GW?p^2_vei