Skip to content

Commit cb46b0b

Browse files
masintermasinter
committed
initial checkin for library
1 parent d6580ff commit cb46b0b

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

113 files changed

+45947
-0
lines changed

‎library/BIGBITMAPS

Lines changed: 1645 additions & 0 deletions
Large diffs are not rendered by default.

‎library/BINARYFILES

Lines changed: 1 addition & 0 deletions
Large diffs are not rendered by default.

‎library/BROWSER

Lines changed: 491 additions & 0 deletions
Large diffs are not rendered by default.

‎library/CASH-FILE

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
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

‎library/CHARDEVICE

Lines changed: 1 addition & 0 deletions
Large diffs are not rendered by default.

‎library/CHAT

Lines changed: 1 addition & 0 deletions
Large diffs are not rendered by default.

0 commit comments

Comments
 (0)