Compatibility with new underscore/circumflex assignments
This commit is contained in:
rmkaplan
@@ -1,16 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11 14599
|
||||
(FILECREATED " 2-Sep-2025 12:06:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;14 14825
|
||||
|
||||
:CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
|
||||
(VARS UNIXCOMMCOMS)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
|
||||
:CHANGES-TO (FNS FORK-UNIX)
|
||||
|
||||
:PREVIOUS-DATE "29-Apr-2025 22:45:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;13)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNIXCOMMCOMS)
|
||||
|
||||
@@ -75,8 +74,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
else (SUBRCALL UNIX-HANDLECOMM 4])
|
||||
|
||||
(FORK-UNIX
|
||||
[LAMBDA (STR) (* ; "Edited 25-May-88 15:47 by drc:")
|
||||
(SUBRCALL UNIX-HANDLECOMM 0 (\DTEST STR 'ONED-ARRAY])
|
||||
[LAMBDA (STR) (* ; "Edited 2-Sep-2025 12:03 by rmk")
|
||||
(* ; "Edited 29-Apr-2025 22:45 by rmk")
|
||||
(* ; "Edited 25-May-88 15:47 by drc:")
|
||||
|
||||
(* ;; "MTOUBYTES converts MCCS codes to Unicodes, and then lays out the bytes of the UTF-8 encoding of those characters. ")
|
||||
|
||||
(SUBRCALL UNIX-HANDLECOMM 0 (MTOUTF8STRING (\DTEST STR 'ONED-ARRAY])
|
||||
|
||||
(UNIX-KILL
|
||||
[LAMBDA (CONN) (* ; "Edited 25-May-88 16:04 by drc:")
|
||||
@@ -316,12 +320,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1963 7028 (FORK-SHELL 1973 . 3170) (FORK-UNIX 3172 . 3348) (UNIX-KILL 3350 . 3539) (
|
||||
UNIX-WRITE 3541 . 4252) (CREATE-SHELL-STREAM 4254 . 5138) (CREATE-PROCESS-STREAM 5140 . 5979) (
|
||||
UNIXCOMM-AROUNDEXITFN 5981 . 7026)) (7076 12267 (INITIALIZE-SHELL-DEVICE 7086 . 8514) (
|
||||
UNIX-GET-NEXT-BUFFER 8516 . 10716) (UNIX-BACKFILEPTR 10718 . 11130) (UNIX-STREAM-EOFP 11132 . 11613) (
|
||||
UNIX-STREAM-OUT 11615 . 11871) (UNIX-STREAM-CLOSE 11873 . 12265)) (12515 14221 (
|
||||
CREATE-UNIX-SOCKET-STREAM 12525 . 13331) (ACCEPT-UNIX-SOCKET-STREAM 13333 . 14219)))))
|
||||
(FILEMAP (NIL (1903 7339 (FORK-SHELL 1913 . 3110) (FORK-UNIX 3112 . 3659) (UNIX-KILL 3661 . 3850) (
|
||||
UNIX-WRITE 3852 . 4563) (CREATE-SHELL-STREAM 4565 . 5449) (CREATE-PROCESS-STREAM 5451 . 6290) (
|
||||
UNIXCOMM-AROUNDEXITFN 6292 . 7337)) (7387 12578 (INITIALIZE-SHELL-DEVICE 7397 . 8825) (
|
||||
UNIX-GET-NEXT-BUFFER 8827 . 11027) (UNIX-BACKFILEPTR 11029 . 11441) (UNIX-STREAM-EOFP 11443 . 11924) (
|
||||
UNIX-STREAM-OUT 11926 . 12182) (UNIX-STREAM-CLOSE 12184 . 12576)) (12826 14532 (
|
||||
CREATE-UNIX-SOCKET-STREAM 12836 . 13642) (ACCEPT-UNIX-SOCKET-STREAM 13644 . 14530)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
296
lispusers/GITFNS
296
lispusers/GITFNS
@@ -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 " 9-May-2025 11:39:55" {WMEDLEY}<lispusers>GITFNS.;545 134412
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS GITFNSCOMS)
|
||||
(FNS GIT-WORKING-COMPARE-DIRECTORIES)
|
||||
:CHANGES-TO (FNS GIT-PULL-REQUESTS)
|
||||
|
||||
:PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539)
|
||||
:PREVIOUS-DATE " 5-May-2025 22:04:15" {WMEDLEY}<lispusers>GITFNS.;544)
|
||||
|
||||
|
||||
(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
|
||||
|
||||
@@ -2273,16 +2275,16 @@
|
||||
RB NIL PROJECT])
|
||||
)
|
||||
|
||||
(RPAQ? FROMGITN 0)
|
||||
(RPAQ? FROMGITN 0)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Utilities")
|
||||
(* ;; "Utilities")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2430,35 +2432,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 (4187 20766 (GIT-CLONEP 4197 . 5525) (GIT-INIT 5527 . 6157) (GIT-MAKE-PROJECT 6159 .
|
||||
13824) (GIT-GET-PROJECT 13826 . 15751) (GIT-PUT-PROJECT-FIELD 15753 . 17394) (GIT-PROJECT-PATH 17396
|
||||
. 18440) (FIND-ANCESTOR-DIRECTORY 18442 . 18791) (GIT-FIND-CLONE 18793 . 19874) (GIT-MAINBRANCH 19876
|
||||
. 20271) (GIT-MAINBRANCH? 20273 . 20764)) (26229 31158 (PRC-COMMAND 26239 . 31156)) (31214 34002 (
|
||||
ALLSUBDIRS 31224 . 32510) (MEDLEYSUBDIRS 32512 . 33205) (GITSUBDIRS 33207 . 34000)) (34003 38793 (
|
||||
TOGIT 34013 . 35419) (FROMGIT 35421 . 36402) (GIT-DELETE-FILE 36404 . 37250) (MYMEDLEY-DELETE-FILES
|
||||
37252 . 38791)) (38794 41797 (MYMEDLEYSUBDIR 38804 . 39260) (GITSUBDIR 39262 . 39705) (STRIPDIR 39707
|
||||
. 40078) (STRIPHOST 40080 . 40320) (STRIPNAME 40322 . 41075) (STRIPWHERE 41077 . 41795)) (41798 43700
|
||||
(GFILE4MFILE 41808 . 42171) (MFILE4GFILE 42173 . 42742) (GIT-REPO-FILENAME 42744 . 43698)) (43749
|
||||
54004 (GIT-COMMIT 43759 . 44585) (GIT-PUSH 44587 . 45347) (GIT-PULL 45349 . 46101) (GIT-APPROVAL 46103
|
||||
. 46452) (GIT-GET-FILE 46454 . 48369) (GIT-FILE-EXISTS? 48371 . 48645) (GIT-REMOTE-UPDATE 48647 .
|
||||
49482) (GIT-REMOTE-ADD 49484 . 49791) (GIT-FILE-DATE 49793 . 50840) (GIT-FILE-HISTORY 50842 . 52776) (
|
||||
GIT-PRINT-FILE-HISTORY 52778 . 53828) (GIT-FETCH 53830 . 54002)) (54034 65372 (GIT-BRANCH-DIFF 54044
|
||||
. 60791) (GIT-COMMIT-DIFFS 60793 . 61684) (GIT-BRANCH-RELATIONS 61686 . 65370)) (65417 84912 (
|
||||
GIT-BRANCH-NUM 65427 . 66000) (GIT-CHECKOUT 66002 . 67288) (GIT-WHICH-BRANCH 67290 . 67697) (
|
||||
GIT-MAKE-BRANCH 67699 . 70278) (GIT-BRANCHES 70280 . 72875) (GIT-BRANCH-EXISTS? 72877 . 73748) (
|
||||
GIT-PICK-BRANCH 73750 . 74240) (GIT-BRANCH-MENU 74242 . 75123) (GIT-BRANCH-WHENSELECTEDFN 75125 .
|
||||
77664) (GIT-PULL-REQUESTS 77666 . 81293) (GIT-SHORT-BRANCH-NAME 81295 . 81586) (GIT-LONG-NAME 81588 .
|
||||
81905) (GIT-PRC-BRANCHES 81907 . 84910)) (84942 88390 (GIT-MY-CURRENT-BRANCH 84952 . 85322) (
|
||||
GIT-MY-BRANCHP 85324 . 85942) (GIT-MY-NEXT-BRANCH 85944 . 86438) (GIT-MY-BRANCHES 86440 . 88388)) (
|
||||
88436 92511 (GIT-ADD-WORKTREE 88446 . 90053) (GIT-REMOVE-WORKTREE 90055 . 90985) (GIT-LIST-WORKTREES
|
||||
90987 . 91791) (WORKTREEDIR 91793 . 92509)) (92559 125952 (GIT-GET-DIFFERENT-FILES 92569 . 98993) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98995 . 106226) (GIT-WORKING-COMPARE-DIRECTORIES 106228 . 111935) (
|
||||
GIT-COMPARE-WORKTREE 111937 . 115915) (GITCDOBJBUTTONFN 115917 . 120407) (GIT-CD-LABELFN 120409 .
|
||||
121491) (GIT-CD-MENUFN 121493 . 123933) (GIT-WORKING-COMPARE-FILES 123935 . 124555) (
|
||||
GIT-BRANCHES-COMPARE-FILES 124557 . 125721) (GIT-PR-COMPARE 125723 . 125950)) (126022 134345 (CDGITDIR
|
||||
126032 . 126719) (GIT-COMMAND 126721 . 128279) (GITORIGIN 128281 . 128978) (GIT-INITIALS 128980 .
|
||||
129284) (GIT-COMMAND-TO-FILE 129286 . 132771) (GIT-RESULT-TO-LINES 132773 . 133678) (STRIPLOCAL 133680
|
||||
. 134343)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
1994
lispusers/HELPSYS
1994
lispusers/HELPSYS
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Reference in New Issue
Block a user