Compare commits
3 Commits
medley-250
...
medley-250
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
330c5a01a7 | ||
|
|
2499b3546e | ||
|
|
7ad65469b1 |
@@ -103,14 +103,16 @@ The target files are copied from this work directory to the loadups
|
||||
directory if the loadup is successful.
|
||||
Each stage of the loadup also creates a dribble file containing the
|
||||
terminal output from within the Medley environment.
|
||||
These dribble files are not copied to the loadups directory, but remain
|
||||
available in the work directory after the loadup completes.
|
||||
These dribble files are also copied to the loadups directory, but also
|
||||
remain available in the work directory after the loadup completes.
|
||||
.PP
|
||||
Only one instance (per <MEDLEIDIR>) of loadup can be run at a time.
|
||||
(The lock file is in the work directory and is named
|
||||
\f[B]\f[BI]lock\f[B]\f[R].
|
||||
It can be removed in case of an uncontrolled failure of the loadup
|
||||
procedure.)
|
||||
There is lock file to prevent simultaneous loadups in the work directory
|
||||
(named \f[B]\f[BI]lock\f[B]\f[R]) that can be manually removed.
|
||||
The lock can also be automatically overridden (see the \[en]override
|
||||
flag below).
|
||||
Alternatively, if a lock is encountered at run time, the user will be
|
||||
asked to choose whether to override or simply exit the loadup.
|
||||
.PP
|
||||
Note: \f[B]MEDLEYDIR\f[R] is an environment variable set by the loadup
|
||||
script.
|
||||
@@ -253,6 +255,12 @@ Synonym for \[lq]\[en]target apps\[rq]
|
||||
\f[B]-a-, --apps-, -apps-, -5-\f[R]
|
||||
Synonym for \[lq]\[en]target apps\[rq]
|
||||
.TP
|
||||
\f[B]-ov, --override, -override\f[R]
|
||||
Automatically override the lock that prevents two loadups from running
|
||||
simultaneously.
|
||||
If this flag is not set and an active lock is encountered, the user will
|
||||
be asked to choose whether to override or exit.
|
||||
.TP
|
||||
\f[B]-nc, --nocopy, -nocopy\f[R]
|
||||
Run the specified loadups, but do not copy results into loadups
|
||||
directory.
|
||||
|
||||
Binary file not shown.
@@ -48,10 +48,10 @@ The two independent stages that can be run if the first 4 sequential stages comp
|
||||
>+ **DB:**: creates the *fuller.database* file. Fuller.database is a Mastercope database created by analyzing all of the source code included in full.sysout. (Stage 4) Fuller.database is copied into the loadups directory.
|
||||
|
||||
|
||||
Loadup does all of its work in a work directory (\<MEDLEYDIR>loadups/build). The target files are copied from this work directory to the loadups directory if the loadup is successful. Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment. These dribble files are not copied to the loadups directory, but remain available in the work directory after the loadup completes.
|
||||
Loadup does all of its work in a work directory (\<MEDLEYDIR>loadups/build). The target files are copied from this work directory to the loadups directory if the loadup is successful. Each stage of the loadup also creates a dribble file containing the terminal output from within the Medley environment. These dribble files are also copied to the loadups directory, but also remain available in the work directory after the loadup completes.
|
||||
|
||||
|
||||
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. (The lock file is in the work directory and is named ***lock***. It can be removed in case of an uncontrolled failure of the loadup procedure.)
|
||||
Only one instance (per \<MEDLEIDIR>) of loadup can be run at a time. There is lock file to prevent simultaneous loadups in the work directory (named ***lock***) that can be manually removed. The lock can also be automatically overridden (see the --override flag below). Alternatively, if a lock is encountered at run time, the user will be asked to choose whether to override or simply exit the loadup.
|
||||
|
||||
Note: **MEDLEYDIR** is an environment variable set by the loadup script. It is set to the top level directory of the Medley installation that contains the specific loadup script that
|
||||
is invoked after all symbolic links are resolved. In the standard global installation this will
|
||||
@@ -120,6 +120,9 @@ OPTIONS
|
||||
**-a-, \-\-apps-, -apps-, -5-**
|
||||
: Synonym for "--target apps"
|
||||
|
||||
**-ov, \-\-override, -override**
|
||||
: Automatically override the lock that prevents two loadups from running simultaneously. If this flag is not set and an active lock is encountered, the user will be asked to choose whether to override or exit.
|
||||
|
||||
**-nc, \-\-nocopy, -nocopy**
|
||||
: Run the specified loadups, but do not copy results into loadups directory.
|
||||
|
||||
|
||||
@@ -77,12 +77,15 @@ into the loadups directory.</p></li>
|
||||
work directory to the loadups directory if the loadup is successful.
|
||||
Each stage of the loadup also creates a dribble file containing the
|
||||
terminal output from within the Medley environment. These dribble files
|
||||
are not copied to the loadups directory, but remain available in the
|
||||
work directory after the loadup completes.</p>
|
||||
are also copied to the loadups directory, but also remain available in
|
||||
the work directory after the loadup completes.</p>
|
||||
<p>Only one instance (per <MEDLEIDIR>) of loadup can be run at a
|
||||
time. (The lock file is in the work directory and is named
|
||||
<strong><em>lock</em></strong>. It can be removed in case of an
|
||||
uncontrolled failure of the loadup procedure.)</p>
|
||||
time. There is lock file to prevent simultaneous loadups in the work
|
||||
directory (named <strong><em>lock</em></strong>) that can be manually
|
||||
removed. The lock can also be automatically overridden (see the
|
||||
–override flag below). Alternatively, if a lock is encountered at run
|
||||
time, the user will be asked to choose whether to override or simply
|
||||
exit the loadup.</p>
|
||||
<p>Note: <strong>MEDLEYDIR</strong> is an environment variable set by
|
||||
the loadup script. It is set to the top level directory of the Medley
|
||||
installation that contains the specific loadup script that is invoked
|
||||
@@ -194,6 +197,13 @@ loadups.</p>
|
||||
<dd>
|
||||
<p>Synonym for “–target apps”</p>
|
||||
</dd>
|
||||
<dt><strong>-ov, --override, -override</strong></dt>
|
||||
<dd>
|
||||
<p>Automatically override the lock that prevents two loadups from
|
||||
running simultaneously. If this flag is not set and an active lock is
|
||||
encountered, the user will be asked to choose whether to override or
|
||||
exit.</p>
|
||||
</dd>
|
||||
<dt><strong>-nc, --nocopy, -nocopy</strong></dt>
|
||||
<dd>
|
||||
<p>Run the specified loadups, but do not copy results into loadups
|
||||
|
||||
405
lispusers/GITFNS
405
lispusers/GITFNS
@@ -1,28 +1,29 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539 133841
|
||||
(FILECREATED "29-Apr-2025 15:17:37" {WMEDLEY}<lispusers>GITFNS.;541 134267
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS GIT-GET-FILE GIT-RESULT-TO-LINES)
|
||||
:CHANGES-TO (VARS GITFNSCOMS)
|
||||
(FNS GIT-WORKING-COMPARE-DIRECTORIES)
|
||||
|
||||
:PREVIOUS-DATE "21-Mar-2025 19:07:34" {WMEDLEY}<lispusers>GITFNS.;536)
|
||||
:PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539)
|
||||
|
||||
|
||||
(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
|
||||
@@ -43,94 +44,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
|
||||
|
||||
@@ -401,15 +402,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)
|
||||
@@ -417,120 +418,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
|
||||
|
||||
@@ -616,12 +617,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "File correspondents")
|
||||
(* ;; "File correspondents")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -864,12 +865,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Git commands")
|
||||
(* ;; "Git commands")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1073,7 +1074,7 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "Differences")
|
||||
(* ;; "Differences")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1261,12 +1262,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Branches")
|
||||
(* ;; "Branches")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1574,7 +1575,7 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "My branches")
|
||||
(* ;; "My branches")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1641,12 +1642,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Worktrees")
|
||||
(* ;; "Worktrees")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1717,12 +1718,12 @@
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Comparisons")
|
||||
(* ;; "Comparisons")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1934,98 +1935,100 @@
|
||||
else '(0 differences))
|
||||
else '(0 differences])
|
||||
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 12-Jun-2024 22:52 by mth")
|
||||
(* ;; "Edited 29-Apr-2025 15:14 by rmk")
|
||||
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
(* ;; "Edited 12-Jun-2024 22:52 by mth")
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
(* ;; "Edited 26-Sep-2023 22:41 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
|
||||
(* ;; "Edited 10-May-2022 10:41 by rmk")
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
|
||||
(* ;; "Edited 10-May-2022 10:41 by rmk")
|
||||
|
||||
(* ;;
|
||||
"Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
|
||||
"Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.")
|
||||
(CL:UNLESS (AND (fetch GITHOST of PROJECT)
|
||||
(fetch WHOST of PROJECT))
|
||||
(ERROR (fetch PROJECTNAME of PROJECT)
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.")
|
||||
(CL:UNLESS (AND (fetch GITHOST of PROJECT)
|
||||
(fetch WHOST of PROJECT))
|
||||
(ERROR (fetch PROJECTNAME of PROJECT)
|
||||
" does not have both git and working directories"))
|
||||
(CL:WHEN (AND (LISTP SUBDIRS)
|
||||
(NULL (CDR SUBDIRS)))
|
||||
(SETQ SUBDIRS (CAR SUBDIRS)))
|
||||
(CL:WHEN (AND (LISTP SUBDIRS)
|
||||
(NULL (CDR SUBDIRS)))
|
||||
(SETQ SUBDIRS (CAR SUBDIRS)))
|
||||
(CL:UNLESS SUBDIRS
|
||||
(SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT)
|
||||
(SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT)
|
||||
'ALL)))
|
||||
(SETQ SUBDIRS (L-CASE SUBDIRS))
|
||||
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
(SETQ SUBDIRS (L-CASE SUBDIRS))
|
||||
(LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all)
|
||||
then (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
|
||||
"ALL subdirectories"
|
||||
else SUBDIRS)))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
else SUBDIRS)))
|
||||
(for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT)
|
||||
T)))
|
||||
(NENTRIES _ 0)
|
||||
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
NIL
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT T))
|
||||
first (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
|
||||
(BKSYSBUF " ") inside SUBDIRS
|
||||
collect (TERPRI T)
|
||||
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
'(*.* *>*.* .* *>.*)
|
||||
(for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)
|
||||
collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E
|
||||
'DIRECTORY)
|
||||
1 NIL T T FILEDIRCASEARRAY))
|
||||
(CL:IF DPOS
|
||||
(SUBSTRING E (ADD1 DPOS))
|
||||
(SUBSTRING E (ADD1 DPOS))
|
||||
E))
|
||||
NIL NIL NIL FIXDIRECTORYDATES))
|
||||
[for CDE in (fetch CDENTRIES of CDVAL)
|
||||
do (CL:WHEN (fetch INFO1 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE))
|
||||
(UNSLASHIT DATUM T)))
|
||||
(CL:WHEN (fetch INFO2 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE))
|
||||
(SLASHIT DATUM T)))]
|
||||
[for CDE in (fetch CDENTRIES of CDVAL)
|
||||
do (CL:WHEN (fetch INFO1 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE))
|
||||
(UNSLASHIT DATUM T)))
|
||||
(CL:WHEN (fetch INFO2 of CDE)
|
||||
(change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE))
|
||||
(SLASHIT DATUM T)))]
|
||||
CDVAL
|
||||
finally
|
||||
finally
|
||||
|
||||
(* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")
|
||||
(* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")
|
||||
|
||||
(CL:WHEN (AND (CDR $$VAL)
|
||||
(CL:WHEN (AND (CDR $$VAL)
|
||||
GIT-MERGE-COMPARES)
|
||||
(SETQ $$VAL (CDMERGE $$VAL))
|
||||
[SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "])
|
||||
[for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS
|
||||
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
||||
(SETQ $$VAL (CDMERGE $$VAL))
|
||||
[SETQ SUBDIRS (CONCATLIST (for SUBDIR in SUBDIRS collect (CONCAT SUBDIR " "])
|
||||
[for CDVAL TITLE in $$VAL as SUBDIR inside SUBDIRS
|
||||
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
||||
" files"))
|
||||
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
|
||||
[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)
|
||||
,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
|
||||
'("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
|
||||
(CONS (CONCAT SUBDIR "/")
|
||||
(for CDENTRY in (fetch CDENTRIES of CDVAL)
|
||||
collect (fetch MATCHNAME of CDENTRY)))
|
||||
(add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL]
|
||||
(SETQ LAST-WMEDLEY-CDVALUES $$VAL)
|
||||
(TERPRI T)
|
||||
(RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
|
||||
(CONS (CONCAT SUBDIR "/")
|
||||
(for CDENTRY in (fetch CDENTRIES of CDVAL)
|
||||
collect (fetch MATCHNAME of CDENTRY)))
|
||||
(add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL]
|
||||
(SETQ LAST-WMEDLEY-CDVALUES $$VAL)
|
||||
(TERPRI T)
|
||||
(RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
|
||||
'difference
|
||||
'differences)])
|
||||
|
||||
@@ -2270,16 +2273,16 @@
|
||||
RB NIL PROJECT])
|
||||
)
|
||||
|
||||
(RPAQ? FROMGITN 0)
|
||||
(RPAQ? FROMGITN 0)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "Utilities")
|
||||
(* ;; "Utilities")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
@@ -2427,35 +2430,35 @@
|
||||
STRING])
|
||||
)
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4202 20781 (GIT-CLONEP 4212 . 5540) (GIT-INIT 5542 . 6172) (GIT-MAKE-PROJECT 6174 .
|
||||
13839) (GIT-GET-PROJECT 13841 . 15766) (GIT-PUT-PROJECT-FIELD 15768 . 17409) (GIT-PROJECT-PATH 17411
|
||||
. 18455) (FIND-ANCESTOR-DIRECTORY 18457 . 18806) (GIT-FIND-CLONE 18808 . 19889) (GIT-MAINBRANCH 19891
|
||||
. 20286) (GIT-MAINBRANCH? 20288 . 20779)) (26244 31173 (PRC-COMMAND 26254 . 31171)) (31229 34017 (
|
||||
ALLSUBDIRS 31239 . 32525) (MEDLEYSUBDIRS 32527 . 33220) (GITSUBDIRS 33222 . 34015)) (34018 38808 (
|
||||
TOGIT 34028 . 35434) (FROMGIT 35436 . 36417) (GIT-DELETE-FILE 36419 . 37265) (MYMEDLEY-DELETE-FILES
|
||||
37267 . 38806)) (38809 41812 (MYMEDLEYSUBDIR 38819 . 39275) (GITSUBDIR 39277 . 39720) (STRIPDIR 39722
|
||||
. 40093) (STRIPHOST 40095 . 40335) (STRIPNAME 40337 . 41090) (STRIPWHERE 41092 . 41810)) (41813 43715
|
||||
(GFILE4MFILE 41823 . 42186) (MFILE4GFILE 42188 . 42757) (GIT-REPO-FILENAME 42759 . 43713)) (43764
|
||||
54019 (GIT-COMMIT 43774 . 44600) (GIT-PUSH 44602 . 45362) (GIT-PULL 45364 . 46116) (GIT-APPROVAL 46118
|
||||
. 46467) (GIT-GET-FILE 46469 . 48384) (GIT-FILE-EXISTS? 48386 . 48660) (GIT-REMOTE-UPDATE 48662 .
|
||||
49497) (GIT-REMOTE-ADD 49499 . 49806) (GIT-FILE-DATE 49808 . 50855) (GIT-FILE-HISTORY 50857 . 52791) (
|
||||
GIT-PRINT-FILE-HISTORY 52793 . 53843) (GIT-FETCH 53845 . 54017)) (54049 65169 (GIT-BRANCH-DIFF 54059
|
||||
. 60806) (GIT-COMMIT-DIFFS 60808 . 61481) (GIT-BRANCH-RELATIONS 61483 . 65167)) (65214 84600 (
|
||||
GIT-BRANCH-NUM 65224 . 65797) (GIT-CHECKOUT 65799 . 67085) (GIT-WHICH-BRANCH 67087 . 67494) (
|
||||
GIT-MAKE-BRANCH 67496 . 70075) (GIT-BRANCHES 70077 . 72672) (GIT-BRANCH-EXISTS? 72674 . 73545) (
|
||||
GIT-PICK-BRANCH 73547 . 74037) (GIT-BRANCH-MENU 74039 . 74920) (GIT-BRANCH-WHENSELECTEDFN 74922 .
|
||||
77461) (GIT-PULL-REQUESTS 77463 . 80981) (GIT-SHORT-BRANCH-NAME 80983 . 81274) (GIT-LONG-NAME 81276 .
|
||||
81593) (GIT-PRC-BRANCHES 81595 . 84598)) (84630 88078 (GIT-MY-CURRENT-BRANCH 84640 . 85010) (
|
||||
GIT-MY-BRANCHP 85012 . 85630) (GIT-MY-NEXT-BRANCH 85632 . 86126) (GIT-MY-BRANCHES 86128 . 88076)) (
|
||||
88124 92199 (GIT-ADD-WORKTREE 88134 . 89741) (GIT-REMOVE-WORKTREE 89743 . 90673) (GIT-LIST-WORKTREES
|
||||
90675 . 91479) (WORKTREEDIR 91481 . 92197)) (92247 125381 (GIT-GET-DIFFERENT-FILES 92257 . 98681) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 98683 . 105914) (GIT-WORKING-COMPARE-DIRECTORIES 105916 . 111364) (
|
||||
GIT-COMPARE-WORKTREE 111366 . 115344) (GITCDOBJBUTTONFN 115346 . 119836) (GIT-CD-LABELFN 119838 .
|
||||
120920) (GIT-CD-MENUFN 120922 . 123362) (GIT-WORKING-COMPARE-FILES 123364 . 123984) (
|
||||
GIT-BRANCHES-COMPARE-FILES 123986 . 125150) (GIT-PR-COMPARE 125152 . 125379)) (125451 133774 (CDGITDIR
|
||||
125461 . 126148) (GIT-COMMAND 126150 . 127708) (GITORIGIN 127710 . 128407) (GIT-INITIALS 128409 .
|
||||
128713) (GIT-COMMAND-TO-FILE 128715 . 132200) (GIT-RESULT-TO-LINES 132202 . 133107) (STRIPLOCAL 133109
|
||||
. 133772)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -17,6 +17,7 @@ main() {
|
||||
nocopy=false
|
||||
thinw=false
|
||||
thinl=false
|
||||
override_lock=false
|
||||
while [ "$#" -ne 0 ];
|
||||
do
|
||||
case "$1" in
|
||||
@@ -144,6 +145,9 @@ main() {
|
||||
export MAIKODIR="${maikodir}"
|
||||
shift
|
||||
;;
|
||||
-ov | -override | --override)
|
||||
override_lock=true
|
||||
;;
|
||||
--noendmsg)
|
||||
noendmsg=true
|
||||
;;
|
||||
@@ -251,7 +255,7 @@ main() {
|
||||
|
||||
|
||||
# check and set the run_lock
|
||||
check_run_lock
|
||||
check_run_lock "${override_lock}"
|
||||
|
||||
# if requested, thin the loadups and workdirs by eliminating all versioned (*.~[0-9]*~) files
|
||||
# from these directories
|
||||
@@ -348,18 +352,24 @@ main() {
|
||||
then
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
fi
|
||||
|
||||
if [ $start -le 3 ] && [ $end -ge 4 ]
|
||||
then
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
fi
|
||||
|
||||
if [ $start -le 4 ] && [ $end -ge 5 ]
|
||||
then
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/apps.sysout "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
fi
|
||||
|
||||
if [ "${aux}" = true ]
|
||||
@@ -368,12 +378,18 @@ main() {
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/exports.all "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/exports.dribble "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
fi
|
||||
|
||||
if [ "${db}" = true ]
|
||||
then
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/fuller.database "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
/bin/sh "${LOADUP_CPV}" "${LOADUP_WORKDIR}"/fuller.dribble "${LOADUP_OUTDIR}" \
|
||||
| sed -e "s#${MEDLEYDIR}/##g"
|
||||
fi
|
||||
|
||||
fi
|
||||
|
||||
@@ -249,13 +249,39 @@ process_maikodir() {
|
||||
export LOADUP_LOCKFILE="${LOADUP_WORKDIR}"/lock
|
||||
|
||||
check_run_lock() {
|
||||
if [ -e "${LOADUP_LOCKFILE}" ]
|
||||
then
|
||||
output_error_msg "Error: Another loadup is already running with PID $(cat "${LOADUP_LOCKFILE}")${EOL}Exiting."
|
||||
exit 1
|
||||
fi
|
||||
echo "$$" > "${LOADUP_LOCKFILE}"
|
||||
LOADUP_LOCK="$$"
|
||||
set +x
|
||||
if [ -e "${LOADUP_LOCKFILE}" ]
|
||||
then
|
||||
output_warn_msg "Warning: Another loadup is already running with PID $(cat "${LOADUP_LOCKFILE}")"
|
||||
if [ "${override_lock}" = true ]
|
||||
then
|
||||
output_warn_msg "Overriding lock preventing simultaneous loadups due to command line argument --override${EOL}Continuing."
|
||||
else
|
||||
loop_done=false
|
||||
while [ "${loop_done}" = "false" ]
|
||||
do
|
||||
output_warn_msg "Do you want to override the lock guarding against simultaneous loadups?"
|
||||
output_warn_msg "Answer [y, Y, n or N, default n] followed by RETURN"
|
||||
read resp
|
||||
if [ -z "${resp}" ]; then resp=n; fi
|
||||
case "${resp}" in
|
||||
n* | N* )
|
||||
output_error_msg "Ok. Exiting"
|
||||
exit 5
|
||||
;;
|
||||
y* | Y* )
|
||||
output_warn_msg "Ok. Overriding lock and continuing"
|
||||
loop_done=true
|
||||
;;
|
||||
* )
|
||||
output_warn_msg "Answer not one of Y, y, N, or n. Retry."
|
||||
;;
|
||||
esac
|
||||
done
|
||||
fi
|
||||
fi
|
||||
echo "$$" > "${LOADUP_LOCKFILE}"
|
||||
LOADUP_LOCK="$$"
|
||||
}
|
||||
|
||||
remove_run_lock() {
|
||||
|
||||
@@ -1,13 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Aug-2024 22:11:48" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;4 11113
|
||||
(FILECREATED "15-May-2025 00:18:25" {DSK}<home>frank>il>qmedley>sources>MEDLEYDIR.;2 11450
|
||||
|
||||
:EDIT-BY "mth"
|
||||
:CHANGES-TO (VARS MEDLEY-INIT-VARS)
|
||||
|
||||
:CHANGES-TO (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS)
|
||||
(FNS SET-SYSOUT-COMMIT)
|
||||
|
||||
:PREVIOUS-DATE " 8-Jul-2024 22:49:43" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;3)
|
||||
:PREVIOUS-DATE "26-Aug-2024 22:11:48" {DSK}<home>frank>il>qmedley>sources>MEDLEYDIR.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
@@ -193,8 +190,12 @@
|
||||
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
|
||||
(IRM.DINFOGRAPH)
|
||||
(DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
|
||||
[LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
(LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
(AND (GETD 'PSEUDOHOSTS)
|
||||
(TARGETHOST 'LI)
|
||||
(PSEUDOHOST 'LI LHD))
|
||||
LHD))
|
||||
[USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM))
|
||||
(CONS LOGINHOST/DIR '("INIT"]
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts" "fonts/adobe"
|
||||
@@ -206,8 +207,12 @@
|
||||
NIL NIL T))
|
||||
(UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox")
|
||||
NIL NIL T))
|
||||
(LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME")))
|
||||
(LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
(AND (GETD 'PSEUDOHOSTS)
|
||||
(TARGETHOST 'LI)
|
||||
(PSEUDOHOST 'LI LHD))
|
||||
LHD)
|
||||
RESET)
|
||||
(USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
|
||||
(CONS LOGINHOST/DIR '("INIT"]
|
||||
@@ -221,6 +226,6 @@
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1749 8823 (MEDLEY-INIT-VARS 1759 . 5237) (MEDLEYDIR 5239 . 7623) (MEDLEYSUBSTDIR 7625
|
||||
. 8603) (SET-SYSOUT-COMMIT 8605 . 8821)))))
|
||||
(FILEMAP (NIL (1661 8735 (MEDLEY-INIT-VARS 1671 . 5149) (MEDLEYDIR 5151 . 7535) (MEDLEYSUBSTDIR 7537
|
||||
. 8515) (SET-SYSOUT-COMMIT 8517 . 8733)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user