Rmk62 old tedit formats and nits (#851)

* TEDIT-FIND, TEDIT-OFD: Read old-format TEDIT files

TEDIT-OFD also traps non-stream TEXT arguments that should no longer propagate

* EDITKEYS: Only BKSYSBUF when TEDIT has the TTY

Also, changed the name from Function Keys to Tedit Keys, made the shrunk window open on left-click

* COMPAREDIRECTORIES: better format when one of the columns is empty

* GITFNS: "cob next" asks to confirm the parent branch

* TEDIT-FILE:  Pass TEXTSTREAM to TEDIT.GET.OBJECT

* TEDIT-FILE again:  same problem in readers for old formats

* Eliminate (OPENTEXTSTREAM "")

lispusers/GITFNS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Jul-2022 11:13:13" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;418
 112329 
+
(FILECREATED "18-Jul-2022 21:45:18" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;428
 113994 
 
-      :CHANGES-TO (FNS GIT-PULL-REQUESTS GIT-BRANCH-DIFF PROCESS-COMMAND)
+      :CHANGES-TO (FNS GIT-MAKE-BRANCH)
 
-      :PREVIOUS-DATE "16-Jul-2022 22:22:54" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;414)
+      :PREVIOUS-DATE "18-Jul-2022 09:53:48" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;427)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -102,7 +102,7 @@
         (* ;; "Utilities")

 
         (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND 
-             GIT-RESULT-TO-LINES)
+             GIT-RESULT-TO-LINES STRIPLOCAL)
         (PROPS (GITFNS FILETYPE))))
 
 
