Move internal/library to internal, xerox font dirs, loadup and medleydir (#709)

* Move internal/library to internal, xerox font dirs, loadup and medleydir

* and MEDLEYDIR too

* mised some changes in 'promote/internal'

* tiny typo

internal/TAR

@@ -0,0 +1,82 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
+
(FILECREATED "26-Jun-90 19:28:14" |{DSK}<usr>local>lde>lispcore>internal>library>TAR.;2|
 3663   
+
+      |changes| |to:|  (VARS TARCOMS)
+
+      |previous| |date:| "31-Dec-00 17:55:22" |{DSK}<usr>local>lde>lispcore>internal>library>TAR.;1|
+)
+
+
+; Copyright (c) 1987, 1900, 1990 by Venue & Xerox Corporation.  All rights reserved.
+
+(PRETTYCOMPRINT TARCOMS)
+
+(RPAQQ TARCOMS
 ((RECORDS TARHEADER)
+                    (FNS GATHER-NAME READ-TAR-FILE)))
+(DECLARE\: EVAL@COMPILE
+
+(BLOCKRECORD TARHEADER
 ((FILENAME BYTE 100)
+                            (MODE BYTE 8)
+                            (UID BYTE 8)
+                            (GID BYTE 8)
+                            (SIZE BYTE 12)
+                            (MTIME BYTE 12)
+                            (CHKSUM BYTE 8)
+                            (LINKFLAG BYTE)
+                            (LINKNAME BYTE 100)))
+)
+(DEFINEQ
+
+(GATHER-NAME

+  (LAMBDA (BASE OFFSET)
                                      (* \; "Edited 19-Oct-87 00:41 by jds")

+
+    (APPLY 'CONCAT (|bind|
 CH |for|
 I |from|
 OFFSET |to|
 100 |until|
 (ZEROP CH)
+                      |when|
 (NOT (ZEROP (SETQ CH (\\GETBASEBYTE BASE I))))
+                      |collect|
 (COND
+                                   ((IEQP CH (CHARCODE /))
+                                    ">")
+                                   ((IEQP CH (CHARCODE _))
+                                    "-")
+                                   (T (CHARACTER CH)))))))
+
+(READ-TAR-FILE

+  (LAMBDA (FILENAME START LIST-ONLY SKIP-EXISTING-FILES)
     (* \; "Edited 31-Dec-00 17:55 by jds")

+
+    (CL:WITH-OPEN-STREAM
+     (INSTREAM (OPENSTREAM FILENAME 'INPUT 'OLD '((SEQUENTIAL T)
+                                                  (BUFFERS 40))))
+     (LET* ((BUFFER (NCREATE 'VMEMPAGEP))
+            (SIZE-STRING (CL:MAKE-ARRAY 12 :ELEMENT-TYPE 'CL:STRING-CHAR :DISPLACED-TO-BASE
+                                (\\ADDBASE BUFFER 62)))
+            SIZE FILENAME OLDFPTR)
+          
+          (* |;;| "Read the file header:")

+
+           (SETFILEPTR INSTREAM (OR START 0))
+           (|while|
 (NOT (EOFP INSTREAM))
+              |do|
 (\\BINS INSTREAM BUFFER 0 512)
+                   (SETQ FILENAME (GATHER-NAME
 BUFFER 2))
+                   (SETQ SIZE (CL:WITH-INPUT-FROM-STRING (IN
 SIZE-STRING)
+                                     (LET ((*READTABLE* (FIND-READTABLE "XCL"))
+                                           (*READ-BASE* 8))
+                                          (CL:READ IN))))
+                   (PRINTOUT T "FILE:  " FILENAME ",  SIZE = " SIZE T)
+                   (COND
+                      ((AND (NOT LIST-ONLY)
+                            (> SIZE 0))
+                       (SETQ OLDFPTR (GETFILEPTR INSTREAM))
+                       (COND
+                          ((OR (NOT SKIP-EXISTING-FILES)
+                               (NOT (CL:PROBE-FILE FILENAME)))
+                           (CL:WITH-OPEN-STREAM (OUT (OPENSTREAM FILENAME 'OUTPUT 'NEW
+                                                            `((SEQUENTIAL T)
+                                                              (BUFFERS 40)
+                                                              (LENGTH ,SIZE))))
+                                  (COPYBYTES INSTREAM OUT SIZE))))
+                       (SETFILEPTR INSTREAM (+ OLDFPTR (ITIMES 512 (IQUOTIENT (+ SIZE 511)
+                                                                          512)))))))))))
+)
+(PUTPROPS TAR COPYRIGHT ("Venue & Xerox Corporation" 1987 1900 1990))
+(DECLARE\: DONTCOPY
+  (FILEMAP (NIL (944 3570 (GATHER-NAME 954 . 1560) (READ-TAR-FILE 1562 . 3568)))))
+STOP