Rmk55 gitfns with redirect (#826)
* CLIPBOARD, FILEIO: external format CLIPBOARD uses SYSTEM-EXTERNALFORMAT. FILEIO: added sourceparameters argument to COPYFILE, so format can be specified. * GITFNS: rework to avoid hanging process stream Redirects command output to tmp output and error streams, at most only looks for a COMPLETED signal in the process stream (which still sometimes hangs) * EXAMINEDEFS: Asks for a menu position on a keyboard call (Otherwise, the chunk menu may be buried under the TTY window)
This commit is contained in:
rmkaplan
GitHub
@@ -1,22 +1,23 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 3-Jul-2021 13:16:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.;6 9185
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS CLIPBOARDCOMS)
|
||||
(FILECREATED " 7-Jul-2022 23:53:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;7 9243
|
||||
|
||||
previous date%: "24-Jun-2021 21:14:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.;5)
|
||||
:CHANGES-TO (VARS CLIPBOARDCOMS)
|
||||
(FNS CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2021 13:16:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;6)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CLIPBOARDCOMS)
|
||||
|
||||
(RPAQQ CLIPBOARDCOMS
|
||||
[ (* ; "Enable copy and paste")
|
||||
[ (* ; "Enable copy and paste")
|
||||
(FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE
|
||||
CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
|
||||
(FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD)
|
||||
(FNS SEDIT.COPYTOCLIPBOARD)
|
||||
(INITVARS (CLIPBOARD-FORMAT :UTF-8))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
|
||||
UNIXCOMM UNICODE)
|
||||
(P (INSTALL-CLIPBOARD)))
|
||||
@@ -116,24 +117,21 @@
|
||||
(LISPINTERRUPTS.ORIG])
|
||||
|
||||
(CLIPBOARD-COPY-STREAM
|
||||
[LAMBDA NIL (* ; "Edited 23-Feb-2021 22:11 by rmk:")
|
||||
|
||||
(* ;; "Clipboard is UNICODE and UTF8")
|
||||
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk")
|
||||
(* ; "Edited 23-Feb-2021 22:11 by rmk:")
|
||||
(LET (STRM (OST (UNIX-GETENV "OSTYPE")))
|
||||
(SETQ STRM (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" OST)
|
||||
"pbcopy"
|
||||
"xclip -i -selection clipboard")))
|
||||
(\EXTERNALFORMAT STRM CLIPBOARD-FORMAT)
|
||||
STRM])
|
||||
|
||||
(CLIPBOARD-PASTE-STREAM
|
||||
[LAMBDA NIL (* ; "Edited 23-Feb-2021 17:29 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk")
|
||||
(* ; "Edited 23-Feb-2021 17:29 by rmk:")
|
||||
(LET (STRM (OST (UNIX-GETENV "OSTYPE")))
|
||||
(SETQ STRM (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" OST)
|
||||
"pbpaste"
|
||||
"xclip -o -selection clipboard")))
|
||||
(\EXTERNALFORMAT STRM CLIPBOARD-FORMAT)
|
||||
[SETFILEINFO STRM 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
|
||||
(RETFROM (FUNCTION READCCODE)
|
||||
NIL]
|
||||
@@ -183,8 +181,6 @@
|
||||
NIL STREAM])]
|
||||
T])
|
||||
)
|
||||
|
||||
(RPAQ? CLIPBOARD-FORMAT :UTF-8)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
@@ -203,8 +199,8 @@
|
||||
)
|
||||
(PUTPROPS CLIPBOARD COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1301 6531 (INSTALL-CLIPBOARD 1311 . 3243) (GETCLIPBOARD 3245 . 3619) (PUTCLIPBOARD 3621
|
||||
. 4026) (PASTEFROMCLIPBOARD 4028 . 4946) (LISPINTERRUPTS.PASTE 4948 . 5369) (CLIPBOARD-COPY-STREAM
|
||||
5371 . 5871) (CLIPBOARD-PASTE-STREAM 5873 . 6529)) (6532 7291 (TEDIT.COPYTOCLIPBOARD 6542 . 6823) (
|
||||
TEDIT.EXTRACTTOCLIPBOARD 6825 . 7289)) (7292 8831 (SEDIT.COPYTOCLIPBOARD 7302 . 8829)))))
|
||||
(FILEMAP (NIL (1317 6626 (INSTALL-CLIPBOARD 1327 . 3259) (GETCLIPBOARD 3261 . 3635) (PUTCLIPBOARD 3637
|
||||
. 4042) (PASTEFROMCLIPBOARD 4044 . 4962) (LISPINTERRUPTS.PASTE 4964 . 5385) (CLIPBOARD-COPY-STREAM
|
||||
5387 . 5902) (CLIPBOARD-PASTE-STREAM 5904 . 6624)) (6627 7386 (TEDIT.COPYTOCLIPBOARD 6637 . 6918) (
|
||||
TEDIT.EXTRACTTOCLIPBOARD 6920 . 7384)) (7387 8926 (SEDIT.COPYTOCLIPBOARD 7397 . 8924)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "24-Jun-2022 18:52:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;39 12695
|
||||
(FILECREATED " 9-Jul-2022 11:05:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;40 12957
|
||||
|
||||
:CHANGES-TO (FNS EXAMINEDEFS)
|
||||
|
||||
:PREVIOUS-DATE "23-Jun-2022 17:58:57"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;38)
|
||||
:PREVIOUS-DATE "24-Jun-2022 18:52:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;39)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
@@ -19,7 +19,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 24-Jun-2022 18:51 by rmk")
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 9-Jul-2022 11:04 by rmk")
|
||||
(* ; "Edited 24-Jun-2022 18:51 by rmk")
|
||||
(* ; "Edited 23-Jun-2022 17:58 by rmk")
|
||||
(* ; "Edited 25-Feb-2022 15:01 by rmk")
|
||||
|
||||
@@ -132,7 +133,9 @@
|
||||
TEXTWIDTH)
|
||||
(TEDITDEF NAME DEF2 TYPE NIL
|
||||
TEXTWIDTH)
|
||||
'LINE REGION (LIST TITLE1 TITLE2)
|
||||
'LINE
|
||||
(OR REGION (GETPOSITION))
|
||||
(LIST TITLE1 TITLE2)
|
||||
(CONCAT "Compare sources of " NAME
|
||||
" as " TYPE)
|
||||
TEXTWIDTH TEXTHEIGHT))
|
||||
@@ -213,6 +216,6 @@
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (671 12553 (EXAMINEDEFS 681 . 9275) (EXAMINEFILES 9277 . 10672) (TEDITDEF 10674 . 12551)
|
||||
(FILEMAP (NIL (671 12815 (EXAMINEDEFS 681 . 9537) (EXAMINEFILES 9539 . 10934) (TEDITDEF 10936 . 12813)
|
||||
))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
418
lispusers/GITFNS
418
lispusers/GITFNS
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Jun-2022 13:33:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;318 101193
|
||||
(FILECREATED " 9-Jul-2022 19:01:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;397 109555
|
||||
|
||||
:CHANGES-TO (COMMANDS prc)
|
||||
(FNS GIT-COMMIT-DIFFS)
|
||||
:CHANGES-TO (FNS GIT-PRC-MENU GIT-COMMAND-TO-FILE)
|
||||
(COMMANDS prc)
|
||||
|
||||
:PREVIOUS-DATE "25-Jun-2022 21:38:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;317)
|
||||
:PREVIOUS-DATE " 8-Jul-2022 10:37:36"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;390)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -26,7 +26,7 @@
|
||||
|
||||
(COMS (FNS GIT-CLONEP GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH
|
||||
FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?)
|
||||
(RECORDS GIT-PROJECT)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT))
|
||||
(INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
(GIT-PROJECTS NIL)))
|
||||
(P (GIT-MAKE-PROJECT 'MEDLEY T T '(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/
|
||||
@@ -60,7 +60,8 @@
|
||||
(* ;; "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-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY
|
||||
GIT-FETCH)
|
||||
|
||||
(* ;; "Differences")
|
||||
|
||||
@@ -101,7 +102,7 @@
|
||||
|
||||
(* ;; "Utilities")
|
||||
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS)
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE)
|
||||
(PROPS (GITFNS FILETYPE))))
|
||||
|
||||
|
||||
@@ -146,6 +147,7 @@
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 6-Jul-2022 19:34 by rmk")
|
||||
(* ; "Edited 17-May-2022 17:08 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 12-May-2022 00:26 by rmk")
|
||||
@@ -264,16 +266,14 @@
|
||||
EXCLUSIONS _ EXCLUSIONS
|
||||
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
|
||||
CLONEPATH _ CLONEPATH))
|
||||
(REPLACE MAINBRANCH OF PROJECT WITH (OR (GIT-BRANCH-EXISTS? 'origin/main T PROJECT)
|
||||
(GIT-BRANCH-EXISTS? 'origin/master NIL PROJECT))
|
||||
)
|
||||
(/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
|
||||
(CAR (PUSH GIT-PROJECTS (CONS PROJECTNAME]
|
||||
PROJECT)
|
||||
PROJECTNAME))])
|
||||
|
||||
(GIT-GET-PROJECT
|
||||
[LAMBDA (PROJECT NOERROR FIELD) (* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
[LAMBDA (PROJECT FIELD NOERROR) (* ; "Edited 7-Jul-2022 11:25 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 9-May-2022 20:02 by rmk")
|
||||
(* ; "Edited 8-May-2022 11:38 by rmk")
|
||||
(CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT)
|
||||
@@ -292,7 +292,12 @@
|
||||
(DEFAULTSUBDIRS
|
||||
(FETCH DEFAULTSUBDIRS OF PROJECT))
|
||||
(CLONEPATH (FETCH CLONEPATH OF PROJECT))
|
||||
(MAINBRANCH (FETCH MAINBRANCH OF PROJECT))
|
||||
(MAINBRANCH [OR (FETCH MAINBRANCH OF PROJECT)
|
||||
(REPLACE MAINBRANCH OF PROJECT WITH (OR (GIT-BRANCH-EXISTS? 'origin/main
|
||||
T PROJECT)
|
||||
(GIT-BRANCH-EXISTS?
|
||||
'origin/master NIL PROJECT
|
||||
])
|
||||
PROJECT))])
|
||||
|
||||
(GIT-PROJECT-PATH
|
||||
@@ -336,8 +341,9 @@
|
||||
(ERROR "NOT A GIT CLONE" PROJECTPATH])
|
||||
|
||||
(GIT-MAINBRANCH
|
||||
[LAMBDA (PROJECT LOCAL NOERROR) (* ; "Edited 9-May-2022 16:34 by rmk")
|
||||
(LET [(MB (GIT-GET-PROJECT PROJECT NOERROR 'MAINBRANCH]
|
||||
[LAMBDA (PROJECT LOCAL NOERROR) (* ; "Edited 7-Jul-2022 11:16 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:34 by rmk")
|
||||
(LET ((MB (GIT-GET-PROJECT PROJECT 'MAINBRANCH NOERROR)))
|
||||
(CL:IF LOCAL
|
||||
(CONCAT "local/" (STRIPWHERE MB))
|
||||
MB)])
|
||||
@@ -350,10 +356,12 @@
|
||||
THEN NIL
|
||||
ELSE (ERROR "Can't modify main branch" BRANCH])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
|
||||
@@ -388,7 +396,7 @@
|
||||
(LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
|
||||
PROJECT)
|
||||
(SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL)
|
||||
T)
|
||||
NIL T)
|
||||
THEN (SETQ PROJECT (CAR STAIL))
|
||||
(GO $$OUT))
|
||||
(CAR STAIL)))
|
||||
@@ -399,6 +407,7 @@
|
||||
(* ;; "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)
|
||||
((NIL T)
|
||||
(GIT-MY-CURRENT-BRANCH PROJECT))
|
||||
@@ -421,24 +430,28 @@
|
||||
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
|
||||
|
||||
(LET ((RB REMOTEBRANCH)
|
||||
(DR DRAFTS))
|
||||
(DR DRAFTS)
|
||||
(PRS))
|
||||
(IF PROJECT
|
||||
THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
ELSEIF (GIT-GET-PROJECT RB T)
|
||||
ELSEIF (GIT-GET-PROJECT RB NIL T)
|
||||
THEN (SETQ PROJECT RB)
|
||||
(SETQ RB NIL)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS T)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS NIL T)
|
||||
THEN (SETQ PROJECT DRAFTS)
|
||||
(SETQ DRFTS NIL))
|
||||
(CL:WHEN (MEMB (U-CASE RB)
|
||||
'(DRAFT DRAFTS))
|
||||
(SETQ RB NIL)
|
||||
(SETQ DR T))
|
||||
(GIT-COMMAND "git fetch")
|
||||
(CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT)
|
||||
"Pull requests")))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES RB (GIT-MAINBRANCH PROJECT)
|
||||
NIL PROJECT))))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT))
|
||||
(IF PRS
|
||||
THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS)
|
||||
"Pull requests")))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES RB (GIT-MAINBRANCH PROJECT)
|
||||
NIL PROJECT))
|
||||
ELSE "No open pull requests")))
|
||||
|
||||
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
|
||||
|
||||
@@ -447,10 +460,11 @@
|
||||
(CL:UNLESS (STRINGP NEXTTITLESTRING)
|
||||
(SETQ PROJECT NEXTTITLESTRING))
|
||||
(CL:UNLESS PROJECT
|
||||
(CL:WHEN (GIT-GET-PROJECT BRANCH T)
|
||||
(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))
|
||||
@@ -459,34 +473,35 @@
|
||||
(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 (FETCH PROJECTNAME OF PROJECT)
|
||||
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
T)
|
||||
" branches"]
|
||||
(GIT-CHECKOUT BRANCH PROJECT))))
|
||||
|
||||
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT)
|
||||
(GIT-FETCH PROJECT)
|
||||
(CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
T)
|
||||
" "
|
||||
(GIT-WHICH-BRANCH PROJECT)))
|
||||
|
||||
(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT T 'GHOST)
|
||||
(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 (TRUEFILENAME (GIT-GET-PROJECT PROJECT NIL 'GITHOST))
|
||||
(SLASHIT (/CNDIR (CONCAT (TRUEFILENAME (GIT-GET-PROJECT PROJECT 'GITHOST))
|
||||
(OR SUBDIR "")))
|
||||
T))
|
||||
|
||||
(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT 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 (TRUEFILENAME (GIT-GET-PROJECT PROJECT NIL 'WHOST))
|
||||
(SLASHIT (/CNDIR (CONCAT (TRUEFILENAME (GIT-GET-PROJECT PROJECT 'WHOST))
|
||||
(OR SUBDIR "")))
|
||||
T))
|
||||
|
||||
@@ -787,6 +802,12 @@
|
||||
(GIT-GET-FILE
|
||||
[LAMBDA (BRANCH GITFILE LOCALFILE NOERROR PROJECT)
|
||||
|
||||
(* ;; "Edited 8-Jul-2022 10:36 by rmk")
|
||||
|
||||
(* ;; "Edited 5-Jul-2022 00:09 by rmk: Redirect show command to tmp/ rename to localfile")
|
||||
|
||||
(* ;; "Edited 30-Jun-2022 22:09 by rmk")
|
||||
|
||||
(* ;; "Edited 22-May-2022 17:34 by rmk")
|
||||
|
||||
(* ;; "Edited 8-May-2022 16:54 by rmk: the stream, not the name because of the NODIRCORE case.")
|
||||
@@ -799,51 +820,32 @@
|
||||
|
||||
(CL:WHEN (AND BRANCH (STRPOS "local/" BRANCH 1 NIL T))
|
||||
(SETQ BRANCH (SUBSTRING BRANCH 7)))
|
||||
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT)
|
||||
"git show " BRANCH ":" GITFILE)))
|
||||
(SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(LET (BYTES)
|
||||
(IF (FOR I B C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I))
|
||||
DO
|
||||
(* ;;
|
||||
"Returns NIL if we run off the fatal string with a match, otherwise T")
|
||||
|
||||
(CL:UNLESS (SETQ B (\BIN s))
|
||||
(RETURN T))
|
||||
(PUSH BYTES B)
|
||||
(CL:UNLESS (EQ B C)
|
||||
(RETURN T)))
|
||||
THEN
|
||||
(* ;; "Don't open STREAM until we know the file is real")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM (OR LOCALFILE '{NODIRCORE)
|
||||
:IF-EXISTS :NEW-VERSION :DIRECTION :IO)
|
||||
(FOR B IN (DREVERSE BYTES) DO (\BOUT STREAM B))
|
||||
[DO (\BOUT STREAM (OR (\BIN s)
|
||||
(RETURN]
|
||||
(SETFILEINFO STREAM 'CREATIONDATE (OR (FILEDATE STREAM T)
|
||||
(FILEDATE STREAM)
|
||||
(GIT-FILE-DATE GITFILE BRANCH
|
||||
PROJECT)))
|
||||
STREAM)
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "GIT FILE NOT FOUND" GITFILE])
|
||||
(LET ((RESULTFILE (GIT-COMMAND-TO-FILE (CONCAT "git show " BRANCH ":" GITFILE)
|
||||
PROJECT T))
|
||||
TYPE DATE)
|
||||
(CL:WHEN (LISTP RESULTFILE) (* ; "CADR is Unix error stream")
|
||||
(CL:WITH-OPEN-FILE (ESTREAM (CADR RESULTFILE)
|
||||
:DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT))
|
||||
(COPYCHARS ESTREAM T))
|
||||
(DELFILE (CADR RESULTFILE))
|
||||
(SETQ RESULTFILE (CAR RESULTFILE)))
|
||||
(IF RESULTFILE
|
||||
THEN (CL:MULTIPLE-VALUE-SETQ (TYPE DATE)
|
||||
(LISPFILETYPE RESULTFILE))
|
||||
(SETFILEINFO RESULTFILE 'CREATIONDATE (OR DATE (GIT-FILE-DATE GITFILE BRANCH
|
||||
PROJECT)))
|
||||
(RENAMEFILE RESULTFILE LOCALFILE)
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "GIT FILE NOT FOUND" GITFILE])
|
||||
|
||||
(GIT-FILE-EXISTS?
|
||||
[LAMBDA (BRANCH GITFILE PROJECT) (* ; "Edited 8-May-2022 00:02 by rmk")
|
||||
(* ; "Edited 6-Mar-2022 19:04 by rmk")
|
||||
(* ; "Edited 10-Feb-2022 20:55 by rmk")
|
||||
(* ; "Edited 10-Dec-2021 21:30 by rmk")
|
||||
[LAMBDA (GFILE BRANCH PROJECT) (* ; "Edited 5-Jul-2022 10:27 by rmk")
|
||||
|
||||
(* ;; "T if GITFILE exists on BRANCH. If s is EOFP, the file exists but is empty")
|
||||
(* ;; "If the noerror DATE is NIL, the file doesn't exist. ")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT)
|
||||
"git show " BRANCH ":" GITFILE)))
|
||||
(SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: " I))
|
||||
ALWAYS (EQ (BIN s)
|
||||
C])
|
||||
(CL:WHEN (GIT-FILE-DATE GFILE BRANCH PROJECT T)
|
||||
T])
|
||||
|
||||
(GIT-REMOTE-UPDATE
|
||||
[LAMBDA (DOIT PROJECT)
|
||||
@@ -869,9 +871,8 @@
|
||||
(CAR RESULT])
|
||||
|
||||
(GIT-FILE-DATE
|
||||
[LAMBDA (GFILE BRANCH PROJECT) (* ; "Edited 8-May-2022 16:56 by rmk")
|
||||
(* ; "Edited 6-Mar-2022 17:41 by rmk")
|
||||
(* ; "Edited 3-Jan-2022 19:43 by rmk")
|
||||
[LAMBDA (GFILE BRANCH PROJECT NOERROR) (* ; "Edited 6-Jul-2022 19:39 by rmk")
|
||||
(* ; "Edited 5-Jul-2022 10:30 by rmk")
|
||||
(CL:WHEN (AND NIL BRANCH (STRPOS "local/" BRANCH 1 NIL T))
|
||||
(SETQ BRANCH (SUBSTRING BRANCH 7)))
|
||||
(LET [(DATE (CAR (GIT-COMMAND (CONCAT "git log -1 --pretty=%"format:%%cD%" "
|
||||
@@ -880,7 +881,70 @@
|
||||
"")
|
||||
(GIT-REPO-FILENAME GFILE PROJECT))
|
||||
NIL T PROJECT]
|
||||
(CL:UNLESS (OR DATE NOERROR)
|
||||
|
||||
(* ;; "We suppressed the generic error in GIT-COMMAND, so we could do our own thing")
|
||||
|
||||
(ERROR "GIT FILE NOT FOUND" GFILE))
|
||||
DATE])
|
||||
|
||||
(GIT-FILE-HISTORY
|
||||
[LAMBDA (FILE PROJECT PRINT) (* ; "Edited 4-Jul-2022 23:09 by rmk")
|
||||
(* ; "Edited 1-Jul-2022 22:57 by rmk")
|
||||
(LET ((LINES (GIT-COMMAND (CONCAT "git log --date=rfc -- " (GIT-REPO-FILENAME FILE PROJECT))
|
||||
T NIL (GIT-GET-PROJECT PROJECT)))
|
||||
VAL)
|
||||
[FOR L COMMIT COMMENTS POS IN (REVERSE LINES) UNLESS (ZEROP (NCHARS L))
|
||||
DO (IF (STRPOS "commit " L 1 NIL 1)
|
||||
THEN (CL:WHEN COMMENTS
|
||||
(SETQ COMMIT (NCONC1 COMMIT (CONS 'Comments COMMENTS)))
|
||||
(SETQ COMMENTS NIL))
|
||||
(PUSH VAL (CONS (LIST 'commit (SUBSTRING L 8))
|
||||
COMMIT))
|
||||
(SETQ COMMIT NIL)
|
||||
ELSEIF (EQ (CHARCODE SPACE)
|
||||
(CHCON1 L))
|
||||
THEN (PUSH COMMENTS (OR (SUBSTRING L (FIND I FROM 2
|
||||
SUCHTHAT (NEQ (CHARCODE SPACE)
|
||||
(NTHCHARCODE L I)))
|
||||
-1)
|
||||
T))
|
||||
ELSE (PUSH COMMIT (LIST [SUBATOM L 1 (OR (SETQ POS (SUB1 (STRPOS ": " L 1]
|
||||
(SUBSTRING L (FIND I FROM (IPLUS 2 POS)
|
||||
SUCHTHAT (NEQ (CHARCODE SPACE)
|
||||
(NTHCHARCODE L I)))
|
||||
-1]
|
||||
(CL:WHEN PRINT (GIT-PRINT-FILE-HISTORY VAL))
|
||||
(CONS (GIT-REPO-FILENAME FILE PROJECT)
|
||||
VAL])
|
||||
|
||||
(GIT-PRINT-FILE-HISTORY
|
||||
[LAMBDA (COMMITS AUTHORS) (* ; "Edited 2-Jul-2022 00:21 by rmk")
|
||||
(PRINTOUT T (CAR COMMITS)
|
||||
T)
|
||||
(FOR C AU IN (CDR COMMITS) EACHTIME (SETQ AU (CADR (ASSOC 'Author C)))
|
||||
WHEN (OR (NULL AUTHORS)
|
||||
(THEREIS A INSIDE AUTHORS SUCHTHAT (STRPOS A AU 1 NIL NIL NIL UPPERCASEARRAY)))
|
||||
DO (PRINTOUT T 5 (CAAR C)
|
||||
": "
|
||||
(CADAR C)
|
||||
T)
|
||||
(FOR X IN (CDR C)
|
||||
DO (PRINTOUT T 10 (CAR X)
|
||||
": ")
|
||||
(IF (EQ (CAR X)
|
||||
'Comments)
|
||||
THEN (FOR CC (POS _ (POSITION T)) IN (CDR X)
|
||||
DO (IF (EQ CC T)
|
||||
THEN (TERPRI T)
|
||||
ELSE (PRINTOUT T .TAB0 POS CC)))
|
||||
ELSE (PRINTOUT T (CADR X)))
|
||||
(TERPRI T))
|
||||
(TERPRI T])
|
||||
|
||||
(GIT-FETCH
|
||||
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk")
|
||||
(GIT-COMMAND "git fetch" T NIL PROJECT])
|
||||
)
|
||||
|
||||
|
||||
@@ -1047,12 +1111,21 @@
|
||||
0])])
|
||||
|
||||
(GIT-CHECKOUT
|
||||
[LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 15:12 by rmk")
|
||||
[LAMBDA (BRANCH PROJECT) (* ; "Edited 7-Jul-2022 20:21 by rmk")
|
||||
(* ; "Edited 9-May-2022 15:12 by rmk")
|
||||
(* ; "Edited 7-May-2022 23:51 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 22:40 by rmk:")
|
||||
(CAR (GIT-COMMAND (CONCAT "git checkout " (OR BRANCH (GIT-MAINBRANCH PROJECT))
|
||||
"; git pull")
|
||||
NIL NIL PROJECT])
|
||||
(CL:UNLESS BRANCH
|
||||
(SETQ BRANCH (GIT-MAINBRANCH PROJECT)))
|
||||
(LET ((CURRENTBRANCH (GIT-WHICH-BRANCH PROJECT)))
|
||||
[SETQ CURRENTBRANCH (SUBSTRING CURRENTBRANCH (ADD1 (STRPOS "/" CURRENTBRANCH]
|
||||
(CL:UNLESS [STRING.EQUAL CURRENTBRANCH (SUBSTRING BRANCH (ADD1 (OR (STRPOS "/" BRANCH)
|
||||
0]
|
||||
(GIT-COMMAND (CONCAT "git checkout " BRANCH)
|
||||
NIL T PROJECT)
|
||||
(CAR (GIT-COMMAND (CONCAT "git pull")
|
||||
NIL T PROJECT)))
|
||||
BRANCH])
|
||||
|
||||
(GIT-WHICH-BRANCH
|
||||
[LAMBDA (PROJECT) (* ; "Edited 7-May-2022 22:41 by rmk")
|
||||
@@ -1096,7 +1169,8 @@
|
||||
ELSE (HELP "Unexpected git result" RESULT])
|
||||
|
||||
(GIT-BRANCHES
|
||||
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 23-May-2022 14:25 by rmk")
|
||||
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 8-Jul-2022 10:33 by rmk")
|
||||
(* ; "Edited 23-May-2022 14:25 by rmk")
|
||||
(* ; "Edited 19-May-2022 10:06 by rmk")
|
||||
(* ; "Edited 9-May-2022 14:10 by rmk")
|
||||
(* ; "Edited 7-May-2022 23:29 by rmk")
|
||||
@@ -1116,7 +1190,7 @@
|
||||
(SETQ BRANCHES (APPEND LOCAL REMOTE))
|
||||
(CL:WHEN EXCLUDEMERGED
|
||||
(SETQ BRANCHES (FOR B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT 'LOCAL)) IN BRANCHES
|
||||
UNLESS (GIT-COMMIT-DIFFS MAINBRANCH B PROJECT) COLLECT B)))
|
||||
WHEN (GIT-COMMIT-DIFFS B MAINBRANCH PROJECT) COLLECT B)))
|
||||
(SORT BRANCHES])
|
||||
|
||||
(GIT-BRANCH-EXISTS?
|
||||
@@ -1142,11 +1216,13 @@
|
||||
MENUFONT _ DEFAULTFONT)))])
|
||||
|
||||
(GIT-PRC-MENU
|
||||
[LAMBDA (DRAFT PROJECT) (* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(LET ((PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(SETQ RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT))
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ LABEL (IF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
|
||||
@@ -1165,7 +1241,7 @@
|
||||
(CONCAT " " (CADR PR)
|
||||
" #"
|
||||
(CAR PR]
|
||||
T))])
|
||||
T)))])
|
||||
|
||||
(GIT-PULL-REQUESTS
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk")
|
||||
@@ -1615,7 +1691,8 @@
|
||||
'differences)])
|
||||
|
||||
(GIT-COMPARE-WORKTREE
|
||||
[LAMBDA (BRANCH DONTUPDATE PROJECT) (* ; "Edited 9-May-2022 16:17 by rmk")
|
||||
[LAMBDA (BRANCH DONTUPDATE PROJECT) (* ; "Edited 7-Jul-2022 11:17 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:17 by rmk")
|
||||
(CL:UNLESS DONTUPDATE
|
||||
(GIT-ADD-WORKTREE BRANCH T PROJECT)
|
||||
(GIT-ADD-WORKTREE (GIT-MAINBRANCH PROJECT)
|
||||
@@ -1625,7 +1702,7 @@
|
||||
(CL:UNLESS DONTUPDATE
|
||||
(GIT-ADD-WORKTREE BRANCH T PROJECT)
|
||||
(GIT-ADD-WORKTREE MAINBRANCH T PROJECT))
|
||||
(PRINTOUT T T "Comparing " (GIT-GET-PROJECT PROJECT NIL 'PROJECTNAME)
|
||||
(PRINTOUT T T "Comparing " (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
|
||||
(FETCH PROJECTNAME OF PROJECT)
|
||||
" origin/" BRANCH " and " MAINBRANCH T)
|
||||
(FOR FILE BFILE MFILE IN (GIT-BRANCH-DIFF BRANCH MAINBRANCH PROJECT)
|
||||
@@ -1813,11 +1890,12 @@
|
||||
(SHOULDNT])
|
||||
|
||||
(GIT-WORKING-COMPARE-FILES
|
||||
[LAMBDA (FILE PROJECT) (* ; "Edited 22-May-2022 14:45 by rmk")
|
||||
(LET ((FILE1 (UNSLASHIT (PACKFILENAME 'HOST (GIT-GET-PROJECT PROJECT NIL 'WHOST)
|
||||
[LAMBDA (FILE PROJECT) (* ; "Edited 7-Jul-2022 11:17 by rmk")
|
||||
(* ; "Edited 22-May-2022 14:45 by rmk")
|
||||
(LET ((FILE1 (UNSLASHIT (PACKFILENAME 'HOST (GIT-GET-PROJECT PROJECT 'WHOST)
|
||||
'BODY FILE)
|
||||
T))
|
||||
(FILE2 (SLASHIT (PACKFILENAME 'HOST (GIT-GET-PROJECT PROJECT NIL 'GITHOST)
|
||||
(FILE2 (SLASHIT (PACKFILENAME 'HOST (GIT-GET-PROJECT PROJECT 'GITHOST)
|
||||
'BODY FILE)
|
||||
T)))
|
||||
(CD-COMPARE-FILES FILE1 FILE2 FILE1 FILE2])
|
||||
@@ -1859,16 +1937,16 @@
|
||||
(DEFINEQ
|
||||
|
||||
(CDGITDIR
|
||||
[LAMBDA (PROJECT) (* ; "Edited 7-May-2022 22:41 by rmk")
|
||||
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 09:36 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:41 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 21:12 by rmk:")
|
||||
|
||||
(* ;; "Strips off {UNIX}")
|
||||
|
||||
(CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT]
|
||||
" ; "])
|
||||
" && "])
|
||||
|
||||
(GIT-COMMAND
|
||||
[LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 7-May-2022 22:40 by rmk")
|
||||
[LAMBDA (CMD ALL NOERROR PROJECT) (* ; "Edited 8-Jul-2022 10:20 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:40 by rmk")
|
||||
(* ; "Edited 7-Oct-2021 11:15 by rmk:")
|
||||
|
||||
(* ;; "Suppress .git lines unless ALL")
|
||||
@@ -1880,21 +1958,23 @@
|
||||
[BIND LPOS WHILE (SETQ LPOS (STRPOS "local/" CMD))
|
||||
DO (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS))
|
||||
(SUBSTRING CMD (IPLUS LPOS (NCHARS "local/"]
|
||||
(CL:WITH-OPEN-FILE (STREAM "{NODIRCORE}shell-dribble.txt" :DIRECTION :IO)
|
||||
(ShellCommand (CONCAT (CDGITDIR PROJECT)
|
||||
CMD)
|
||||
STREAM)
|
||||
(SETFILEPTR STREAM 0)
|
||||
(BIND LINE UNTIL (EOFP STREAM)
|
||||
WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1 NIL T] COLLECT LINE
|
||||
FINALLY (CL:UNLESS NOERROR
|
||||
(CL:WHEN (OR (EQ 1 (STRPOS "fatal" (CAR $$VAL)
|
||||
1 NIL T))
|
||||
(EQ 1 (STRPOS "gh: Command not found" (CAR $$VAL)
|
||||
1 NIL T)))
|
||||
(ERROR (CONCAT "Git command %"" CMD "%" failed")
|
||||
(CAR $$VAL))))])
|
||||
(LET (LINES (RESULTFILE (GIT-COMMAND-TO-FILE CMD PROJECT NOERROR)))
|
||||
(CL:WHEN (LISTP RESULTFILE) (* ; "CADR is Unix error stream")
|
||||
(CL:WITH-OPEN-FILE (ESTREAM (CADR RESULTFILE)
|
||||
:DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT))
|
||||
(COPYCHARS ESTREAM T))
|
||||
(DELFILE (CADR RESULTFILE))
|
||||
(SETQ RESULTFILE (CAR RESULTFILE)))
|
||||
(CL:WHEN RESULTFILE
|
||||
(SETQ LINES (CL:WITH-OPEN-FILE (STREAM RESULTFILE :DIRECTION :INPUT :EXTERNAL-FORMAT
|
||||
(SYSTEM-EXTERNALFORMAT))
|
||||
(BIND LINE UNTIL (EOFP STREAM)
|
||||
WHEN [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P NIL
|
||||
:EOF-VALUE NIL))
|
||||
(OR ALL (NOT (STRPOS ".git" LINE 1 NIL T] COLLECT
|
||||
LINE)))
|
||||
(DELFILE RESULTFILE) (* ; "On tmp/, OK if we miss")
|
||||
LINES)])
|
||||
|
||||
(GITORIGIN
|
||||
[LAMBDA (BRANCH LOCAL) (* ; "Edited 9-May-2022 14:26 by rmk")
|
||||
@@ -1919,32 +1999,94 @@
|
||||
(SUBSTRING INITIALS 1 -2)
|
||||
INITIALS)
|
||||
(ERROR "INITIALS is not set"])
|
||||
|
||||
(GIT-COMMAND-TO-FILE
|
||||
[LAMBDA (CMD PROJECT NOERROR) (* ; "Edited 9-Jul-2022 18:55 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 08:51 by rmk")
|
||||
|
||||
(* ;; "Try to make the temporary name unique. Maybe Unix mktemp, except that we need to know the name that was used. So we calculate it, provide it, and assume that it worked. Caller an decide to delete it after examination. (Or, left to be reaped from /tmp/)")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
|
||||
(* ;;
|
||||
"Filename of the form /tmp/medley-gitresult-{IDATE}-{rand} -- Avoid creating new unix directory")
|
||||
|
||||
(LET* ([PROJECTNAME (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME]
|
||||
(DATE (IDATE))
|
||||
(RAND (RAND))
|
||||
(RESULTFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-result"))
|
||||
(ERRORFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-error"))
|
||||
COMPLETED)
|
||||
[CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR PROJECT)
|
||||
CMD " > " (STRIPHOST RESULTFILE)
|
||||
" 2> "
|
||||
(STRIPHOST ERRORFILE)
|
||||
" && echo COMPLETED ")))
|
||||
(CLOSEF? ERRORFILE)
|
||||
|
||||
(* ;;
|
||||
"Avoid reading the process stream if there is another error signal. It ends to hang.")
|
||||
|
||||
(SETQ COMPLETED (IF (AND (INFILEP ERRORFILE)
|
||||
(IGREATERP (GETFILEINFO ERRORFILE 'LENGTH)
|
||||
0))
|
||||
THEN [CL:WITH-OPEN-FILE (ESTREAM ERRORFILE :DIRECTION :INPUT
|
||||
:EXTERNAL-FORMAT (
|
||||
SYSTEM-EXTERNALFORMAT
|
||||
))
|
||||
(OR (NEQ 0 (OR (FILEPOS "fatal: " ESTREAM 0 1)
|
||||
(FILEPOS "gh: Command not found"
|
||||
ESTREAM 0 1)
|
||||
(FILEPOS "unknown command %"" ESTREAM
|
||||
0 1)))
|
||||
(FILEPOS "' is not a git command." ESTREAM
|
||||
(NCHARS CMD]
|
||||
ELSE (SETFILEINFO PS 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(STREQUAL "COMPLETED" (RSTRING PS]
|
||||
(CLOSEF? RESULTFILE)
|
||||
(IF COMPLETED
|
||||
THEN (IF (IEQP 0 (GETFILEINFO ERRORFILE 'LENGTH))
|
||||
THEN (DELFILE ERRORFILE)
|
||||
(SETQ ERRORFILE NIL)
|
||||
ELSEIF (IEQP 0 (GETFILEINFO RESULTFILE 'LENGTH))
|
||||
THEN (SETQ RESULTFILE ERRORFILE)
|
||||
(SETQ ERRORFILE NIL))
|
||||
(IF ERRORFILE
|
||||
THEN (LIST RESULTFILE ERRORFILE)
|
||||
ELSE RESULTFILE)
|
||||
ELSE (DELFILE RESULTFILE)
|
||||
(DELFILE ERRORFILE)
|
||||
(IF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR (CONCAT "Command failed: " CMD])
|
||||
)
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3458 17305 (GIT-CLONEP 3468 . 4731) (GIT-MAKE-PROJECT 4733 . 12845) (GIT-GET-PROJECT
|
||||
12847 . 14184) (GIT-PROJECT-PATH 14186 . 15230) (FIND-ANCESTOR-DIRECTORY 15232 . 15581) (
|
||||
GIT-FIND-CLONE 15583 . 16664) (GIT-MAINBRANCH 16666 . 16950) (GIT-MAINBRANCH? 16952 . 17303)) (23311
|
||||
26099 (ALLSUBDIRS 23321 . 24607) (MEDLEYSUBDIRS 24609 . 25302) (GITSUBDIRS 25304 . 26097)) (26100
|
||||
30890 (TOGIT 26110 . 27516) (FROMGIT 27518 . 28499) (GIT-DELETE-FILE 28501 . 29347) (
|
||||
MYMEDLEY-DELETE-FILES 29349 . 30888)) (30891 33423 (MYMEDLEYSUBDIR 30901 . 31357) (GITSUBDIR 31359 .
|
||||
31802) (STRIPDIR 31804 . 32175) (STRIPHOST 32177 . 32417) (STRIPNAME 32419 . 33172) (STRIPWHERE 33174
|
||||
. 33421)) (33424 35326 (GFILE4MFILE 33434 . 33797) (MFILE4GFILE 33799 . 34368) (GIT-REPO-FILENAME
|
||||
34370 . 35324)) (35375 43176 (GIT-COMMIT 35385 . 36211) (GIT-PUSH 36213 . 36857) (GIT-PULL 36859 .
|
||||
37471) (GIT-APPROVAL 37473 . 37822) (GIT-GET-FILE 37824 . 40343) (GIT-FILE-EXISTS? 40345 . 41289) (
|
||||
GIT-REMOTE-UPDATE 41291 . 42015) (GIT-REMOTE-ADD 42017 . 42324) (GIT-FILE-DATE 42326 . 43174)) (43206
|
||||
51906 (GIT-BRANCH-DIFF 43216 . 47968) (GIT-COMMIT-DIFFS 47970 . 48523) (GIT-BRANCH-RELATIONS 48525 .
|
||||
51904)) (51951 60886 (GIT-BRANCH-NUM 51961 . 52534) (GIT-CHECKOUT 52536 . 53048) (GIT-WHICH-BRANCH
|
||||
53050 . 53348) (GIT-MAKE-BRANCH 53350 . 55094) (GIT-BRANCHES 55096 . 56587) (GIT-BRANCH-EXISTS? 56589
|
||||
. 57293) (GIT-PICK-BRANCH 57295 . 57623) (GIT-PRC-MENU 57625 . 59253) (GIT-PULL-REQUESTS 59255 .
|
||||
60272) (GIT-SHORT-BRANCH-NAME 60274 . 60565) (GIT-LONG-NAME 60567 . 60884)) (60916 64251 (
|
||||
GIT-MY-CURRENT-BRANCH 60926 . 61296) (GIT-MY-BRANCHP 61298 . 61803) (GIT-MY-NEXT-BRANCH 61805 . 62299)
|
||||
(GIT-MY-BRANCHES 62301 . 64249)) (64297 68249 (GIT-ADD-WORKTREE 64307 . 65791) (GIT-REMOVE-WORKTREE
|
||||
65793 . 66723) (GIT-LIST-WORKTREES 66725 . 67529) (WORKTREEDIR 67531 . 68247)) (68297 98073 (
|
||||
GIT-GET-DIFFERENT-FILES 68307 . 74132) (GIT-BRANCHES-COMPARE-DIRECTORIES 74134 . 79976) (
|
||||
GIT-WORKING-COMPARE-DIRECTORIES 79978 . 84724) (GIT-COMPARE-WORKTREE 84726 . 88599) (GITCDOBJBUTTONFN
|
||||
88601 . 93091) (GIT-CD-LABELFN 93093 . 94175) (GIT-CD-MENUFN 94177 . 96384) (GIT-WORKING-COMPARE-FILES
|
||||
96386 . 96905) (GIT-BRANCHES-COMPARE-FILES 96907 . 98071)) (98143 101126 (CDGITDIR 98153 . 98531) (
|
||||
GIT-COMMAND 98533 . 100119) (GITORIGIN 100121 . 100818) (GIT-INITIALS 100820 . 101124)))))
|
||||
(FILEMAP (NIL (3592 18006 (GIT-CLONEP 3602 . 4865) (GIT-MAKE-PROJECT 4867 . 12847) (GIT-GET-PROJECT
|
||||
12849 . 14774) (GIT-PROJECT-PATH 14776 . 15820) (FIND-ANCESTOR-DIRECTORY 15822 . 16171) (
|
||||
GIT-FIND-CLONE 16173 . 17254) (GIT-MAINBRANCH 17256 . 17651) (GIT-MAINBRANCH? 17653 . 18004)) (24323
|
||||
27111 (ALLSUBDIRS 24333 . 25619) (MEDLEYSUBDIRS 25621 . 26314) (GITSUBDIRS 26316 . 27109)) (27112
|
||||
31902 (TOGIT 27122 . 28528) (FROMGIT 28530 . 29511) (GIT-DELETE-FILE 29513 . 30359) (
|
||||
MYMEDLEY-DELETE-FILES 30361 . 31900)) (31903 34435 (MYMEDLEYSUBDIR 31913 . 32369) (GITSUBDIR 32371 .
|
||||
32814) (STRIPDIR 32816 . 33187) (STRIPHOST 33189 . 33429) (STRIPNAME 33431 . 34184) (STRIPWHERE 34186
|
||||
. 34433)) (34436 36338 (GFILE4MFILE 34446 . 34809) (MFILE4GFILE 34811 . 35380) (GIT-REPO-FILENAME
|
||||
35382 . 36336)) (36387 46175 (GIT-COMMIT 36397 . 37223) (GIT-PUSH 37225 . 37869) (GIT-PULL 37871 .
|
||||
38483) (GIT-APPROVAL 38485 . 38834) (GIT-GET-FILE 38836 . 40767) (GIT-FILE-EXISTS? 40769 . 41043) (
|
||||
GIT-REMOTE-UPDATE 41045 . 41769) (GIT-REMOTE-ADD 41771 . 42078) (GIT-FILE-DATE 42080 . 43011) (
|
||||
GIT-FILE-HISTORY 43013 . 44947) (GIT-PRINT-FILE-HISTORY 44949 . 45999) (GIT-FETCH 46001 . 46173)) (
|
||||
46205 54905 (GIT-BRANCH-DIFF 46215 . 50967) (GIT-COMMIT-DIFFS 50969 . 51522) (GIT-BRANCH-RELATIONS
|
||||
51524 . 54903)) (54950 64659 (GIT-BRANCH-NUM 54960 . 55533) (GIT-CHECKOUT 55535 . 56594) (
|
||||
GIT-WHICH-BRANCH 56596 . 56894) (GIT-MAKE-BRANCH 56896 . 58640) (GIT-BRANCHES 58642 . 60240) (
|
||||
GIT-BRANCH-EXISTS? 60242 . 60946) (GIT-PICK-BRANCH 60948 . 61276) (GIT-PRC-MENU 61278 . 63026) (
|
||||
GIT-PULL-REQUESTS 63028 . 64045) (GIT-SHORT-BRANCH-NAME 64047 . 64338) (GIT-LONG-NAME 64340 . 64657))
|
||||
(64689 68024 (GIT-MY-CURRENT-BRANCH 64699 . 65069) (GIT-MY-BRANCHP 65071 . 65576) (GIT-MY-NEXT-BRANCH
|
||||
65578 . 66072) (GIT-MY-BRANCHES 66074 . 68022)) (68070 72022 (GIT-ADD-WORKTREE 68080 . 69564) (
|
||||
GIT-REMOVE-WORKTREE 69566 . 70496) (GIT-LIST-WORKTREES 70498 . 71302) (WORKTREEDIR 71304 . 72020)) (
|
||||
72070 102052 (GIT-GET-DIFFERENT-FILES 72080 . 77905) (GIT-BRANCHES-COMPARE-DIRECTORIES 77907 . 83749)
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES 83751 . 88497) (GIT-COMPARE-WORKTREE 88499 . 92477) (GITCDOBJBUTTONFN
|
||||
92479 . 96969) (GIT-CD-LABELFN 96971 . 98053) (GIT-CD-MENUFN 98055 . 100262) (
|
||||
GIT-WORKING-COMPARE-FILES 100264 . 100884) (GIT-BRANCHES-COMPARE-FILES 100886 . 102050)) (102122
|
||||
109488 (CDGITDIR 102132 . 102692) (GIT-COMMAND 102694 . 104702) (GITORIGIN 104704 . 105401) (
|
||||
GIT-INITIALS 105403 . 105707) (GIT-COMMAND-TO-FILE 105709 . 109486)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
127
sources/FILEIO
127
sources/FILEIO
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Jul-2022 00:01:09"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;113 159763
|
||||
(FILECREATED " 8-Jul-2022 10:59:15"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;114 160097
|
||||
|
||||
:CHANGES-TO (FNS PUTSTREAMPROP GETSTREAMPROP \DO.PARAMS.AT.OPEN)
|
||||
(RECORDS STREAM)
|
||||
:CHANGES-TO (FNS COPYFILE \COPYOPENFILE)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 08:55:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FILEIO.;111)
|
||||
:PREVIOUS-DATE " 6-Jul-2022 00:01:09"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;113)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -2222,25 +2221,39 @@ update the map")
|
||||
T])
|
||||
|
||||
(COPYFILE
|
||||
[LAMBDA (FROMFILE TOFILE DESTPARAMETERS) (* ; "Edited 2-Jan-93 13:35 by jds")
|
||||
[LAMBDA (FROMFILE TOFILE DESTPARAMETERS SOURCEPARAMETERS)
|
||||
|
||||
(* ;;; "DESTPARAMETERS is like PARAMETERS arg to OPENSTREAM -- overrides default parameters")
|
||||
(* ;;
|
||||
"Edited 8-Jul-2022 10:54 by rmk: Added SOURCEPARAMETERS, in particular to declare external format")
|
||||
|
||||
(* ;; "Edited 8-Jul-2022 10:41 by rmk")
|
||||
|
||||
(* ;; "Edited 2-Jan-93 13:35 by jds")
|
||||
|
||||
(* ;;; "DESTPARAMETERS is like PARAMETERS arg to OPENSTREAM -- overrides default parameters")
|
||||
|
||||
[AND (DIRECTORYNAMEP (PACKFILENAME 'HOST NIL 'BODY TOFILE)
|
||||
(UNPACKFILENAME TOFILE 'HOST))
|
||||
(SETQ TOFILE (PACKFILENAME 'DIRECTORY TOFILE 'BODY (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FROMFILE]
|
||||
(RESETLST
|
||||
[RESETSAVE [SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT 'OLD '((SEQUENTIAL T)
|
||||
(DON'TCACHE T]
|
||||
[RESETSAVE [SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT 'OLD `((SEQUENTIAL T)
|
||||
(DON'TCACHE T)
|
||||
,@SOURCEPARAMETERS]
|
||||
'(PROGN (CLOSEF OLDVALUE]
|
||||
(\COPYOPENFILE FROMFILE TOFILE DESTPARAMETERS))])
|
||||
|
||||
(\COPYOPENFILE
|
||||
[LAMBDA (INSTREAM NEWNAME DESTPARAMETERS) (* ; "Edited 3-May-2021 20:36 by rmk:")
|
||||
(* ; "Edited 11-Dec-95 11:50 by ")
|
||||
(* ; "Edited 17-Sep-90 11:41 by jds")
|
||||
(* bvm%: "18-Oct-85 15:54")
|
||||
[LAMBDA (INSTREAM NEWNAME DESTPARAMETERS)
|
||||
|
||||
(* ;; "Edited 8-Jul-2022 10:58 by rmk: Use COPYCHARS if external formats are different")
|
||||
|
||||
(* ;; "Edited 3-May-2021 20:36 by rmk:")
|
||||
|
||||
(* ;; "Edited 11-Dec-95 11:50 by ")
|
||||
|
||||
(* ;; "Edited 17-Sep-90 11:41 by jds")
|
||||
(* bvm%: "18-Oct-85 15:54")
|
||||
(PROG ((PROPS DESTPARAMETERS)
|
||||
TYPE X OUTSTREAM)
|
||||
[COND
|
||||
@@ -2254,11 +2267,11 @@ update the map")
|
||||
(SETQ TYPE (\INFER.FILE.TYPE INSTREAM)))
|
||||
(push PROPS (LIST 'TYPE TYPE]
|
||||
|
||||
(* ;; "TAL removed : (COND ((AND (EQ TYPE 'TEXT) (SETQ X (GETFILEINFO INSTREAM 'EOL)) (NOT (ASSOC 'EOL DESTPARAMETERS))) (push PROPS (LIST 'EOL X)))) --- if the caller didn't specify, we ought to convert to the destination system's EOL convention for text files.")
|
||||
(* ;; "TAL removed : (COND ((AND (EQ TYPE 'TEXT) (SETQ X (GETFILEINFO INSTREAM 'EOL)) (NOT (ASSOC 'EOL DESTPARAMETERS))) (push PROPS (LIST 'EOL X)))) --- if the caller didn't specify, we ought to convert to the destination system's EOL convention for text files.")
|
||||
|
||||
(CL:UNLESS (EQ TYPE 'TEXT)
|
||||
|
||||
(* ;; "RMK: Setting the LENGTH seems wrong for TEXT files, since the byte-length could change if EOL or external-format differs. Let normal Length mechanisms prevail. Indeed, why bother with setting the length anyway--unless this is merely a hint for the opener? If so, the text guard can be removed.")
|
||||
(* ;; "RMK: Setting the LENGTH seems wrong for TEXT files, since the byte-length could change if EOL or external-format differs. Let normal Length mechanisms prevail. Indeed, why bother with setting the length anyway--unless this is merely a hint for the opener? If so, the text guard can be removed.")
|
||||
|
||||
[COND
|
||||
((SETQ X (GETFILEINFO INSTREAM 'LENGTH))
|
||||
@@ -2269,17 +2282,19 @@ update the map")
|
||||
'(AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE))
|
||||
(DELFILE OLDVALUE]
|
||||
|
||||
(* ;; "Obsoleted by Lyric's multiple streams: (OR (EQ (\GETFILEPTR INSTREAM) 0) (SETFILEPTR INSTREAM 0)) ;; In case it was open by someone else! Really need multiple streams, but until then at least don't lose big this way")
|
||||
(* ;; "Obsoleted by Lyric's multiple streams: (OR (EQ (\GETFILEPTR INSTREAM) 0) (SETFILEPTR INSTREAM 0)) ;; In case it was open by someone else! Really need multiple streams, but until then at least don't lose big this way")
|
||||
|
||||
(COND
|
||||
((EQ TYPE 'TEXT)
|
||||
((OR (EQ TYPE 'TEXT)
|
||||
(NEQ (ffetch (STREAM EXTERNALFORMAT) of INSTREAM)
|
||||
(ffetch (STREAM EXTERNALFORMAT) of OUTSTREAM)))
|
||||
|
||||
(* ;; "RMK: COPYCHARS ensures that external format conversion happens if necessary ")
|
||||
(* ;; "RMK: COPYCHARS ensures that external format conversion happens if necessary ")
|
||||
|
||||
(COPYCHARS INSTREAM OUTSTREAM))
|
||||
(T (COPYBYTES INSTREAM OUTSTREAM)))
|
||||
|
||||
(* ;; "On UNIX version, give FX the option of printing a warning when the file type is defaulted -- they want to discourage that behavior.")
|
||||
(* ;; "On UNIX version, give FX the option of printing a warning when the file type is defaulted -- they want to discourage that behavior.")
|
||||
|
||||
(AND (EQ \MACHINETYPE \MAIKO)
|
||||
FileTypeConfirmFlg
|
||||
@@ -2287,7 +2302,7 @@ update the map")
|
||||
(NULL (ASSOC 'TYPE DESTPARAMETERS))
|
||||
(\UFStoOtherCopyMess INSTREAM OUTSTREAM))
|
||||
|
||||
(* ;; "We return the closed stream.")
|
||||
(* ;; "We return the closed stream.")
|
||||
|
||||
(RETURN (CLOSEF OUTSTREAM])
|
||||
|
||||
@@ -3057,39 +3072,39 @@ update the map")
|
||||
(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1992 1993 1999 2020 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27526 31332 (STREAMPROP 27536 . 27970) (GETSTREAMPROP 27972 . 28567) (PUTSTREAMPROP
|
||||
28569 . 31180) (STREAMP 31182 . 31330)) (31375 33894 (\DEFPRINT.BY.NAME 31385 . 32537) (
|
||||
\STREAM.DEFPRINT 32539 . 33587) (\FDEV.DEFPRINT 33589 . 33892)) (34152 39193 (\GETACCESS 34162 . 34616
|
||||
) (\SETACCESS 34618 . 39191)) (59419 65388 (\DEFINEDEVICE 59429 . 61745) (\GETDEVICEFROMNAME 61747 .
|
||||
62220) (\GETDEVICEFROMHOSTNAME 62222 . 63266) (\REMOVEDEVICE 63268 . 64391) (\REMOVEDEVICE.NAMES 64393
|
||||
. 65386)) (65428 90319 (\CLOSEFILE 65438 . 66263) (\DELETEFILE 66265 . 66559) (\DEVICEEVENT 66561 .
|
||||
68331) (\GENERATEFILES 68333 . 69280) (\GENERATENEXTFILE 69282 . 69933) (\GENERATEFILEINFO 69935 .
|
||||
70396) (\GETFILENAME 70398 . 70787) (\GENERIC.OUTFILEP 70789 . 71259) (\OPENFILE 71261 . 73839) (
|
||||
\DO.PARAMS.AT.OPEN 73841 . 76156) (\RENAMEFILE 76158 . 76582) (\REVALIDATEFILE 76584 . 79186) (
|
||||
\PAGED.REVALIDATEFILELST 79188 . 80746) (\PAGED.REVALIDATEFILES 80748 . 82467) (\PAGED.REVALIDATEFILE
|
||||
82469 . 84752) (\BUFFERED.REVALIDATEFILE 84754 . 87040) (\BUFFERED.REVALIDATEFILELST 87042 . 88226) (
|
||||
\PRINT-REVALIDATION-RESULT 88228 . 88643) (\TRUNCATEFILE 88645 . 89036) (\FILE-CONFLICT 89038 . 90317)
|
||||
) (90355 95018 (\GENERATENOFILES 90365 . 92461) (\NULLFILEGENERATOR 92463 . 92707) (\NOFILESNEXTFILEFN
|
||||
92709 . 94700) (\NOFILESINFOFN 94702 . 95016)) (95137 97045 (\FILE.NOT.OPEN 95147 . 95660) (
|
||||
\FILE.WONT.OPEN 95662 . 95990) (\ILLEGAL.DEVICEOP 95992 . 96274) (\IS.NOT.RANDACCESSP 96276 . 96722) (
|
||||
\STREAM.NOT.OPEN 96724 . 97043)) (97180 99478 (\FDEVINSTANCE 97190 . 99476)) (100680 108054 (CNDIR
|
||||
100690 . 101995) (DIRECTORYNAME 101997 . 106180) (DIRECTORYNAMEP 106182 . 106798) (HOSTNAMEP 106800 .
|
||||
107607) (\ADD.CONNECTED.DIR 107609 . 108052)) (108099 135979 (\BACKFILEPTR 108109 . 108297) (
|
||||
\BACKPEEKBIN 108299 . 108660) (\BACKBIN 108662 . 109013) (BIN 109015 . 109232) (\BIN 109234 . 109511)
|
||||
(\BINS 109513 . 109799) (BOUT 109801 . 110163) (\BOUT 110165 . 110480) (\BOUTS 110482 . 110793) (
|
||||
COPYBYTES 110795 . 114127) (COPYCHARS 114129 . 117795) (COPYFILE 117797 . 118594) (\COPYOPENFILE
|
||||
118596 . 121669) (\INFER.FILE.TYPE 121671 . 122625) (EOFP 122627 . 122924) (FORCEOUTPUT 122926 .
|
||||
123173) (\FLUSH.OPEN.STREAMS 123175 . 123531) (CHARSET 123533 . 125197) (ACCESS-CHARSET 125199 .
|
||||
125416) (GETEOFPTR 125418 . 125668) (GETFILEINFO 125670 . 128863) (\TYPE.FROM.FILETYPE 128865 . 129335
|
||||
) (\FILETYPE.FROM.TYPE 129337 . 129516) (GETFILEPTR 129518 . 129770) (SETFILEINFO 129772 . 133878) (
|
||||
SETFILEPTR 133880 . 135599) (BOUT16 135601 . 135786) (BIN16 135788 . 135977)) (136082 141287 (
|
||||
\GENERIC.BINS 136092 . 136372) (\GENERIC.BOUTS 136374 . 136639) (\GENERIC.RENAMEFILE 136641 . 138472)
|
||||
(\GENERIC.OPENP 138474 . 139789) (\GENERIC.READP 139791 . 140832) (\GENERIC.CHARSET 140834 . 141285))
|
||||
(141288 141627 (\MAP-OPEN-STREAMS 141298 . 141625)) (143411 145491 (\EOF.ACTION 143421 . 143672) (
|
||||
\EOSERROR 143674 . 143867) (\GETEOFPTR 143869 . 144051) (\INCFILEPTR 144053 . 144403) (\PEEKBIN 144405
|
||||
. 144596) (\SETCLOSEDFILELENGTH 144598 . 144932) (\SETEOFPTR 144934 . 145122) (\SETFILEPTR 145124 .
|
||||
145489)) (145492 146034 (\FIXPOUT 145502 . 145802) (\FIXPIN 145804 . 146032)) (146035 146601 (\BOUTEOL
|
||||
146045 . 146599)) (149497 159361 (\BUFFERED.BIN 149507 . 150359) (\BUFFERED.PEEKBIN 150361 . 151143)
|
||||
(\BUFFERED.BOUT 151145 . 152005) (\BUFFERED.BINS 152007 . 155692) (\BUFFERED.BOUTS 155694 . 157495) (
|
||||
\BUFFERED.COPYBYTES 157497 . 159359)))))
|
||||
(FILEMAP (NIL (27467 31273 (STREAMPROP 27477 . 27911) (GETSTREAMPROP 27913 . 28508) (PUTSTREAMPROP
|
||||
28510 . 31121) (STREAMP 31123 . 31271)) (31316 33835 (\DEFPRINT.BY.NAME 31326 . 32478) (
|
||||
\STREAM.DEFPRINT 32480 . 33528) (\FDEV.DEFPRINT 33530 . 33833)) (34093 39134 (\GETACCESS 34103 . 34557
|
||||
) (\SETACCESS 34559 . 39132)) (59360 65329 (\DEFINEDEVICE 59370 . 61686) (\GETDEVICEFROMNAME 61688 .
|
||||
62161) (\GETDEVICEFROMHOSTNAME 62163 . 63207) (\REMOVEDEVICE 63209 . 64332) (\REMOVEDEVICE.NAMES 64334
|
||||
. 65327)) (65369 90260 (\CLOSEFILE 65379 . 66204) (\DELETEFILE 66206 . 66500) (\DEVICEEVENT 66502 .
|
||||
68272) (\GENERATEFILES 68274 . 69221) (\GENERATENEXTFILE 69223 . 69874) (\GENERATEFILEINFO 69876 .
|
||||
70337) (\GETFILENAME 70339 . 70728) (\GENERIC.OUTFILEP 70730 . 71200) (\OPENFILE 71202 . 73780) (
|
||||
\DO.PARAMS.AT.OPEN 73782 . 76097) (\RENAMEFILE 76099 . 76523) (\REVALIDATEFILE 76525 . 79127) (
|
||||
\PAGED.REVALIDATEFILELST 79129 . 80687) (\PAGED.REVALIDATEFILES 80689 . 82408) (\PAGED.REVALIDATEFILE
|
||||
82410 . 84693) (\BUFFERED.REVALIDATEFILE 84695 . 86981) (\BUFFERED.REVALIDATEFILELST 86983 . 88167) (
|
||||
\PRINT-REVALIDATION-RESULT 88169 . 88584) (\TRUNCATEFILE 88586 . 88977) (\FILE-CONFLICT 88979 . 90258)
|
||||
) (90296 94959 (\GENERATENOFILES 90306 . 92402) (\NULLFILEGENERATOR 92404 . 92648) (\NOFILESNEXTFILEFN
|
||||
92650 . 94641) (\NOFILESINFOFN 94643 . 94957)) (95078 96986 (\FILE.NOT.OPEN 95088 . 95601) (
|
||||
\FILE.WONT.OPEN 95603 . 95931) (\ILLEGAL.DEVICEOP 95933 . 96215) (\IS.NOT.RANDACCESSP 96217 . 96663) (
|
||||
\STREAM.NOT.OPEN 96665 . 96984)) (97121 99419 (\FDEVINSTANCE 97131 . 99417)) (100621 107995 (CNDIR
|
||||
100631 . 101936) (DIRECTORYNAME 101938 . 106121) (DIRECTORYNAMEP 106123 . 106739) (HOSTNAMEP 106741 .
|
||||
107548) (\ADD.CONNECTED.DIR 107550 . 107993)) (108040 136313 (\BACKFILEPTR 108050 . 108238) (
|
||||
\BACKPEEKBIN 108240 . 108601) (\BACKBIN 108603 . 108954) (BIN 108956 . 109173) (\BIN 109175 . 109452)
|
||||
(\BINS 109454 . 109740) (BOUT 109742 . 110104) (\BOUT 110106 . 110421) (\BOUTS 110423 . 110734) (
|
||||
COPYBYTES 110736 . 114068) (COPYCHARS 114070 . 117736) (COPYFILE 117738 . 118802) (\COPYOPENFILE
|
||||
118804 . 122003) (\INFER.FILE.TYPE 122005 . 122959) (EOFP 122961 . 123258) (FORCEOUTPUT 123260 .
|
||||
123507) (\FLUSH.OPEN.STREAMS 123509 . 123865) (CHARSET 123867 . 125531) (ACCESS-CHARSET 125533 .
|
||||
125750) (GETEOFPTR 125752 . 126002) (GETFILEINFO 126004 . 129197) (\TYPE.FROM.FILETYPE 129199 . 129669
|
||||
) (\FILETYPE.FROM.TYPE 129671 . 129850) (GETFILEPTR 129852 . 130104) (SETFILEINFO 130106 . 134212) (
|
||||
SETFILEPTR 134214 . 135933) (BOUT16 135935 . 136120) (BIN16 136122 . 136311)) (136416 141621 (
|
||||
\GENERIC.BINS 136426 . 136706) (\GENERIC.BOUTS 136708 . 136973) (\GENERIC.RENAMEFILE 136975 . 138806)
|
||||
(\GENERIC.OPENP 138808 . 140123) (\GENERIC.READP 140125 . 141166) (\GENERIC.CHARSET 141168 . 141619))
|
||||
(141622 141961 (\MAP-OPEN-STREAMS 141632 . 141959)) (143745 145825 (\EOF.ACTION 143755 . 144006) (
|
||||
\EOSERROR 144008 . 144201) (\GETEOFPTR 144203 . 144385) (\INCFILEPTR 144387 . 144737) (\PEEKBIN 144739
|
||||
. 144930) (\SETCLOSEDFILELENGTH 144932 . 145266) (\SETEOFPTR 145268 . 145456) (\SETFILEPTR 145458 .
|
||||
145823)) (145826 146368 (\FIXPOUT 145836 . 146136) (\FIXPIN 146138 . 146366)) (146369 146935 (\BOUTEOL
|
||||
146379 . 146933)) (149831 159695 (\BUFFERED.BIN 149841 . 150693) (\BUFFERED.PEEKBIN 150695 . 151477)
|
||||
(\BUFFERED.BOUT 151479 . 152339) (\BUFFERED.BINS 152341 . 156026) (\BUFFERED.BOUTS 156028 . 157829) (
|
||||
\BUFFERED.COPYBYTES 157831 . 159693)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user