1
0
mirror of synced 2026-01-26 20:31:53 +00:00

rmk122--Next round on fonts and MCCS (#2280)

* A revision to the font, Unicode, Tedit, and other modules to implement the MCCS character coding as the standard for internal text strings.  MCCS is a variant of XCCS with arrows switched with circumflex/underscore and $ switched with currency, and allows for additional code assignments over time. :MCCS replaces :XCCS as the default external format, especially for source files.  The file XCCS is removed in favor of the file MCCS, which includes the XCCS external format for backward compatibility.

* This includes a single Medley-font formatted font file for each of the family/size/face display fonts.  The glyph assignments correspond to the MCCS character encoding (except for fonts with idiosyncratic encodings--Hippo, Symbol).  All charsets from legacy font files are included in each file, and the character sets and glyphs in each file have also been extended by offline coercion from related families (e.g. Glyphs not in legacy Terminal are taken from legacy Modern). There should be fewer black boxes, and character-display shouldn't change when you switch fonts.

* The Unicode mapping tables have been redefined to set up correspondences between Unicode and MCCS, not XCCS.  Separate XCCS to/from MCCS mapping functions are provided in the file MCCS; they are no longer included in INTERPRESS.

* TEDIT converts characters in legacy fonts to their new MCCS codes as it reads formatted files, marks the file as MCCS compatible and preserves the new codes on writing.

* Default keyboard assignments produce the MCCS uparrow and leftarrow for shift-6 and shift-hyphen, use Function-6 for circumflex and Function-10 for underscore.

See documentation in FONTCODECHANGES.TEDIT MCCS.TEDIT MEDLEYFONTFORMAT.TEDIT in docs/internal, and library/UNICODE.TEDIT.
This commit is contained in:
rmkaplan
2025-10-20 17:17:34 -07:00
committed by GitHub
parent 54353a4bef
commit 82fc95ce18
401 changed files with 8871 additions and 6601 deletions

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Aug-2025 22:34:31" {WMEDLEY}<lispusers>EDITFONT.;33 24939
(FILECREATED " 7-Oct-2025 14:56:00" {WMEDLEY}<lispusers>EDITFONT.;40 26223
:EDIT-BY rmk
:CHANGES-TO (FNS EDITFONT EF.EDITBM EF.CHARITEMS EF.SAVE)
:CHANGES-TO (RECORDS CHARITEM)
(FNS EDITFONT)
:PREVIOUS-DATE "27-Aug-2025 22:50:51" {WMEDLEY}<lispusers>EDITFONT.;30)
:PREVIOUS-DATE " 6-Oct-2025 15:58:41" {WMEDLEY}<lispusers>EDITFONT.;39)
(PRETTYCOMPRINT EDITFONTCOMS)
@@ -80,7 +81,8 @@
(WINDOWPROP WINDOW 'MENU NIL])
(EF.CHARITEMS
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Aug-2025 11:34 by rmk")
[LAMBDA (FONT CHARSET ROWMAJOR) (* ; "Edited 5-Oct-2025 14:42 by rmk")
(* ; "Edited 29-Aug-2025 11:34 by rmk")
(* ; "Edited 27-Aug-2025 22:50 by rmk")
(* ; "Edited 4-Aug-2025 00:14 by rmk")
(* ; "Edited 25-Jul-2025 10:06 by rmk")
@@ -88,14 +90,20 @@
(* ;; "Get CHARITEMS for CHARSET in FONT. Sort them in column-major order to build an array that corresponds to the tables in Unicode and XCCS.")
(for ROW from 0 to 15 join (for COL CODE from 0 to 15
collect (SETQ CODE (LOGOR (LLSH CHARSET 8)
(IPLUS (TIMES COL 16)
ROW)))
(create CHARITEM
BITMAP _ (GETCHARBITMAP CODE FONT)
CHARCODE _ CODE
SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT])
(if ROWMAJOR
then (for C8 from 0 to \MAXTHINCHAR as C from (LLSH CHARSET 8)
collect (create CHARITEM
BITMAP _ (GETCHARBITMAP C FONT)
CHARCODE _ C8
SLUGCHARP _ (SLUGCHARP.DISPLAY C FONT)))
else (for ROW from 0 to 15 join (for COL CODE from 0 to 15
collect (SETQ CODE (LOGOR (LLSH CHARSET 8)
(IPLUS (TIMES COL 16)
ROW)))
(create CHARITEM
BITMAP _ (GETCHARBITMAP CODE FONT)
CHARCODE _ CODE
SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT])
(EF.BUTTONEVENTFN
[LAMBDA (WINDOW) (* kbr%: "16-Oct-85 22:19")
@@ -179,15 +187,16 @@
(REDISPLAYW (WFROMMENU MENU])
(EF.DELETE
[LAMBDA (CHARITEM MENU) (* ; "Edited 4-Aug-2025 13:14 by rmk")
[LAMBDA (CHARITEM MENU) (* ; "Edited 2-Sep-2025 23:03 by rmk")
(* ; "Edited 4-Aug-2025 13:14 by rmk")
(* kbr%: "15-Dec-84 15:20")
(* ;
 "Turn CHARITEM into a slug charitem.")
(LET ((WINDOW (WFROMMENU MENU))
SLUGBITMAP)
[SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO (WINDOWPROP
WINDOW
'FONT)
[SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO (WINDOWPROP
WINDOW
'FONT)
(WINDOWPROP WINDOW 'CHARSET]
(UNINTERRUPTABLY
(replace (CHARITEM BITMAP) of CHARITEM with SLUGBITMAP)
@@ -233,7 +242,8 @@
(T (LISPERROR "ILLEGAL ARG" BITMAP])
(EF.SAVE
[LAMBDA (WINDOW) (* ; "Edited 29-Aug-2025 11:35 by rmk")
[LAMBDA (WINDOW) (* ; "Edited 2-Sep-2025 23:03 by rmk")
(* ; "Edited 29-Aug-2025 11:35 by rmk")
(* ; "Edited 4-Aug-2025 09:22 by rmk")
(* ; "Edited 2-Aug-2025 08:47 by rmk")
(* kbr%: "21-Oct-85 15:39")
@@ -255,12 +265,12 @@
(* ;; "We'll install the slugbm at the end, include its dimensions")
(SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO FONT CHARSET)))
(SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO FONT CHARSET)))
(SETQ SLUGWIDTH (fetch (BITMAP BITMAPWIDTH) of SLUGBM))
(add CBWIDTH SLUGWIDTH)
(SETQ CBHEIGHT (IMAX CBHEIGHT (fetch (BITMAP BITMAPHEIGHT) of SLUGBM)))
(SETQ CB (BITMAPCREATE CBWIDTH CBHEIGHT))
(SETQ CSINFO (create CHARSETINFO copying (\XGETCHARSETINFO FONT CHARSET)
(SETQ CSINFO (create CHARSETINFO copying (\GETCHARSETINFO FONT CHARSET)
CHARSETBITMAP _ CB))
(SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO))
(SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO))(* ; "Store new info in allocations")
@@ -325,6 +335,7 @@
(BLANKCHARSETCREATE
[LAMBDA (FAMILY SIZE FACE CHARSET FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTH)
(* ; "Edited 2-Sep-2025 23:03 by rmk")
(* ; "Edited 4-Aug-2025 13:29 by rmk")
(* mjs "27-Mar-85 14:48")
(* ; "Edited 3-Aug-2025 17:53 by rmk")
@@ -343,7 +354,7 @@
(PROG (ROTATION DEVICE FONT CSINFO SLUGWIDTH OFFSETS WIDTHS SLUGOFFSET CB CBWIDTH CBHEIGHT)
(SETQ FONT (\FONT.CHECKARGS FAMILY SIZE FACE 0 'DISPLAY CHARSET))
[if (type? FONTDESCRIPTOR FONT)
then (CL:WHEN (SETQ CSINFO (\XGETCHARSETINFO FONT CHARSET))
then (CL:WHEN (SETQ CSINFO (\GETCHARSETINFO FONT CHARSET))
(RETURN FONT))
else (SPREADFONTSPEC FONT)
(SETQ FONT
@@ -418,7 +429,10 @@
(RETURN FONT])
(EDITFONT
[LAMBDA (FONT CHARSET) (* ; "Edited 29-Aug-2025 22:34 by rmk")
[LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG) (* ; "Edited 7-Oct-2025 14:55 by rmk")
(* ; "Edited 5-Oct-2025 15:06 by rmk")
(* ; "Edited 4-Sep-2025 09:27 by rmk")
(* ; "Edited 29-Aug-2025 22:34 by rmk")
(* ; "Edited 17-Aug-2025 12:03 by rmk")
(* ; "Edited 3-Aug-2025 23:25 by rmk")
(* ; "Edited 2-Aug-2025 10:11 by rmk")
@@ -429,20 +443,23 @@
(SETQ CHARSET (OR (CHARSET.DECODE CHARSET)
0))
(LET (CHARITEMS MENU TITLE HEIGHT WIDTH REGION POS WINDOW)
(SETQ CHARITEMS (EF.CHARITEMS FONT CHARSET))
(SETQ CHARITEMS (EF.CHARITEMS FONT CHARSET ROWMAJOR))
(SETQ MENU (create MENU
MENUFONT _ FONT
CENTERFLG _ T
MENUCOLUMNS _ 16
MENUCOLUMNS _ (OR NCOLUMNS 16)
ITEMS _ CHARITEMS
WHENSELECTEDFN _ (FUNCTION EF.WHENSELECTEDFN)))
(SETQ TITLE (PACK* (FONTPROP FONT 'FAMILY)
" "
(FONTPROP FONT 'SIZE)
" "
(PACKC (for ATOM in (FONTPROP FONT 'FACE) collect (CHCON1 ATOM)))
(FONTFACETOATOM (FONTPROP FONT 'FACE))
" "
(OCTALSTRING CHARSET)))
(OCTALSTRING CHARSET)
(CL:IF TITLETAG
(CONCAT " " TITLETAG)
"")))
(PUTMENUPROP MENU 'EDITFONTTITLE TITLE)
(SETQ HEIGHT (HEIGHTIFWINDOW (fetch (MENU IMAGEHEIGHT) of MENU)
T))
@@ -462,7 +479,7 @@
YCOORD _ 0))
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION EF.BUTTONEVENTFN))
(MODERNWINDOW WINDOW)
WINDOW])
FONT])
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -477,10 +494,10 @@
(EF.INIT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1141 16132 (EF.INIT 1151 . 1785) (EF.PROMPT 1787 . 2369) (EF.MESSAGE 2371 . 2583) (
EF.CLOSEFN 2585 . 3112) (EF.CHARITEMS 3114 . 4436) (EF.BUTTONEVENTFN 4438 . 4850) (EF.WHENSELECTEDFN
4852 . 5256) (EF.EDITBM 5258 . 6752) (EF.MIDDLEBUTTONFN 6754 . 6999) (EF.CHANGESIZE 7001 . 8330) (
EF.DELETE 8332 . 9407) (EF.ENTER 9409 . 10350) (EF.REPLACE 10352 . 11325) (EF.SAVE 11327 . 15424) (
COPYFONT 15426 . 15701) (READSTRIKEFONTFILE 15703 . 16130)) (16133 24751 (BLANKCHARSETCREATE 16143 .
22120) (EDITFONT 22122 . 24749)))))
(FILEMAP (NIL (1147 16865 (EF.INIT 1157 . 1791) (EF.PROMPT 1793 . 2375) (EF.MESSAGE 2377 . 2589) (
EF.CLOSEFN 2591 . 3118) (EF.CHARITEMS 3120 . 4956) (EF.BUTTONEVENTFN 4958 . 5370) (EF.WHENSELECTEDFN
5372 . 5776) (EF.EDITBM 5778 . 7272) (EF.MIDDLEBUTTONFN 7274 . 7519) (EF.CHANGESIZE 7521 . 8850) (
EF.DELETE 8852 . 10033) (EF.ENTER 10035 . 10976) (EF.REPLACE 10978 . 11951) (EF.SAVE 11953 . 16157) (
COPYFONT 16159 . 16434) (READSTRIKEFONTFILE 16436 . 16863)) (16866 26035 (BLANKCHARSETCREATE 16876 .
22961) (EDITFONT 22963 . 26033)))))
STOP

Binary file not shown.

View File

@@ -1,29 +1,28 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Apr-2025 15:17:37" {WMEDLEY}<lispusers>GITFNS.;541 134267
(FILECREATED "23-Sep-2025 21:43:21" {WMEDLEY}<lispusers>GITFNS.;551 134847
:EDIT-BY rmk
:CHANGES-TO (VARS GITFNSCOMS)
(FNS GIT-WORKING-COMPARE-DIRECTORIES)
:CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES)
:PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539)
:PREVIOUS-DATE "22-Sep-2025 12:52:41" {WMEDLEY}<lispusers>GITFNS.;550)
(PRETTYCOMPRINT GITFNSCOMS)
(RPAQQ GITFNSCOMS
(RPAQQ GITFNSCOMS
(
(* ;; "Set up")
(* ;; "Set up")
(FILES (SYSLOAD FROM LISPUSERS)
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER
)
(* ;; "")
(* ;; "")
(* ;; "GIT projects")
(* ;; "GIT projects")
(COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD
GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH
@@ -44,94 +43,94 @@
(P (GIT-INIT))
(ADDVARS (AROUNDEXITFNS GIT-INIT))
(* ;; "")
(* ;; "")
(* ;; "Lisp exec commands")
(* ;; "Lisp exec commands")
(INITVARS (GIT-MERGE-COMPARES T)
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
(COMMANDS gwc bbc prc cob b? cdg cdw)
(FNS PRC-COMMAND)
(* ;; "")
(* ;; "")
(* ;; "File correspondents")
(* ;; "File correspondents")
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
(FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
(* ;; "")
(* ;; "")
(* ;; "Git commands")
(* ;; "Git commands")
(FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS?
GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY
GIT-FETCH)
(* ;; "Differences")
(* ;; "Differences")
(FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
(* ;; "")
(* ;; "")
(* ;; "Branches")
(* ;; "Branches")
(FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES
GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-BRANCH-WHENSELECTEDFN
GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
(* ;; "My branches")
(* ;; "My branches")
(FNS GIT-MY-CURRENT-BRANCH GIT-MY-BRANCHP GIT-MY-NEXT-BRANCH GIT-MY-BRANCHES)
(* ;; "")
(* ;; "")
(* ;; "Worktrees")
(* ;; "Worktrees")
(FNS GIT-ADD-WORKTREE GIT-REMOVE-WORKTREE GIT-LIST-WORKTREES WORKTREEDIR)
(* ;; "")
(* ;; "")
(* ;; "Comparisons")
(* ;; "Comparisons")
(FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES
GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN
GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE)
(INITVARS (FROMGITN 0))
(* ;; "")
(* ;; "")
(* ;; "Utilities")
(* ;; "Utilities")
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES
STRIPLOCAL)
(PROPS (GITFNS FILETYPE))))
(PROPS (GITFNS FILETYPE))))
(* ;; "Set up")
(* ;; "Set up")
(FILESLOAD (SYSLOAD FROM LISPUSERS)
(FILESLOAD (SYSLOAD FROM LISPUSERS)
COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER)
(* ;; "")
(* ;; "")
(* ;; "GIT projects")
(* ;; "GIT projects")
(DEFINEQ
@@ -402,15 +401,15 @@
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
)
)
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
(RPAQ? GIT-DEFAULT-PROJECTS
(RPAQ? GIT-DEFAULT-PROJECTS
'((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
(greetfiles scripts sources library lispusers internal doctools rooms))
(NOTECARDS)
@@ -418,120 +417,120 @@
(TEST)
(MAIKO)))
(RPAQ? GIT-PROJECTS NIL)
(RPAQ? GIT-PROJECTS NIL)
(RPAQ? GIT-PRC-MENUS NIL)
(RPAQ? GIT-PRC-MENUS NIL)
(GIT-INIT)
(GIT-INIT)
(ADDTOVAR AROUNDEXITFNS GIT-INIT)
(ADDTOVAR AROUNDEXITFNS GIT-INIT)
(* ;; "")
(* ;; "")
(* ;; "Lisp exec commands")
(* ;; "Lisp exec commands")
(RPAQ? GIT-MERGE-COMPARES T)
(RPAQ? GIT-MERGE-COMPARES T)
(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
(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")
(* ;; "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)))
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
PROJECT)
(SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL)
(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)))
THEN (SETQ PROJECT (CAR STAIL))
(GO $$OUT))
(CAR STAIL)))
(GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
(* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
(* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-FETCH PROJECT)
(SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-FETCH PROJECT)
(SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
((NIL T)
(GIT-MY-CURRENT-BRANCH PROJECT))
(GIT-MY-CURRENT-BRANCH PROJECT))
((LOCAL REMOTE ORIGIN)
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
(OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
(OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
BRANCH1)))
(SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
(SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
((NIL T)
(GIT-MAINBRANCH PROJECT LOCAL))
(GIT-MAINBRANCH PROJECT LOCAL))
((LOCAL REMOTE ORIGIN)
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
(OR (GIT-LONG-NAME BRANCH2 NIL PROJECT)
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
(OR (GIT-LONG-NAME BRANCH2 NIL PROJECT)
BRANCH2)))
(GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
(GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
LOCAL PROJECT))
(DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT)
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
(PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
(PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name. Default is to bring up a menu of locally available branches.")
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name. Default is to bring up a menu of locally available branches.")
(CL:UNLESS (STRINGP NEXTTITLESTRING)
(SETQ PROJECT NEXTTITLESTRING))
(CL:UNLESS (STRINGP NEXTTITLESTRING)
(SETQ PROJECT NEXTTITLESTRING))
(CL:UNLESS PROJECT
(CL:WHEN (GIT-GET-PROJECT BRANCH NIL T)
(SETQ PROJECT BRANCH)
(SETQ BRANCH NIL)))
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-FETCH PROJECT)
(SELECTQ (U-CASE BRANCH)
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
(CL:WHEN (GIT-GET-PROJECT BRANCH NIL T)
(SETQ PROJECT BRANCH)
(SETQ BRANCH NIL)))
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-FETCH PROJECT)
(SELECTQ (U-CASE BRANCH)
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
PROJECT))
((NEW NEXT)
(GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT))
(CL:WHEN [SETQ BRANCH (IF BRANCH
THEN (GIT-LONG-NAME BRANCH NIL PROJECT)
ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
(GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT))
(CL:WHEN [SETQ BRANCH (IF BRANCH
THEN (GIT-LONG-NAME BRANCH NIL PROJECT)
ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
T)
" branches"]
(GIT-CHECKOUT BRANCH PROJECT))))
(GIT-CHECKOUT BRANCH PROJECT))))
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-FETCH PROJECT)
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-FETCH PROJECT)
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
T)
" "
(GIT-WHICH-BRANCH PROJECT)))
(GIT-WHICH-BRANCH PROJECT)))
(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
(SETQ SUBDIR PROJECT)
(SETQ PROJECT GIT-DEFAULT-PROJECT))
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
(CHARCODE (> /]
(SETQ SUBDIR (CONCAT SUBDIR "/")))
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST)
(OR SUBDIR "")))
(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
(SETQ SUBDIR PROJECT)
(SETQ PROJECT GIT-DEFAULT-PROJECT))
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
(CHARCODE (> /]
(SETQ SUBDIR (CONCAT SUBDIR "/")))
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST)
(OR SUBDIR "")))
T))
(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
(SETQ SUBDIR PROJECT)
(SETQ PROJECT GIT-DEFAULT-PROJECT))
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
(CHARCODE (> /]
(SETQ SUBDIR (CONCAT SUBDIR "/")))
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
(OR SUBDIR "")))
(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
(SETQ SUBDIR PROJECT)
(SETQ PROJECT GIT-DEFAULT-PROJECT))
(CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
(CHARCODE (> /]
(SETQ SUBDIR (CONCAT SUBDIR "/")))
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
(OR SUBDIR "")))
T))
(DEFINEQ
@@ -617,12 +616,12 @@
(* ;; "")
(* ;; "")
(* ;; "File correspondents")
(* ;; "File correspondents")
(DEFINEQ
@@ -865,12 +864,12 @@
(* ;; "")
(* ;; "")
(* ;; "Git commands")
(* ;; "Git commands")
(DEFINEQ
@@ -1074,7 +1073,7 @@
(* ;; "Differences")
(* ;; "Differences")
(DEFINEQ
@@ -1187,14 +1186,16 @@
T])
(GIT-COMMIT-DIFFS
[LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 2-May-2024 11:24 by mth")
[LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 5-May-2025 21:59 by rmk")
(* ; "Edited 29-Apr-2025 22:08 by rmk")
(* ; "Edited 2-May-2024 11:24 by mth")
(* ; "Edited 26-Jun-2022 13:32 by rmk")
(* ; "Edited 7-May-2022 23:48 by rmk")
(* ; "Edited 2-May-2022 13:45 by rmk")
(* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2")
(GIT-COMMAND (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"^" BUTNOTBRANCH2 "%"")
(GIT-COMMAND (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"­" BUTNOTBRANCH2 "%"")
NIL NIL PROJECT])
(GIT-BRANCH-RELATIONS
@@ -1262,12 +1263,12 @@
(* ;; "")
(* ;; "")
(* ;; "Branches")
(* ;; "Branches")
(DEFINEQ
@@ -1466,7 +1467,8 @@
'(PROGN (DSPFONT OLDVALUE T])])
(GIT-PULL-REQUESTS
[LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 20-May-2024 22:12 by rmk")
[LAMBDA (INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2025 11:39 by rmk")
(* ; "Edited 20-May-2024 22:12 by rmk")
(* ; "Edited 13-May-2024 18:59 by rmk")
(* ; "Edited 11-May-2024 10:51 by rmk")
(* ; "Edited 1-May-2024 09:23 by rmk")
@@ -1493,7 +1495,7 @@
PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
PRSTATUS _ (CL:IF DRAFT
'D
(CL:IF (STREQUAL "REVIEW_REQUIRED"
(CL:IF (STREQUAL "REVIEW¬REQUIRED"
(JSON-GET JSOBJ 'reviewDecision))
" "
'A))
@@ -1575,7 +1577,7 @@
(* ;; "My branches")
(* ;; "My branches")
(DEFINEQ
@@ -1642,12 +1644,12 @@
(* ;; "")
(* ;; "")
(* ;; "Worktrees")
(* ;; "Worktrees")
(DEFINEQ
@@ -1718,12 +1720,12 @@
(* ;; "")
(* ;; "")
(* ;; "Comparisons")
(* ;; "Comparisons")
(DEFINEQ
@@ -1731,6 +1733,10 @@
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT)
(DECLARE (USEDFREE FROMGITN))
(* ;; "Edited 23-Sep-2025 21:42 by rmk")
(* ;; "Edited 22-Sep-2025 12:48 by rmk")
(* ;; "Edited 12-Sep-2022 14:58 by rmk")
(* ;; "Edited 21-May-2022 23:38 by rmk")
@@ -1742,97 +1748,98 @@
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT))
(SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT))
(LET
(MAPPINGS FROMGIT (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT)))
(CL:WHEN DIFFS
(SETQ FROMGIT (PACK* '{FROMGIT (add FROMGITN 1)
'}))
(PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (fetch PROJECTNAME of PROJECT)
">"
(DATE)
">"))
(LET (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF BRANCH1 BRANCH2 PROJECT)))
(CL:WHEN DIFFS
(SETQ FROMGIT (PACK* "{FROMGIT" (add FROMGITN 1)
"}"))
(* ;; "UNSLASHIT because CORE doesn't know about slash")
(* ;; "If both origin/, strip it out of subdirectories")
(CL:UNLESS DIR1
(SETQ DIR1 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH1)
">")))
(CL:UNLESS DIR2
(SETQ DIR2 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH2)
">")))
(for D in DIFFS
do (SELECTQ (CAR D)
(ADDED (* ;
(SETQ PRNAME (MTOUSTRING (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T)
(STRPOS "origin/" BRANCH2 NIL T))
(SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ ")))
BRANCH2)))
(PSEUDOHOST FROMGIT (CONCAT "{DSK}<tmp>" (fetch PROJECTNAME of PROJECT)
"-PR--" PRNAME "--" (DATE)
">"))
(CL:UNLESS DIR1
(SETQ DIR1 (CONCAT FROMGIT "<master>")))
(CL:UNLESS DIR2
(SETQ DIR2 (CONCAT FROMGIT "<pr>")))
(for D in DIFFS
do
(SELECTQ (CAR D)
(ADDED (* ;
 "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?")
(SETQ D (CADR D))
(OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
T PROJECT)
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
T PROJECT)))
(DELETED
(* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.")
(SETQ D (CADR D))
(OR (GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
T PROJECT)
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
T PROJECT)))
(DELETED
(* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2. But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted. Try for both, but don't cause an error.")
(SETQ D (CADR D))
(OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
T PROJECT)
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
T PROJECT)))
(CHANGED (* ; "Should exist in both branches")
(SETQ D (CADR D))
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
T PROJECT)
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
T PROJECT))
((RENAMED COPIED)
(SETQ D (CADR D))
(OR (GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
T PROJECT)
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
T PROJECT)))
(CHANGED (* ; "Should exist in both branches")
(SETQ D (CADR D))
(GIT-GET-FILE BRANCH1 D (CONCAT DIR1 D)
T PROJECT)
(GIT-GET-FILE BRANCH2 D (CONCAT DIR2 D)
T PROJECT))
((RENAMED COPIED)
(* ;; "These entries are from-to filename pairs. If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in BRANCH2 and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up. ")
(* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.")
(* ;; "If renamed and then changed, for now treat as unrelated adds and deletes: put both files in the fromgit directory. Perhaps the mapping should still figure out how to relate them.")
(* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.")
(* ;; "For copied files, presumably 2 files are exactly the same. But we hope we can show them on the same line, by virtue of the mapping.")
[LET ((GFILE (CDR D))
F1 F1)
[LET ((GFILE (CDR D))
F1 F2)
(* ;; "GFILE is a triple (F2 F1 N )")
(* ;; "GFILE is a triple (F2 F1 N )")
(* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")
(* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")
(SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE)
(CONCAT DIR1 (CADR GFILE))
T PROJECT))
(SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE)
(CONCAT DIR2 (CADR GFILE))
T PROJECT))
(SETQ F1 (GIT-GET-FILE BRANCH1 (CADR GFILE)
(CONCAT DIR1 (CADR GFILE))
T PROJECT))
(SETQ F2 (GIT-GET-FILE BRANCH2 (CADR GFILE)
(CONCAT DIR2 (CADR GFILE))
T PROJECT))
(* ;; "Let the directories figure it out")
(* ;; "Let the directories figure it out")
(AND NIL (if (EQ (CADDR GFILE)
100)
then
(AND NIL (if (EQ (CADDR GFILE)
100)
then
(* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to. Maybe the first one should always be one that exists, the second may just be a useful name. But we have to know whether to match against INFO1 or INFO2")
(HELP GFILE 100)
(push MAPPINGS
(LIST (LIST)
(FULLNAME F1)
(SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE))
)
T)
(NTHCHAR (CAR D)
1)
100))
else
(* ;;
(HELP GFILE 100)
(push MAPPINGS
(LIST (LIST)
(FULLNAME F1)
(SLASHIT (U-CASE (CONCAT DIR2
(CAR GFILE)))
T)
(NTHCHAR (CAR D)
1)
100))
else
(* ;;
 "If not a perfect match, then the directory should figure it out")
(GIT-GET-FILE BRANCH2 (CAR GFILE)
(CONCAT DIR2 (CAR GFILE))
T PROJECT])
(HELP "UNKNOWN GIT-DIFF TAG" D)))
(LIST DIR1 DIR2 MAPPINGS))])
(GIT-GET-FILE BRANCH2 (CAR GFILE)
(CONCAT DIR2 (CAR GFILE))
T PROJECT])
(HELP "UNKNOWN GIT-DIFF TAG" D)))
(LIST DIR1 DIR2 MAPPINGS))])
(GIT-BRANCHES-COMPARE-DIRECTORIES
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Jun-2024 22:52 by mth")
@@ -2273,16 +2280,16 @@
RB NIL PROJECT])
)
(RPAQ? FROMGITN 0)
(RPAQ? FROMGITN 0)
(* ;; "")
(* ;; "")
(* ;; "Utilities")
(* ;; "Utilities")
(DEFINEQ
@@ -2430,35 +2437,35 @@
STRING])
)
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4225 20804 (GIT-CLONEP 4235 . 5563) (GIT-INIT 5565 . 6195) (GIT-MAKE-PROJECT 6197 .
13862) (GIT-GET-PROJECT 13864 . 15789) (GIT-PUT-PROJECT-FIELD 15791 . 17432) (GIT-PROJECT-PATH 17434
. 18478) (FIND-ANCESTOR-DIRECTORY 18480 . 18829) (GIT-FIND-CLONE 18831 . 19912) (GIT-MAINBRANCH 19914
. 20309) (GIT-MAINBRANCH? 20311 . 20802)) (26471 31400 (PRC-COMMAND 26481 . 31398)) (31448 34236 (
ALLSUBDIRS 31458 . 32744) (MEDLEYSUBDIRS 32746 . 33439) (GITSUBDIRS 33441 . 34234)) (34237 39027 (
TOGIT 34247 . 35653) (FROMGIT 35655 . 36636) (GIT-DELETE-FILE 36638 . 37484) (MYMEDLEY-DELETE-FILES
37486 . 39025)) (39028 42031 (MYMEDLEYSUBDIR 39038 . 39494) (GITSUBDIR 39496 . 39939) (STRIPDIR 39941
. 40312) (STRIPHOST 40314 . 40554) (STRIPNAME 40556 . 41309) (STRIPWHERE 41311 . 42029)) (42032 43934
(GFILE4MFILE 42042 . 42405) (MFILE4GFILE 42407 . 42976) (GIT-REPO-FILENAME 42978 . 43932)) (43975
54230 (GIT-COMMIT 43985 . 44811) (GIT-PUSH 44813 . 45573) (GIT-PULL 45575 . 46327) (GIT-APPROVAL 46329
. 46678) (GIT-GET-FILE 46680 . 48595) (GIT-FILE-EXISTS? 48597 . 48871) (GIT-REMOTE-UPDATE 48873 .
49708) (GIT-REMOTE-ADD 49710 . 50017) (GIT-FILE-DATE 50019 . 51066) (GIT-FILE-HISTORY 51068 . 53002) (
GIT-PRINT-FILE-HISTORY 53004 . 54054) (GIT-FETCH 54056 . 54228)) (54256 65376 (GIT-BRANCH-DIFF 54266
. 61013) (GIT-COMMIT-DIFFS 61015 . 61688) (GIT-BRANCH-RELATIONS 61690 . 65374)) (65413 84799 (
GIT-BRANCH-NUM 65423 . 65996) (GIT-CHECKOUT 65998 . 67284) (GIT-WHICH-BRANCH 67286 . 67693) (
GIT-MAKE-BRANCH 67695 . 70274) (GIT-BRANCHES 70276 . 72871) (GIT-BRANCH-EXISTS? 72873 . 73744) (
GIT-PICK-BRANCH 73746 . 74236) (GIT-BRANCH-MENU 74238 . 75119) (GIT-BRANCH-WHENSELECTEDFN 75121 .
77660) (GIT-PULL-REQUESTS 77662 . 81180) (GIT-SHORT-BRANCH-NAME 81182 . 81473) (GIT-LONG-NAME 81475 .
81792) (GIT-PRC-BRANCHES 81794 . 84797)) (84825 88273 (GIT-MY-CURRENT-BRANCH 84835 . 85205) (
GIT-MY-BRANCHP 85207 . 85825) (GIT-MY-NEXT-BRANCH 85827 . 86321) (GIT-MY-BRANCHES 86323 . 88271)) (
88311 92386 (GIT-ADD-WORKTREE 88321 . 89928) (GIT-REMOVE-WORKTREE 89930 . 90860) (GIT-LIST-WORKTREES
90862 . 91666) (WORKTREEDIR 91668 . 92384)) (92426 125819 (GIT-GET-DIFFERENT-FILES 92436 . 98860) (
GIT-BRANCHES-COMPARE-DIRECTORIES 98862 . 106093) (GIT-WORKING-COMPARE-DIRECTORIES 106095 . 111802) (
GIT-COMPARE-WORKTREE 111804 . 115782) (GITCDOBJBUTTONFN 115784 . 120274) (GIT-CD-LABELFN 120276 .
121358) (GIT-CD-MENUFN 121360 . 123800) (GIT-WORKING-COMPARE-FILES 123802 . 124422) (
GIT-BRANCHES-COMPARE-FILES 124424 . 125588) (GIT-PR-COMPARE 125590 . 125817)) (125881 134204 (CDGITDIR
125891 . 126578) (GIT-COMMAND 126580 . 128138) (GITORIGIN 128140 . 128837) (GIT-INITIALS 128839 .
129143) (GIT-COMMAND-TO-FILE 129145 . 132630) (GIT-RESULT-TO-LINES 132632 . 133537) (STRIPLOCAL 133539
. 134202)))))
(FILEMAP (NIL (4193 20772 (GIT-CLONEP 4203 . 5531) (GIT-INIT 5533 . 6163) (GIT-MAKE-PROJECT 6165 .
13830) (GIT-GET-PROJECT 13832 . 15757) (GIT-PUT-PROJECT-FIELD 15759 . 17400) (GIT-PROJECT-PATH 17402
. 18446) (FIND-ANCESTOR-DIRECTORY 18448 . 18797) (GIT-FIND-CLONE 18799 . 19880) (GIT-MAINBRANCH 19882
. 20277) (GIT-MAINBRANCH? 20279 . 20770)) (26235 31164 (PRC-COMMAND 26245 . 31162)) (31220 34008 (
ALLSUBDIRS 31230 . 32516) (MEDLEYSUBDIRS 32518 . 33211) (GITSUBDIRS 33213 . 34006)) (34009 38799 (
TOGIT 34019 . 35425) (FROMGIT 35427 . 36408) (GIT-DELETE-FILE 36410 . 37256) (MYMEDLEY-DELETE-FILES
37258 . 38797)) (38800 41803 (MYMEDLEYSUBDIR 38810 . 39266) (GITSUBDIR 39268 . 39711) (STRIPDIR 39713
. 40084) (STRIPHOST 40086 . 40326) (STRIPNAME 40328 . 41081) (STRIPWHERE 41083 . 41801)) (41804 43706
(GFILE4MFILE 41814 . 42177) (MFILE4GFILE 42179 . 42748) (GIT-REPO-FILENAME 42750 . 43704)) (43755
54010 (GIT-COMMIT 43765 . 44591) (GIT-PUSH 44593 . 45353) (GIT-PULL 45355 . 46107) (GIT-APPROVAL 46109
. 46458) (GIT-GET-FILE 46460 . 48375) (GIT-FILE-EXISTS? 48377 . 48651) (GIT-REMOTE-UPDATE 48653 .
49488) (GIT-REMOTE-ADD 49490 . 49797) (GIT-FILE-DATE 49799 . 50846) (GIT-FILE-HISTORY 50848 . 52782) (
GIT-PRINT-FILE-HISTORY 52784 . 53834) (GIT-FETCH 53836 . 54008)) (54040 65378 (GIT-BRANCH-DIFF 54050
. 60797) (GIT-COMMIT-DIFFS 60799 . 61690) (GIT-BRANCH-RELATIONS 61692 . 65376)) (65423 84918 (
GIT-BRANCH-NUM 65433 . 66006) (GIT-CHECKOUT 66008 . 67294) (GIT-WHICH-BRANCH 67296 . 67703) (
GIT-MAKE-BRANCH 67705 . 70284) (GIT-BRANCHES 70286 . 72881) (GIT-BRANCH-EXISTS? 72883 . 73754) (
GIT-PICK-BRANCH 73756 . 74246) (GIT-BRANCH-MENU 74248 . 75129) (GIT-BRANCH-WHENSELECTEDFN 75131 .
77670) (GIT-PULL-REQUESTS 77672 . 81299) (GIT-SHORT-BRANCH-NAME 81301 . 81592) (GIT-LONG-NAME 81594 .
81911) (GIT-PRC-BRANCHES 81913 . 84916)) (84948 88396 (GIT-MY-CURRENT-BRANCH 84958 . 85328) (
GIT-MY-BRANCHP 85330 . 85948) (GIT-MY-NEXT-BRANCH 85950 . 86444) (GIT-MY-BRANCHES 86446 . 88394)) (
88442 92517 (GIT-ADD-WORKTREE 88452 . 90059) (GIT-REMOVE-WORKTREE 90061 . 90991) (GIT-LIST-WORKTREES
90993 . 91797) (WORKTREEDIR 91799 . 92515)) (92565 126387 (GIT-GET-DIFFERENT-FILES 92575 . 99428) (
GIT-BRANCHES-COMPARE-DIRECTORIES 99430 . 106661) (GIT-WORKING-COMPARE-DIRECTORIES 106663 . 112370) (
GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120842) (GIT-CD-LABELFN 120844 .
121926) (GIT-CD-MENUFN 121928 . 124368) (GIT-WORKING-COMPARE-FILES 124370 . 124990) (
GIT-BRANCHES-COMPARE-FILES 124992 . 126156) (GIT-PR-COMPARE 126158 . 126385)) (126457 134780 (CDGITDIR
126467 . 127154) (GIT-COMMAND 127156 . 128714) (GITORIGIN 128716 . 129413) (GIT-INITIALS 129415 .
129719) (GIT-COMMAND-TO-FILE 129721 . 133206) (GIT-RESULT-TO-LINES 133208 . 134113) (STRIPLOCAL 134115
. 134778)))))
STOP

Binary file not shown.

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -1,13 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-May-2023 09:12:17" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;12 101009
(FILECREATED "21-Sep-2025 09:50:47" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;13 100936
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (FNS PFI.PRINT.FILECREATED)
:CHANGES-TO (VARS PRETTYFILEINDEXCOMS)
:PREVIOUS-DATE " 3-Jul-2022 15:28:08" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;11
)
:PREVIOUS-DATE "10-May-2023 09:12:17"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;12)
(PRETTYCOMPRINT PRETTYFILEINDEXCOMS)
@@ -47,8 +48,7 @@
(INITVARS [*PFI-PRINTOPTIONS* '(REGION (72 54 504 702]
(*PFI-DONT-SPAWN*)
(*PFI-MAX-WASTED-LINES* 12)
[*PFI-CHARACTER-TRANSLATIONS* '((INTERPRESS (95 172)
(96 169 FAMILY CLASSIC)
[*PFI-CHARACTER-TRANSLATIONS* '((INTERPRESS (96 169 FAMILY CLASSIC)
(39 185 FAMILY CLASSIC]
(*PFI-INDEX-ORDER* '(FUNCTIONS))
[*PFI-DEFINER-PROPS* (LET ((*PACKAGE* (if (EQ MAKESYSNAME :LYRIC)
@@ -1023,8 +1023,7 @@
(RPAQ? *PFI-MAX-WASTED-LINES* 12)
(RPAQ? *PFI-CHARACTER-TRANSLATIONS* '((INTERPRESS (95 172)
(96 169 FAMILY CLASSIC)
(RPAQ? *PFI-CHARACTER-TRANSLATIONS* '((INTERPRESS (96 169 FAMILY CLASSIC)
(39 185 FAMILY CLASSIC))))
(RPAQ? *PFI-INDEX-ORDER* '(FUNCTIONS))
@@ -1194,28 +1193,28 @@
'NON.PFI.PRINT.BITMAP NIL T)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (9974 12209 (PFI.NEW.LISTFILES1 9984 . 10478) (PFI.ENQUEUE 10480 . 11104) (
\PFI.DO.HARDCOPY 11106 . 11692) (MAYBE.PRETTYFILEINDEX 11694 . 12207)) (12210 34725 (PRETTYFILEINDEX
12220 . 26253) (PFI.MAKE.LPT.STREAM 26255 . 29306) (PFI.SETUP.TRANSLATIONS 29308 . 30822) (
PFI.OUTCHARFN 30824 . 32798) (PFI.COLLECT.DEFINERS 32800 . 33612) (PFI.AFTER.NEW.PAGE 33614 . 34723))
(34726 41240 (PFI.PRINT.FILECREATED 34736 . 39427) (PFI.PRINT.TO.TAB 39429 . 39874) (
PFI.PRINT.ENVIRONMENT 39876 . 41238)) (41241 48756 (PFI.PROCESS.FILE 41251 . 42481) (PFI.PASS.COMMENT
42483 . 43453) (PFI.HANDLE.EXPR 43455 . 44122) (PFI.DEFAULT.HANDLER 44124 . 46177) (PFI.PRETTYPRINT
46179 . 46514) (PFI.LINES.REMAINING 46516 . 46843) (PFI.MAYBE.NEW.PAGE 46845 . 47679) (
PFI.ESTIMATE.SIZE 47681 . 48212) (PFI.ESTIMATE.SIZE1 48214 . 48754)) (48793 59002 (PFI.HANDLE.RPAQQ
48803 . 50211) (PFI.HANDLE.DECLARE 50213 . 51152) (PFI.HANDLE.EVAL-WHEN 51154 . 51637) (
PFI.HANDLE.DEFDEFINER 51639 . 52929) (PFI.HANDLE.DEFINEQ 52931 . 53175) (PFI.PRINT.LAMBDA 53177 .
53515) (PFI.PRINT.LAMBDA.BODY 53517 . 53852) (PFI.HANDLE.PUTDEF 53854 . 54351) (PFI.HANDLE.PUTPROPS
54353 . 54968) (PFI.HANDLE./DECLAREDATATYPE 54970 . 55517) (PFI.HANDLE.* 55519 . 56781) (
PFI.PRINT.COMMENTS 56783 . 58405) (PFI.HANDLE.FILEMAP 58407 . 58695) (PFI.HANDLE.PACKAGE 58697 . 59000
)) (59030 60022 (PFI.PREVIEW.DECLARE 59040 . 59702) (PFI.PREVIEW.DEFINEQ 59704 . 60020)) (60058 71046
(PFI.PRINT.INDEX 60068 . 60919) (PFI.CONDENSE.INDEX 60921 . 62728) (PFI.SORT.INDICES 62730 . 63869) (
PFI.COMPUTE.INDEX.SHAPE 63871 . 65335) (PFI.PRINT.INDICES 65337 . 69879) (PFI.CENTER.PRINT 69881 .
70451) (PFI.INDEX.BREAK 70453 . 70911) (PFI.LOOKUP.NAME 70913 . 71044)) (71047 72278 (PFI.ADD.TO.INDEX
71057 . 71567) (PFI.VARNAME 71569 . 71979) (PFI.CONSTANTNAMES 71981 . 72276)) (72313 80626 (
MULTIFILEINDEX 72323 . 73119) (MULTIFILEINDEX1 73121 . 74577) (PFI.PRINT.MULTI.INDEX 74579 . 79682) (
PFI.CHOOSE.BEST 79684 . 79911) (PFI.MERGE.INDICES 79913 . 80624)) (80683 83752 (PFI.MAYBE.SEE.PRETTY
80693 . 82476) (PFI.MAYBE.PP.DEFINITION 82478 . 83750)) (83822 91932 (PFI.PRINT.BITMAP 83832 . 91930))
(94701 97815 (PUTPROPS.PRETTYPRINT 94711 . 96122) (RPAQX.PRETTYPRINT 96124 . 96849) (
COURIERPROGRAM.PRETTYPRINT 96851 . 97551) (MAYBE.PRETTYPRINT.BOLD 97553 . 97813)))))
(FILEMAP (NIL (9955 12190 (PFI.NEW.LISTFILES1 9965 . 10459) (PFI.ENQUEUE 10461 . 11085) (
\PFI.DO.HARDCOPY 11087 . 11673) (MAYBE.PRETTYFILEINDEX 11675 . 12188)) (12191 34706 (PRETTYFILEINDEX
12201 . 26234) (PFI.MAKE.LPT.STREAM 26236 . 29287) (PFI.SETUP.TRANSLATIONS 29289 . 30803) (
PFI.OUTCHARFN 30805 . 32779) (PFI.COLLECT.DEFINERS 32781 . 33593) (PFI.AFTER.NEW.PAGE 33595 . 34704))
(34707 41221 (PFI.PRINT.FILECREATED 34717 . 39408) (PFI.PRINT.TO.TAB 39410 . 39855) (
PFI.PRINT.ENVIRONMENT 39857 . 41219)) (41222 48737 (PFI.PROCESS.FILE 41232 . 42462) (PFI.PASS.COMMENT
42464 . 43434) (PFI.HANDLE.EXPR 43436 . 44103) (PFI.DEFAULT.HANDLER 44105 . 46158) (PFI.PRETTYPRINT
46160 . 46495) (PFI.LINES.REMAINING 46497 . 46824) (PFI.MAYBE.NEW.PAGE 46826 . 47660) (
PFI.ESTIMATE.SIZE 47662 . 48193) (PFI.ESTIMATE.SIZE1 48195 . 48735)) (48774 58983 (PFI.HANDLE.RPAQQ
48784 . 50192) (PFI.HANDLE.DECLARE 50194 . 51133) (PFI.HANDLE.EVAL-WHEN 51135 . 51618) (
PFI.HANDLE.DEFDEFINER 51620 . 52910) (PFI.HANDLE.DEFINEQ 52912 . 53156) (PFI.PRINT.LAMBDA 53158 .
53496) (PFI.PRINT.LAMBDA.BODY 53498 . 53833) (PFI.HANDLE.PUTDEF 53835 . 54332) (PFI.HANDLE.PUTPROPS
54334 . 54949) (PFI.HANDLE./DECLAREDATATYPE 54951 . 55498) (PFI.HANDLE.* 55500 . 56762) (
PFI.PRINT.COMMENTS 56764 . 58386) (PFI.HANDLE.FILEMAP 58388 . 58676) (PFI.HANDLE.PACKAGE 58678 . 58981
)) (59011 60003 (PFI.PREVIEW.DECLARE 59021 . 59683) (PFI.PREVIEW.DEFINEQ 59685 . 60001)) (60039 71027
(PFI.PRINT.INDEX 60049 . 60900) (PFI.CONDENSE.INDEX 60902 . 62709) (PFI.SORT.INDICES 62711 . 63850) (
PFI.COMPUTE.INDEX.SHAPE 63852 . 65316) (PFI.PRINT.INDICES 65318 . 69860) (PFI.CENTER.PRINT 69862 .
70432) (PFI.INDEX.BREAK 70434 . 70892) (PFI.LOOKUP.NAME 70894 . 71025)) (71028 72259 (PFI.ADD.TO.INDEX
71038 . 71548) (PFI.VARNAME 71550 . 71960) (PFI.CONSTANTNAMES 71962 . 72257)) (72294 80607 (
MULTIFILEINDEX 72304 . 73100) (MULTIFILEINDEX1 73102 . 74558) (PFI.PRINT.MULTI.INDEX 74560 . 79663) (
PFI.CHOOSE.BEST 79665 . 79892) (PFI.MERGE.INDICES 79894 . 80605)) (80664 83733 (PFI.MAYBE.SEE.PRETTY
80674 . 82457) (PFI.MAYBE.PP.DEFINITION 82459 . 83731)) (83803 91913 (PFI.PRINT.BITMAP 83813 . 91911))
(94628 97742 (PUTPROPS.PRETTYPRINT 94638 . 96049) (RPAQX.PRETTYPRINT 96051 . 96776) (
COURIERPROGRAM.PRETTYPRINT 96778 . 97478) (MAYBE.PRETTYPRINT.BOLD 97480 . 97740)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long