initial checkin for library

library/CASH-FILE

@@ -0,0 +1 @@
+(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "CASH-FILE" (USE "LISP" "XCL")))
(IL:FILECREATED "11-Jun-90 14:33:44" IL:|{DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2|
 6688         IL:|changes| IL:|to:|  (IL:VARS IL:CASH-FILECOMS)      IL:|previous| IL:|date:| " 9-Oct-87 11:22:19" IL:|{DSK}<usr>local>lde>lispcore>library>CASH-FILE.;1|); Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.(IL:PRETTYCOMPRINT IL:CASH-FILECOMS)(IL:RPAQQ IL:CASH-FILECOMS
          ((IL:P (PROVIDE "CASH-FILE")                 (EXPORT '(MAKE-CASH-FILE OPEN-CASH-FILE GET-CASH-FILE REM-CASH-FILE CASH-FILE                                  CASH-FILE-P CASH-FILE-HASH-FILE)                        "CASH-FILE")                 (REQUIRE "HASH-FILE" "HASH-FILE.DFASL")                 (USE-PACKAGE "HASH-FILE" "CASH-FILE"))           (IL:STRUCTURES CASH-FILE)           (IL:FUNCTIONS %PRINT-CASH-FILE)           (IL:VARIABLES NOT-IN-HASH-FILE)           (IL:FUNCTIONS MAKE-CASH-FILE OPEN-CASH-FILE GET-CASH-FILE PUT-CASH-FILE REM-CASH-FILE)           (IL:SETFS GET-CASH-FILE)           (IL:FUNCTIONS MOVE-TO-HEAD-OF-QUEUE ADD-TO-CACHE DEL-FROM-CACHE)           (IL:PROP (IL:MAKEFILE-ENVIRONMENT IL:FILETYPE)                  IL:CASH-FILE)))(PROVIDE "CASH-FILE")(EXPORT '(MAKE-CASH-FILE OPEN-CASH-FILE GET-CASH-FILE REM-CASH-FILE CASH-FILE CASH-FILE-P                 CASH-FILE-HASH-FILE)       "CASH-FILE")(REQUIRE "HASH-FILE" "HASH-FILE.DFASL")(USE-PACKAGE "HASH-FILE" "CASH-FILE")(DEFSTRUCT (CASH-FILE
 (:CONSTRUCTOR MAKE-CASH-FILE-INTERNAL)                          (:PRINT-FUNCTION %PRINT-CASH-FILE))   (CACHE NIL :TYPE HASH-TABLE :READ-ONLY T)   (CACHE-SIZE NIL :TYPE INTEGER :READ-ONLY T)   (QUEUE NIL :TYPE LIST)   (HASH-FILE NIL :TYPE HASH-FILE :READ-ONLY T))(DEFUN %PRINT-CASH-FILE
 (CASH-FILE STREAM DEPTH)   (FORMAT STREAM "#<Cash-File on ~A>" (LET* ((STREAM (HASH-FILE::HASH-FILE-STREAM (                                                                                  CASH-FILE-HASH-FILE                                                                                    CASH-FILE)))                                              (NAMESTRING (NAMESTRING (PATHNAME STREAM))))                                             (IF NAMESTRING                                                 NAMESTRING                                                 STREAM))))(DEFCONSTANT NOT-IN-HASH-FILE
 '(NOT-IN-HASH-FILE))(DEFUN MAKE-CASH-FILE
 (FILE-NAME SIZE CACHE-SIZE)   (MAKE-CASH-FILE-INTERNAL :HASH-FILE (MAKE-HASH-FILE FILE-NAME SIZE)          :CACHE          (MAKE-HASH-TABLE :SIZE CACHE-SIZE :TEST 'EQUAL)          :CACHE-SIZE CACHE-SIZE))(DEFUN OPEN-CASH-FILE
 (FILE-NAME CACHE-SIZE &KEY (DIRECTION :INPUT))   (MAKE-CASH-FILE-INTERNAL :HASH-FILE (OPEN-HASH-FILE FILE-NAME :DIRECTION DIRECTION)          :CACHE          (MAKE-HASH-TABLE :SIZE CACHE-SIZE :TEST 'EQUAL)          :CACHE-SIZE CACHE-SIZE))(DEFUN GET-CASH-FILE
 (KEY CASH-FILE &OPTIONAL DEFAULT)   (MULTIPLE-VALUE-BIND (VALUE FOUND?)          (GETHASH KEY (CASH-FILE-CACHE CASH-FILE))          (COND             (FOUND?                     (IL:* IL:|;;| "cache hit ")
                    (MOVE-TO-HEAD-OF-QUEUE KEY CASH-FILE)                    (IF (EQ VALUE NOT-IN-HASH-FILE)                        (IL:* IL:|;;| "it was a cached miss")
                        (VALUES DEFAULT NIL)                        (IL:* IL:|;;| "it was a cached hit")
                        (VALUES                                (IL:* IL:|;;| 
           "return a copy to be compatable with GET-HASH-FILE which always hands you new structure")
                               (COPY-TREE VALUE)                               T)))             (T                 (IL:* IL:|;;| "try the HASH-FILE")
                (MULTIPLE-VALUE-SETQ (VALUE FOUND?)                       (GET-HASH-FILE KEY (CASH-FILE-HASH-FILE CASH-FILE)))                (IL:* IL:|;;| "cache what we found")
                (ADD-TO-CACHE KEY (IF FOUND?                                      (IL:* IL:|;;| "cache the VALUE")
                                      VALUE                                      (IL:* IL:|;;| "cache the miss")
                                      NOT-IN-HASH-FILE)                       CASH-FILE)                (IL:* IL:|;;| "return VALUE or DEFAULT")
                (IF FOUND?                    (VALUES VALUE T)                    (VALUES DEFAULT NIL))))))(DEFUN PUT-CASH-FILE
 (KEY CASH-FILE VALUE)   (IL:* IL:|;;| "add it to the hash file")
   (SETF (GET-HASH-FILE KEY (CASH-FILE-HASH-FILE CASH-FILE))         VALUE)   (IL:* IL:|;;| "add it to the cache")
   (ADD-TO-CACHE KEY VALUE CASH-FILE)   VALUE)(DEFUN REM-CASH-FILE
 (KEY CASH-FILE)   (LET ((FOUND? (REM-HASH-FILE KEY (CASH-FILE-HASH-FILE CASH-FILE))))        (WHEN FOUND? (DEL-FROM-CACHE KEY CASH-FILE))        FOUND?))(DEFSETF GET-CASH-FILE
 PUT-CASH-FILE)(DEFUN MOVE-TO-HEAD-OF-QUEUE
 (KEY CASH-FILE)   (SETF (CASH-FILE-QUEUE CASH-FILE)         (DELETE KEY (CASH-FILE-QUEUE CASH-FILE)                :TEST                'EQUAL :COUNT 1))   (PUSH KEY (CASH-FILE-QUEUE CASH-FILE)))(DEFUN ADD-TO-CACHE
 (KEY VALUE CASH-FILE)   (LET ((CACHE (CASH-FILE-CACHE CASH-FILE)))        (IF (>= (HASH-TABLE-COUNT CACHE)                (CASH-FILE-CACHE-SIZE CASH-FILE))            (IL:* IL:|;;| "cache is full -- throw out last entry")
            (DEL-FROM-CACHE (CAR (LAST (CASH-FILE-QUEUE CASH-FILE)))                   CASH-FILE))        (IL:* IL:|;;| "store VALUE in the cache")
        (SETF (GETHASH KEY CACHE)              VALUE)        (IL:* IL:|;;| "put the KEY at the head of the QUEUE")
        (PUSH KEY (CASH-FILE-QUEUE CASH-FILE))        VALUE))(DEFUN DEL-FROM-CACHE
 (KEY CASH-FILE)   (IL:* IL:|;;| "delete it from the queue")
   (SETF (CASH-FILE-QUEUE CASH-FILE)         (DELETE KEY (CASH-FILE-QUEUE CASH-FILE)                :TEST                'EQUAL :COUNT 1))   (IL:* IL:|;;| "delete it from the cache")
   (REMHASH KEY (CASH-FILE-CACHE CASH-FILE)))(IL:PUTPROPS IL:CASH-FILE
 IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE                                                                 (DEFPACKAGE "CASH-FILE"                                                                        (:USE "LISP" "XCL"))))(IL:PUTPROPS IL:CASH-FILE
 IL:FILETYPE
 :XCL-COMPILE-FILE)(IL:PUTPROPS IL:CASH-FILE IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))(IL:DECLARE\: IL:DONTCOPY  (IL:FILEMAP (NIL)))IL:STOP

library/CHARCODETABLES

@@ -0,0 +1 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Feb-93 19:47:50" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>CHARCODETABLES.;5|
 11685        changes to%:  (FNS SHOWCSETLIST)      previous date%: "25-Aug-92 16:59:31" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>CHARCODETABLES.;4|)(* ; "Copyright (c) 1985, 1986, 1990, 1992, 1993 by Venue & Xerox Corporation.  All rights reserved.")(PRETTYCOMPRINT CHARCODETABLESCOMS)(RPAQQ CHARCODETABLESCOMS
 (                               (* ;; "User-level entries:")
                               (FNS SHOWCOMMONCSETS SHOWCSET SHOWCSETLIST SHOWCSETRANGE)                                                              (* ;; "Main printing functions:")
                               (FNS CENTERPRINT CODETABLE)))(* ;; "User-level entries:")
(DEFINEQ(SHOWCOMMONCSETS
  [LAMBDA (FONT)
                                         (* ; "Edited 25-Aug-92 16:55 by jds")
    (* ;; "Create character-code charts for all the common character sets in existence, namely 0, 41-50, and 356-361 (all octal, of course!) This explicitly excludes the Japanese and Chinese character ranges, which mostly don't exist.")
    (SHOWCSETRANGE
 0 0 FONT)    (SHOWCSETLIST
 (CHARCODE (0,41 0,42 0,44 0,45 0,46 0,47 0,50))           FONT)    (SHOWCSETRANGE
 238 241 FONT)    (PRINTOUT T "Done." T])(SHOWCSET
  [LAMBDA (FONT)
                                         (* ; "Edited 25-Aug-92 16:55 by jds")
    (* ;; "Create character-code charts for ALL the character sets in existence, as of Xerox Character Code Standard XC1-2-2-0")
    (SHOWCSETRANGE
 0 0 FONT)    (SHOWCSETLIST
 (CHARCODE (0,41 0,42 0,43 0,44 0,45 0,46 0,47 0,50))           FONT)    (SHOWCSETRANGE
 48 115 FONT)    (SHOWCSETLIST
 (CHARCODE 0,164 0,165 0,166 0,167 0,170 0,171 0,172))    (SHOWCSETRANGE
 161 212 FONT)    (SHOWCSETLIST
 (CHARCODE 0,340 0,341 0,342 0,343 0,356 0,357 0,360 0,361 0,365 0,375 0,376))    (PRINTOUT T "Done." T])(SHOWCSETLIST
  [LAMBDA (CSETS FONT)
                                   (* ; "Edited  4-Feb-93 19:35 by jds")
    (* ;; "Produce character-code charts for the character sets in the list CSETS.  The charts appear two-up, landscape.")
    (PROG (IPSTREAM (COUNT
 0)                 (XOFFSET 0)                 HALFPAGE)          [for
 CHARSET in
 CSETS do
                                               (* ;; "Print each code chart")
                                              [COND                                                 ((NOT IPSTREAM)                                 (* ;; "W're sure to need an open file.  Open one, if there isn't one already.  Doing it here assures that we'll never create an empty one at the end.")
                                                  [SETQ IPSTREAM (OPENIMAGESTREAM '{LPT} NIL                                                                        '(LANDSCAPE T]                                                  (SETQ HALFPAGE (FIXR (FTIMES 5.5 72                                                                              (DSPSCALE NIL IPSTREAM]                                              (RESETLST                                                  (RESETSAVE (RADIX 8)))                                                              (* ; 
                                                           "Everything's in octal on these charts.")
                                              (PRINTOUT T "Listing Character set " CHARSET "." T)                                              (CODETABLE
 IPSTREAM                                                     [OR FONT '(CLASSIC 12 (MEDIUM REGULAR REGULAR]                                                     CHARSET XOFFSET)                                                              (* ; "Produce the code table.")
                                              (DSPFONT '(CLASSIC 12 (MEDIUM REGULAR REGULAR))                                                     IPSTREAM) (* ;;; "Move to the other half of the page, or to the next page, depending.")
                                              (COND                                                 ((ZEROP XOFFSET)                                                             (* ; 
                                "This is the first one on the page.  Move over for the next chart.")
                                                  (SETQ XOFFSET HALFPAGE))                                                 (T          (* ; 
                      "That was the second chart on this page.  Go to a new page for the next one.")
                                                    (SETQ XOFFSET 0)                                                    (COND                                                       ((IGEQ (SETQ COUNT (ADD1 COUNT))                                                              5)                                                             (* ; 
                    "But every 5 pages, start a new file, to prevent overflow on the print server.")
                                                        (CLOSEF IPSTREAM)                                                        (SETQ IPSTREAM NIL)                                                        (SETQ COUNT 0))                                                       (T (DSPNEWPAGE IPSTREAM]          (AND IPSTREAM (CLOSEF IPSTREAM])(SHOWCSETRANGE
  [LAMBDA (FirstCSet LastCSet FONT)
                      (* ; "Edited 25-Aug-92 16:55 by jds")
    (* ;; "Produce character-code charts for a given range of character sets, from FirstCSet to LastCSet.  They appear two-up, landscape.")
    (SHOWCSETLIST
 (for
 CHARSET from
 FirstCSet to
 LastCSet collect
 CHARSET)           FONT]))(* ;; "Main printing functions:")
(DEFINEQ(CENTERPRINT
  [LAMBDA (TEXT FONT X Y STREAM)
                         (* ; "Edited 25-Aug-92 16:56 by jds")
(* ;;; "Print TEXT onto STREAM in FONT, centered horizontally at X, with its baseline at Y")
    (LET* [(WIDTH (STRINGWIDTH TEXT FONT))           (XLOC (DIFFERENCE X (FTIMES WIDTH 0.5]          (MOVETO (FIXR XLOC)                 Y STREAM)          (DSPFONT FONT STREAM)          (PRIN1 TEXT STREAM])(CODETABLE
  [LAMBDA (STREAM FONT CHARSET XOFFSET)
                  (* ; "Edited 25-Aug-92 16:57 by jds")
    (* ;; "Generates a font table for character set CHARSET of font FONT.  The table is printed on image stream STREAM, at horizontal offset XOFFSET.  The characters are printed using PRIN1.")
    (LET* ((TitleFont (FONTCREATE 'MODERN 10 'BOLD NIL STREAM))           (NUMBERFONT (FONTCREATE 'MODERN 8 'BOLD NIL STREAM))           (SCALE (DSPSCALE NIL STREAM))           (InchesToPrinterUnits (FTIMES 72.0 SCALE))           (DDev (IMAGESTREAMTYPE STREAM))           (CHARSETNAME (OCTALSTRING CHARSET))           TITLE)          (SETQ FONT (FONTCREATE FONT NIL NIL NIL STREAM))   (* ; 
                               "Get the interpress version of the FONT we're making the table for.")
(* ;;; "Print the title over the table, showing font name, size, etc.")
          (DSPFONT TitleFont STREAM)          (SETQ TITLE (CONCAT (FONTPROP FONT 'FAMILY)                             " "                             (FONTPROP FONT 'SIZE)                             " "                             (FONTPROP FONT 'WEIGHT)                             "-"                             (FONTPROP FONT 'SLOPE)                             "   Character Set " CHARSETNAME))          (CENTERPRINT
 TITLE TitleFont (PLUS XOFFSET (TIMES 2.75 InchesToPrinterUnits))                 (FTIMES 7.5 InchesToPrinterUnits)                 STREAM)(* ;;; "Print out the lines for the table, and the character-code guide numbers along the top and left edge.")
          (DSPFONT NUMBERFONT STREAM)          [for
 X from
 (IPLUS XOFFSET InchesToPrinterUnits)             by
 (FIXR (FTIMES SCALE 18)) as
 I from
 0 to
 16             bind
 (Y0 _ (FIXR (FTIMES SCALE 72)))                   (YSPAN _ (FIXR (FTIMES SCALE 24 16)))             do
 (* ;;; "Draw thr vertical lines between the boxes in the code chart.")
                   (DRAWLINE X Y0 X (IPLUS Y0 YSPAN)                          35                          'PAINT STREAM)                   (COND                      ((ILEQ I 15)                       (* ;; "And if it's not the rightmost line, print a number across the top as well, for the high-order 4 bits of the character code.")
                       (CENTERPRINT
 (OCTALSTRING (ITIMES I 16))                              NUMBERFONT                              (IPLUS X (FIXR (FTIMES SCALE 9)))                              (IPLUS Y0 YSPAN 35)                              STREAM]          [for
 Y from
 (FIXR (FTIMES SCALE 72)) by
 (FIXR (FTIMES SCALE 24)) as
 I             from
 0 to
 16 bind
 [X0 _ (IPLUS XOFFSET (FIXR (FTIMES SCALE 72]                                        (XSPAN _ (FIXR (FTIMES SCALE 18 16)))             do
 (* ;;; "Now print the horizontal lines between boxes in the code chart.")
                   (DRAWLINE X0 Y (IPLUS X0 XSPAN)                          Y 35 'PAINT STREAM)                   (COND                      ((ILEQ I 15)                           (* ; 
"And if it isn't the bottommost line, print the low-order 4 bits of character code along the left.")
                       (CENTERPRINT
 (OCTALSTRING (IDIFFERENCE 15 I))                              NUMBERFONT                              (IPLUS X0 (FIXR (FTIMES SCALE -9)))                              (IPLUS Y (FIXR (FTIMES 6 SCALE)))                              STREAM](* ;;; "Now go really print the characters in the table.")
          (DSPFONT FONT STREAM)          (for
 YPosition from
 [FIXR (FTIMES SCALE (IPLUS 72 6 (ITIMES 15 24]             by
 (FIXR (FTIMES SCALE -24)) as
 LOWBITS from
 0 to
 15 bind
                                                                                         CharacterCode             do
 (* ;;; "Run down each column -- i.e., varying the low bits fastest -- printing the characters.")
                   [for
 XPosition from
 (IPLUS XOFFSET (FIXR (FTIMES SCALE 75)))                      by
 (FIXR (FTIMES 18 SCALE)) as
 HIBITS from
 0 to
 15                      do
 (SETQ CharacterCode (IPLUS (LLSH CHARSET 8)                                                        (LLSH HIBITS 4)                                                        LOWBITS))                            (MOVETO XPosition YPosition STREAM)                            (COND                               ((IEQP (LOGAND CharacterCode 255)                                      255)                   (* ; 
                                                        "Can't print the charset-change character!")
                                )                               ((NEQ CharacterCode (CHARCODE FF))                                (COND                                   ((EQ DDev 'DISPLAY)                                    (BLTCHAR CharacterCode STREAM))                                   (T (\OUTCHAR STREAM CharacterCode]                   (printout T "."))          (printout T " done." T]))(PUTPROPS CHARCODETABLES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990 1992 1993))(DECLARE%: DONTCOPY  (FILEMAP (NIL (842 5920 (SHOWCOMMONCSETS 852 . 1403) (SHOWCSET 1405 . 2058) (SHOWCSETLIST 2060 . 5536) (SHOWCSETRANGE 5538 . 5918)) (5963 11571 (CENTERPRINT 5973 . 6404) (CODETABLE 6406 . 11569)))))STOP