@@ -803,6 +803,8 @@
 (GIT-GET-FILE

   [LAMBDA (BRANCH GITFILE LOCALFILE NOERROR PROJECT)
 
+    (* ;; "Edited 18-Jul-2022 09:18 by rmk")

+
     (* ;; "Edited  8-Jul-2022 10:36 by rmk")

 
     (* ;; "Edited  5-Jul-2022 00:09 by rmk: Redirect show command to tmp/ rename to localfile")

@@ -833,8 +835,8 @@
          (IF
 RESULTFILE
              THEN
 (CL:MULTIPLE-VALUE-SETQ (TYPE DATE)
                          (LISPFILETYPE RESULTFILE))
-                  (SETFILEINFO RESULTFILE 'CREATIONDATE (OR DATE (GIT-FILE-DATE
 GITFILE BRANCH 
-                                                                        PROJECT)))
+                  (CL:WHEN (OR DATE (SETQ DATE (GIT-FILE-DATE
 GITFILE BRANCH PROJECT NOERROR)))
+                      (SETFILEINFO RESULTFILE 'CREATIONDATE DATE))
                   (RENAMEFILE RESULTFILE LOCALFILE)
            ELSEIF
 NOERROR
              THEN
 NIL
@@ -1166,7 +1168,8 @@
     (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND
 "git rev-parse --abbrev-ref HEAD" NIL NIL PROJECT])
 
 (GIT-MAKE-BRANCH

-  [LAMBDA (NAME TITLESTRING PROJECT)
                         (* ; "Edited 19-May-2022 17:57 by rmk")


+  [LAMBDA (NAME TITLESTRING PROJECT)
                         (* ; "Edited 18-Jul-2022 21:45 by rmk")


+                                                             (* ; "Edited 19-May-2022 17:57 by rmk")


                                                              (* ; "Edited  9-May-2022 15:13 by rmk")

 
     (* ;; " The new branch is directly under the currently checked out branch.  Maybe it should always make it under the main branch?")

@@ -1188,19 +1191,25 @@
                                                     ELSE
 C]
         (SETQ NAME (CONCAT NAME "--" TITLESTRING)))
     (LET ((UNDER (GIT-WHICH-BRANCH
 PROJECT))
-          (RESULT (GIT-COMMAND
 (CONCAT "git checkout -b " NAME)
-                         NIL NIL PROJECT)))
-         (IF
 (STREQUAL (CAR RESULT)
-                    (CONCAT "Switched to a new branch '" NAME "'"))
-             THEN
 (CONCAT (CAR RESULT)
-                         " under " UNDER)
-           ELSEIF
 (STREQUAL (CAR RESULT)
-                         (CONCAT "fatal: A branch named '" NAME "' already exists."))
-             THEN
 (ERROR NAME "already exists")
-           ELSE
 (HELP "Unexpected git result" RESULT])
+          RESULT)
+         (IF
 (EQ 'Y (ASKUSER NIL 'N (CONCAT "Branch " NAME " will be created under " UNDER 
+                                           ". Is that OK? ")))
+             THEN
 (SETQ RESULT (GIT-COMMAND
 (CONCAT "git checkout -b " NAME)
+                                      NIL NIL PROJECT))
+                  (IF
 (STREQUAL (CAR RESULT)
+                             (CONCAT "Switched to a new branch '" NAME "'"))
+                      THEN
 (CONCAT (CAR RESULT)
+                                  " under " UNDER)
+                    ELSEIF
 (STREQUAL (CAR RESULT)
+                                  (CONCAT "fatal: A branch named '" NAME "' already exists."))
+                      THEN
 (ERROR NAME "already exists")
+                    ELSE
 (HELP "Unexpected git result" RESULT))
+           ELSE
 (PRINTOUT T "New branch not created" T)
+                NIL])
 
 (GIT-BRANCHES

-  [LAMBDA (WHERE
 PROJECT EXCLUDEMERGED)
                      (* ; "Edited  8-Jul-2022 10:33 by rmk")


+  [LAMBDA (WHERE
 PROJECT EXCLUDEMERGED)
                      (* ; "Edited 18-Jul-2022 08:11 by rmk")


+                                                             (* ; "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")


@@ -1211,17 +1220,20 @@
 
     (LET ([LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
                                 '(NIL ALL LOCAL))
-                     (FOR
 B IN
 (GIT-COMMAND
 "git branch" NIL NIL PROJECT)
-                        COLLECT
 (PACK* "local/" (SUBATOM B 3))))]
+                     [FOR
 B IN
 (GIT-COMMAND
 "git branch" NIL NIL PROJECT)
+                        COLLECT
 (SUBATOM B 3 (SUB1 (OR (STRPOS " -> " B)
+                                                       0])]
           [REMOTE (CL:WHEN (MEMB (U-CASE WHERE)
                                  '(NIL ALL REMOTE T))
-                      (FOR
 B IN
 (GIT-COMMAND
 "git branch -r" NIL NIL PROJECT)
-                         COLLECT
 (SUBATOM B 3)))]
+                      [FOR
 B IN
 (GIT-COMMAND
 "git branch -r" NIL NIL PROJECT)
+                         COLLECT
 (SUBATOM B 3 (SUB1 (OR (STRPOS " -> " B)
+                                                        0])]
           BRANCHES)
-         (SETQ BRANCHES (APPEND LOCAL REMOTE))
+         (SETQ BRANCHES (UNION LOCAL REMOTE))
          (CL:WHEN EXCLUDEMERGED
              (SETQ BRANCHES (FOR
 B (MAINBRANCH _ (GIT-MAINBRANCH
 PROJECT 'LOCAL)) IN
 BRANCHES
-                               WHEN
 (GIT-COMMIT-DIFFS
 B MAINBRANCH PROJECT) COLLECT
 B)))
+                               WHEN
 (EQUAL (GIT-COMMAND
 (CONCAT "git merge-base " B " " MAINBRANCH))
+                                           (GIT-COMMAND
 (CONCAT "git rev-parse " B))) COLLECT
 B)))
          (SORT BRANCHES])
 
 (GIT-BRANCH-EXISTS?

@@ -2030,7 +2042,8 @@
         (ERROR "INITIALS is not set"])
 
 (GIT-COMMAND-TO-FILE

-  [LAMBDA (CMD PROJECT NOERROR)
                              (* ; "Edited 16-Jul-2022 10:09 by rmk")


+  [LAMBDA (CMD PROJECT NOERROR)
                              (* ; "Edited 18-Jul-2022 09:53 by rmk")


+                                                             (* ; "Edited 16-Jul-2022 10:09 by rmk")


                                                              (* ; "Edited  9-Jul-2022 18:55 by rmk")


                                                              (* ; "Edited  8-Jul-2022 08:51 by rmk")

 
@@ -2040,6 +2053,7 @@
 
     (* ;; "Filename of  the form /tmp/medley-gitresult-{IDATE}-{rand} ")

 
+    (SETQ CMD (STRIPLOCAL
 CMD))
     (LET* ([PROJECTNAME (L-CASE (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME]
            (DATE (IDATE))
            (RAND (RAND))
@@ -2104,35 +2118,47 @@
                                                                         NIL :EOF-VALUE NIL))
                                                       (OR ALL (NOT (STRPOS ".git" LINE 1]
               COLLECT
 LINE])
+
+(STRIPLOCAL

+  [LAMBDA (STRING)
                                           (* ; "Edited 18-Jul-2022 09:52 by rmk")

+
+    (* ;; "Removes local/ substrings wherever they appear.  To be used in coerecing from a lisp internal convention that local branches carry a local tag to the git convention that an unqualified name is local.")

+
+    [BIND
 POS WHILE
 (SETQ POS (STRPOS "local/" STRING))
+       DO
 (SETQ STRING (CONCAT (SUBSTRING STRING 1 (SUB1 POS))
+                              (OR (SUBSTRING STRING (IPLUS POS (CONSTANT (NCHARS "local/")))
+                                         -1)
+                                  ""]
+    STRING])
 )
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3626 18158 (GIT-CLONEP 3636 . 4899) (GIT-MAKE-PROJECT 4901 . 12999) (GIT-GET-PROJECT 
-13001 . 14926) (GIT-PROJECT-PATH 14928 . 15972) (FIND-ANCESTOR-DIRECTORY 15974 . 16323) (
-GIT-FIND-CLONE 16325 . 17406) (GIT-MAINBRANCH 17408 . 17803) (GIT-MAINBRANCH? 17805 . 18156)) (24475 
-27263 (ALLSUBDIRS 24485 . 25771) (MEDLEYSUBDIRS 25773 . 26466) (GITSUBDIRS 26468 . 27261)) (27264 
-32054 (TOGIT 27274 . 28680) (FROMGIT 28682 . 29663) (GIT-DELETE-FILE 29665 . 30511) (
-MYMEDLEY-DELETE-FILES 30513 . 32052)) (32055 34587 (MYMEDLEYSUBDIR 32065 . 32521) (GITSUBDIR 32523 . 
-32966) (STRIPDIR 32968 . 33339) (STRIPHOST 33341 . 33581) (STRIPNAME 33583 . 34336) (STRIPWHERE 34338
- . 34585)) (34588 36490 (GFILE4MFILE 34598 . 34961) (MFILE4GFILE 34963 . 35532) (GIT-REPO-FILENAME 
-35534 . 36488)) (36539 46327 (GIT-COMMIT 36549 . 37375) (GIT-PUSH 37377 . 38021) (GIT-PULL 38023 . 
-38635) (GIT-APPROVAL 38637 . 38986) (GIT-GET-FILE 38988 . 40919) (GIT-FILE-EXISTS? 40921 . 41195) (
-GIT-REMOTE-UPDATE 41197 . 41921) (GIT-REMOTE-ADD 41923 . 42230) (GIT-FILE-DATE 42232 . 43163) (
-GIT-FILE-HISTORY 43165 . 45099) (GIT-PRINT-FILE-HISTORY 45101 . 46151) (GIT-FETCH 46153 . 46325)) (
-46357 57089 (GIT-BRANCH-DIFF 46367 . 53151) (GIT-COMMIT-DIFFS 53153 . 53706) (GIT-BRANCH-RELATIONS 
-53708 . 57087)) (57134 67092 (GIT-BRANCH-NUM 57144 . 57717) (GIT-CHECKOUT 57719 . 58778) (
-GIT-WHICH-BRANCH 58780 . 59078) (GIT-MAKE-BRANCH 59080 . 60824) (GIT-BRANCHES 60826 . 62424) (
-GIT-BRANCH-EXISTS? 62426 . 63130) (GIT-PICK-BRANCH 63132 . 63460) (GIT-PRC-MENU 63462 . 65210) (
-GIT-PULL-REQUESTS 65212 . 66478) (GIT-SHORT-BRANCH-NAME 66480 . 66771) (GIT-LONG-NAME 66773 . 67090)) 
-(67122 70457 (GIT-MY-CURRENT-BRANCH 67132 . 67502) (GIT-MY-BRANCHP 67504 . 68009) (GIT-MY-NEXT-BRANCH 
-68011 . 68505) (GIT-MY-BRANCHES 68507 . 70455)) (70503 74455 (GIT-ADD-WORKTREE 70513 . 71997) (
-GIT-REMOVE-WORKTREE 71999 . 72929) (GIT-LIST-WORKTREES 72931 . 73735) (WORKTREEDIR 73737 . 74453)) (
-74503 104485 (GIT-GET-DIFFERENT-FILES 74513 . 80338) (GIT-BRANCHES-COMPARE-DIRECTORIES 80340 . 86182) 
-(GIT-WORKING-COMPARE-DIRECTORIES 86184 . 90930) (GIT-COMPARE-WORKTREE 90932 . 94910) (GITCDOBJBUTTONFN
- 94912 . 99402) (GIT-CD-LABELFN 99404 . 100486) (GIT-CD-MENUFN 100488 . 102695) (
-GIT-WORKING-COMPARE-FILES 102697 . 103317) (GIT-BRANCHES-COMPARE-FILES 103319 . 104483)) (104555 
-112262 (CDGITDIR 104565 . 105125) (GIT-COMMAND 105127 . 106685) (GITORIGIN 106687 . 107384) (
-GIT-INITIALS 107386 . 107690) (GIT-COMMAND-TO-FILE 107692 . 111036) (PROCESS-COMMAND 111038 . 111651) 
-(GIT-RESULT-TO-LINES 111653 . 112260)))))
+  (FILEMAP (NIL (3603 18135 (GIT-CLONEP 3613 . 4876) (GIT-MAKE-PROJECT 4878 . 12976) (GIT-GET-PROJECT 
+12978 . 14903) (GIT-PROJECT-PATH 14905 . 15949) (FIND-ANCESTOR-DIRECTORY 15951 . 16300) (
+GIT-FIND-CLONE 16302 . 17383) (GIT-MAINBRANCH 17385 . 17780) (GIT-MAINBRANCH? 17782 . 18133)) (24452 
+27240 (ALLSUBDIRS 24462 . 25748) (MEDLEYSUBDIRS 25750 . 26443) (GITSUBDIRS 26445 . 27238)) (27241 
+32031 (TOGIT 27251 . 28657) (FROMGIT 28659 . 29640) (GIT-DELETE-FILE 29642 . 30488) (
+MYMEDLEY-DELETE-FILES 30490 . 32029)) (32032 34564 (MYMEDLEYSUBDIR 32042 . 32498) (GITSUBDIR 32500 . 
+32943) (STRIPDIR 32945 . 33316) (STRIPHOST 33318 . 33558) (STRIPNAME 33560 . 34313) (STRIPWHERE 34315
+ . 34562)) (34565 36467 (GFILE4MFILE 34575 . 34938) (MFILE4GFILE 34940 . 35509) (GIT-REPO-FILENAME 
+35511 . 36465)) (36516 46338 (GIT-COMMIT 36526 . 37352) (GIT-PUSH 37354 . 37998) (GIT-PULL 38000 . 
+38612) (GIT-APPROVAL 38614 . 38963) (GIT-GET-FILE 38965 . 40930) (GIT-FILE-EXISTS? 40932 . 41206) (
+GIT-REMOTE-UPDATE 41208 . 41932) (GIT-REMOTE-ADD 41934 . 42241) (GIT-FILE-DATE 42243 . 43174) (
+GIT-FILE-HISTORY 43176 . 45110) (GIT-PRINT-FILE-HISTORY 45112 . 46162) (GIT-FETCH 46164 . 46336)) (
+46368 57100 (GIT-BRANCH-DIFF 46378 . 53162) (GIT-COMMIT-DIFFS 53164 . 53717) (GIT-BRANCH-RELATIONS 
+53719 . 57098)) (57145 67947 (GIT-BRANCH-NUM 57155 . 57728) (GIT-CHECKOUT 57730 . 58789) (
+GIT-WHICH-BRANCH 58791 . 59089) (GIT-MAKE-BRANCH 59091 . 61304) (GIT-BRANCHES 61306 . 63279) (
+GIT-BRANCH-EXISTS? 63281 . 63985) (GIT-PICK-BRANCH 63987 . 64315) (GIT-PRC-MENU 64317 . 66065) (
+GIT-PULL-REQUESTS 66067 . 67333) (GIT-SHORT-BRANCH-NAME 67335 . 67626) (GIT-LONG-NAME 67628 . 67945)) 
+(67977 71312 (GIT-MY-CURRENT-BRANCH 67987 . 68357) (GIT-MY-BRANCHP 68359 . 68864) (GIT-MY-NEXT-BRANCH 
+68866 . 69360) (GIT-MY-BRANCHES 69362 . 71310)) (71358 75310 (GIT-ADD-WORKTREE 71368 . 72852) (
+GIT-REMOVE-WORKTREE 72854 . 73784) (GIT-LIST-WORKTREES 73786 . 74590) (WORKTREEDIR 74592 . 75308)) (
+75358 105340 (GIT-GET-DIFFERENT-FILES 75368 . 81193) (GIT-BRANCHES-COMPARE-DIRECTORIES 81195 . 87037) 
+(GIT-WORKING-COMPARE-DIRECTORIES 87039 . 91785) (GIT-COMPARE-WORKTREE 91787 . 95765) (GITCDOBJBUTTONFN
+ 95767 . 100257) (GIT-CD-LABELFN 100259 . 101341) (GIT-CD-MENUFN 101343 . 103550) (
+GIT-WORKING-COMPARE-FILES 103552 . 104172) (GIT-BRANCHES-COMPARE-FILES 104174 . 105338)) (105410 
+113927 (CDGITDIR 105420 . 105980) (GIT-COMMAND 105982 . 107540) (GITORIGIN 107542 . 108239) (
+GIT-INITIALS 108241 . 108545) (GIT-COMMAND-TO-FILE 108547 . 112036) (PROCESS-COMMAND 112038 . 112651) 
+(GIT-RESULT-TO-LINES 112653 . 113260) (STRIPLOCAL 113262 . 113925)))))
 STOP