Compare commits
15 Commits
medley-210
...
test
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
8ec1ca966d | ||
|
|
c55239f744 | ||
|
|
d6f7ad7de9 | ||
|
|
0236971881 | ||
|
|
d04f734295 | ||
|
|
27a52b6ce0 | ||
|
|
0e2e16f183 | ||
|
|
b760d005fb | ||
|
|
95c9496780 | ||
|
|
4bb4457d55 | ||
|
|
2615140ede | ||
|
|
77d772ae45 | ||
|
|
995c321f59 | ||
|
|
9d4a8796dd | ||
|
|
185ee4db70 |
4
.gitignore
vendored
4
.gitignore
vendored
@@ -11,6 +11,10 @@ loadups/full.sysout
|
||||
loadups/*.dribble
|
||||
loadups/whereis.hash
|
||||
|
||||
# manual cross-reference files
|
||||
|
||||
*.IMPTR
|
||||
|
||||
#compiled code -- leave in for now
|
||||
|
||||
# *.lcom
|
||||
|
||||
19
greetfiles/NOGREET
Normal file
19
greetfiles/NOGREET
Normal file
@@ -0,0 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "10-Sep-2021 21:25:42" {DSK}<home>larry>medley>greetfiles>NOGREET.;1 537 )
|
||||
|
||||
|
||||
(PRETTYCOMPRINT NOGREETCOMS)
|
||||
|
||||
(RPAQQ NOGREETCOMS [(P (COND ((STKPOS 'GREET)
|
||||
(SETQ USERGREETFILES NIL)
|
||||
(CLOSEF? (INPUT))
|
||||
(RETFROM 'GREET])
|
||||
|
||||
[COND
|
||||
((STKPOS 'GREET)
|
||||
(SETQ USERGREETFILES NIL)
|
||||
(CLOSEF? (INPUT))
|
||||
(RETFROM 'GREET]
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
133
internal/library/MAKE-PS
Normal file
133
internal/library/MAKE-PS
Normal file
@@ -0,0 +1,133 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 1-Sep-2021 21:13:57" {DSK}<home>larry>medley>internal>library>MAKE-PS.;6 5503
|
||||
|
||||
changes to%: (VARS MAKE-PSCOMS)
|
||||
(FNS MAKE-PS-INIT)
|
||||
|
||||
previous date%: "31-Aug-2021 22:30:13" {DSK}<home>larry>medley>internal>library>MAKE-PS.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MAKE-PSCOMS)
|
||||
|
||||
(RPAQQ MAKE-PSCOMS
|
||||
[(FNS MAKE-PS MAKE-PS-INIT BADFILE)
|
||||
|
||||
(* ;; " Load known used image object types")
|
||||
|
||||
(FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH)
|
||||
(ADVISE TEDIT.PROMPTPRINT)
|
||||
(INITVARS (BADFILESFILE)
|
||||
(BADFS)
|
||||
(BADFILES))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-PS-INIT])
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-PS
|
||||
[LAMBDA (TFILE PREFIX DEST REDOFLG TOPDIRLEN) (* ; "Edited 21-Aug-2021 20:56 by larry")
|
||||
(DECLARE (SPECVARS TFILE))
|
||||
(COND
|
||||
((DIRECTORYNAMEP TFILE)
|
||||
(SETQ TFILE (DIRECTORYNAME TFILE))
|
||||
[OR TOPDIRLEN (SETQ TOPDIRLEN (IPLUS 1 (CL:LENGTH (MKSTRING (FILENAMEFIELD TFILE 'DIRECTORY]
|
||||
[OR DEST (PROGN (ShellCommand (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
|
||||
"/tmp/psfiles"))
|
||||
(SETQ DEST (MEDLEYDIR "tmp/psfiles"]
|
||||
|
||||
(* ;; "first deal with files in this directory")
|
||||
|
||||
(for X in (IF (EQ REDOFLG 'REV)
|
||||
THEN (REVERSE (DIRECTORY (CONCAT TFILE "*.TED*;")))
|
||||
ELSE (DIRECTORY (CONCAT TFILE "*.TED*;")))
|
||||
when (NOT (MEMB X BADFILES)) do (MAKE-PS X PREFIX DEST REDOFLG TOPDIRLEN))
|
||||
|
||||
(* ;; " then deal with subdirs ")
|
||||
|
||||
(for X in (IF (EQ REDOFLG 'REV)
|
||||
THEN (REVERSE (DIRECTORY (CONCAT TFILE "*")))
|
||||
ELSE (DIRECTORY (CONCAT TFILE "*")))
|
||||
when [for SKIP in '(">." ">internal>test" ">dinfo>")
|
||||
always (NOT (STRPOS SKIP (L-CASE X] when (DIRECTORYNAMEP X)
|
||||
do (MAKE-PS X PREFIX DEST REDOFLG TOPDIRLEN)))
|
||||
[(SETQ TFILE (INFILEP TFILE))
|
||||
(PROG ((PSFILE (PACKFILENAME.STRING 'EXTENSION (if (EQ REDOFLG 'IP)
|
||||
then 'IP
|
||||
else "PS")
|
||||
'NAME
|
||||
(CONCAT (OR PREFIX "")
|
||||
(if PREFIX
|
||||
then "-"
|
||||
else "")
|
||||
[PACK (SUBST '- '> (UNPACK (SUBSTRING (FILENAMEFIELD
|
||||
TFILE
|
||||
'DIRECTORY)
|
||||
(IPLUS 1 TOPDIRLEN)
|
||||
-1]
|
||||
"-"
|
||||
(FILENAMEFIELD TFILE 'NAME))
|
||||
'DIRECTORY DEST))
|
||||
(TEXTSTREAM))
|
||||
(if (MEMB TFILE BADFILES)
|
||||
then (RETURN))
|
||||
(if (AND (NOT REDOFLG)
|
||||
(INFILEP PSFILE))
|
||||
then (* ; " do nothing")
|
||||
(PRINTOUT T PSFILE " already there" T)
|
||||
elseif (EQ REDOFLG 'TEST)
|
||||
then (PRINTOUT T "TESTING " TFILE)
|
||||
(CLOSEF (OPENTEXTSTREAM TFILE))
|
||||
else (PRINTOUT T "Converting " TFILE "...")
|
||||
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
|
||||
PSFILE T NIL NIL NIL (if (EQ REDOFLG 'IP)
|
||||
then 'INTERPRESS
|
||||
else 'POSTSCRIPT))
|
||||
(printout T " DONE" T)
|
||||
(CLOSEF? TEXTSTREAM]
|
||||
(T (PRINTOUT T "no such file " T])
|
||||
|
||||
(MAKE-PS-INIT
|
||||
[LAMBDA NIL (* ; "Edited 1-Sep-2021 16:27 by larry")
|
||||
(* ; " initialize")
|
||||
(SETQ BADFILESFILE (MEDLEYDIR "tmp" "badfiles.txt" T))
|
||||
(SETQ BADFS (OPENSTREAM BADFILESFILE 'APPEND))
|
||||
(POSTSCRIPT.INIT)
|
||||
(SETQ BADFILES (SUBSET (READFILE BADFILESFILE)
|
||||
(FUNCTION INFILEP])
|
||||
|
||||
(BADFILE
|
||||
[LAMBDA (X) (* ; "Edited 16-Aug-2021 13:14 by larry")
|
||||
([LAMBDA ($$1)
|
||||
(COND
|
||||
((FMEMB $$1 BADFILES)
|
||||
BADFILES)
|
||||
(T (NCONC1 BADFILES $$1]
|
||||
(OR X TFILE))
|
||||
(PRINT (OR X TFILE)
|
||||
BADFS)
|
||||
(FLUSHOUTPUT BADFS)
|
||||
(CLOSEF? TEXTSTREAM)
|
||||
(RETFROM 'MAKE-PS NIL])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; " Load known used image object types")
|
||||
|
||||
|
||||
(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH)
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T]
|
||||
|
||||
(READVISE TEDIT.PROMPTPRINT)
|
||||
|
||||
(RPAQ? BADFILESFILE )
|
||||
|
||||
(RPAQ? BADFS )
|
||||
|
||||
(RPAQ? BADFILES )
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(MAKE-PS-INIT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (786 5110 (MAKE-PS 796 . 4293) (MAKE-PS-INIT 4295 . 4731) (BADFILE 4733 . 5108)))))
|
||||
STOP
|
||||
BIN
internal/library/MAKE-PS.LCOM
Normal file
BIN
internal/library/MAKE-PS.LCOM
Normal file
Binary file not shown.
@@ -1,9 +1,9 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 6-Aug-2021 07:35:16" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;2 1183
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "30-Aug-2021 16:04:42" {DSK}<home>larry>medley>library>SYSEDIT.;3 1146
|
||||
|
||||
changes to%: (VARS SYSEDITCOMS)
|
||||
|
||||
previous date%: " 6-May-2021 16:22:01" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;1)
|
||||
previous date%: " 6-Aug-2021 07:35:16" {DSK}<home>larry>medley>library>SYSEDIT.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -14,19 +14,17 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ SYSEDITCOMS
|
||||
[(VARS (CLISPIFYPRETTYFLG)
|
||||
(MSRECORDTRANFLG T)
|
||||
(RECOMPILEDEFAULT 'CHANGES)
|
||||
(CLEANUPOPTIONS '(RC F))
|
||||
(GLOBALVARFLG T)
|
||||
(CLISPIFTRANFLG T)
|
||||
(CROSSCOMPILING 'ASK))
|
||||
(CROSSCOMPILING 'ASK)
|
||||
(DFNFLG 'PROP))
|
||||
(P (RESETVARS ((CROSSCOMPILING T))
|
||||
(LOAD? 'EXPORTS.ALL])
|
||||
|
||||
(RPAQQ CLISPIFYPRETTYFLG NIL)
|
||||
|
||||
(RPAQQ MSRECORDTRANFLG T)
|
||||
|
||||
(RPAQQ RECOMPILEDEFAULT CHANGES)
|
||||
|
||||
(RPAQQ CLEANUPOPTIONS (RC F))
|
||||
@@ -37,6 +35,8 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ CROSSCOMPILING ASK)
|
||||
|
||||
(RPAQQ DFNFLG PROP)
|
||||
|
||||
(RESETVARS ((CROSSCOMPILING T))
|
||||
(LOAD? 'EXPORTS.ALL))
|
||||
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
|
||||
|
||||
@@ -1,20 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 6-Aug-2021 07:36:12" ("compiled on " {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;2)
|
||||
" 6-Aug-2021 07:14:33" bcompl'd in "FULL 5-Aug-2021 ..." dated " 5-Aug-2021 22:24:43")
|
||||
(FILECREATED " 6-Aug-2021 07:35:16" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;2 1183 changes to%:
|
||||
(VARS SYSEDITCOMS) previous date%: " 6-May-2021 16:22:01"
|
||||
{DSK}<home>larry>ilisp>medley>library>SYSEDIT.;1)
|
||||
(PRETTYCOMPRINT SYSEDITCOMS)
|
||||
(RPAQQ SYSEDITCOMS ((VARS (CLISPIFYPRETTYFLG) (MSRECORDTRANFLG T) (RECOMPILEDEFAULT (QUOTE CHANGES)) (
|
||||
CLEANUPOPTIONS (QUOTE (RC F))) (GLOBALVARFLG T) (CLISPIFTRANFLG T) (CROSSCOMPILING (QUOTE ASK))) (P (
|
||||
RESETVARS ((CROSSCOMPILING T)) (LOAD? (QUOTE EXPORTS.ALL))))))
|
||||
(RPAQQ CLISPIFYPRETTYFLG NIL)
|
||||
(RPAQQ MSRECORDTRANFLG T)
|
||||
(RPAQQ RECOMPILEDEFAULT CHANGES)
|
||||
(RPAQQ CLEANUPOPTIONS (RC F))
|
||||
(RPAQQ GLOBALVARFLG T)
|
||||
(RPAQQ CLISPIFTRANFLG T)
|
||||
(RPAQQ CROSSCOMPILING ASK)
|
||||
(RESETVARS ((CROSSCOMPILING T)) (LOAD? (QUOTE EXPORTS.ALL)))
|
||||
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
|
||||
NIL
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,446 +0,0 @@
|
||||
(FILECREATED "15-Aug-85 19:44:58" {ERIS}<LISPCORE>LIBRARY>DICOLOR.;2 15766
|
||||
|
||||
changes to: (VARS DICOLORCOMS)
|
||||
|
||||
previous date: " 9-Aug-85 05:58:26" {ERIS}<LISPCORE>LIBRARY>DICOLOR.;1)
|
||||
|
||||
|
||||
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT DICOLORCOMS)
|
||||
|
||||
(RPAQQ DICOLORCOMS ((FNS CNSMENUINIT CNSTOCSL CNSTORGB CSLTOCNS DICOLOR.FROM.USER GETCNS HLSTOCSL
|
||||
CSLTOHLS RGBTOCNS)
|
||||
(VARS DICOLOR.hueMapping DICOLOR.lightnessMapping DICOLOR.saturationMapping
|
||||
NEWCOLORITEM)
|
||||
(INITVARS (COLORNAMEMENU))
|
||||
(FNS DICOLOR.hueN DICOLOR.hueNvalue DICOLOR.hueNname DICOLOR.lightnessN
|
||||
DICOLOR.lightnessNvalue DICOLOR.lightnessNname DICOLOR.saturationN
|
||||
DICOLOR.saturationNvalue DICOLOR.saturationNname)
|
||||
(DECLARE: DONTCOPY (*)
|
||||
(RECORDS hueRecord lightnessRecord saturationRecord)
|
||||
(CONSTANTS * DICOLOR.hueConstants)
|
||||
(CONSTANTS * DICOLOR.saturationConstants)
|
||||
(CONSTANTS * DICOLOR.lightnessConstants))))
|
||||
(DEFINEQ
|
||||
|
||||
(CNSMENUINIT
|
||||
[LAMBDA NIL (* gbn " 9-Aug-85 03:11")
|
||||
[SETQ CNSHUEMENU (create MENU
|
||||
ITEMS _(for I in DICOLOR.hueMapping collect (CAR I]
|
||||
[SETQ CNSSATURATIONMENU (create MENU
|
||||
ITEMS _(for I in DICOLOR.saturationMapping collect (CAR I]
|
||||
(SETQ CNSLIGHTNESSMENU (create MENU
|
||||
ITEMS _(for I in DICOLOR.lightnessMapping collect (CAR I])
|
||||
|
||||
(CNSTOCSL
|
||||
[LAMBDA (hue saturation lightness) (* hdj "12-Apr-85 19:01")
|
||||
(PROG ((hueAtom (MKATOM hue))
|
||||
(saturationAtom (MKATOM saturation))
|
||||
(lightnessAtom (MKATOM lightness))
|
||||
c s l)
|
||||
(if [NOT (SETQ c (fetch (hueRecord ordering) of (ASSOC hueAtom DICOLOR.hueMapping]
|
||||
then (SETQ c DICOLOR.achromatic))
|
||||
(if (EQ c DICOLOR.achromatic)
|
||||
then (SETQ s DICOLOR.noSaturation)
|
||||
else (if [NOT (SETQ s (fetch (saturationRecord ordering) of (ASSOC saturationAtom
|
||||
DICOLOR.saturationMapping]
|
||||
then (SETQ s DICOLOR.vivid)))
|
||||
(SELECTQ hueAtom
|
||||
(Black (SETQ l DICOLOR.black))
|
||||
(White (SETQ l DICOLOR.white))
|
||||
(if [NOT (SETQ l (fetch (lightnessRecord ordering) of (ASSOC lightnessAtom
|
||||
DICOLOR.lightnessMapping]
|
||||
then (SETQ l DICOLOR.medium)))
|
||||
(RETURN (LIST c s l])
|
||||
|
||||
(CNSTORGB
|
||||
[LAMBDA (saturation lightness hue) (* hdj "15-Jul-85 12:33")
|
||||
(LET ((CSL (CNSTOCSL hue saturation lightness)))
|
||||
(HLSTORGB (APPLY (FUNCTION CSLTOHLS)
|
||||
CSL])
|
||||
|
||||
(CSLTOCNS
|
||||
[LAMBDA (c s l) (* hdj "15-Jul-85 12:37")
|
||||
(PROG (hue saturation lightness)
|
||||
[if (EQ c DICOLOR.achromatic)
|
||||
then (SETQ saturation "")
|
||||
[SELECTC l
|
||||
(DICOLOR.black (SETQ hue "Black")
|
||||
(SETQ lightness ""))
|
||||
(DICOLOR.white (SETQ hue "White")
|
||||
(SETQ lightness ""))
|
||||
(PROGN (SETQ hue "Gray")
|
||||
(SETQ lightness (MKSTRING (fetch (lightnessRecord name)
|
||||
of (DICOLOR.lightnessN l]
|
||||
else (SETQ hue (fetch (hueRecord name) of (DICOLOR.hueN c)))
|
||||
(SETQ saturation (fetch (saturationRecord name) of (DICOLOR.saturationN s)))
|
||||
(SETQ lightness (fetch (lightnessRecord name) of (DICOLOR.lightnessN l]
|
||||
(RETURN (LIST saturation lightness hue])
|
||||
|
||||
(DICOLOR.FROM.USER
|
||||
[LAMBDA (NAMES?) (* gbn " 9-Aug-85 04:51")
|
||||
|
||||
(* * returns an RGB triple. If NAMES? prompts the user first with the global color name menu.
|
||||
She can then choose NEWCOLOR which can be specified as RGB or CNS)
|
||||
|
||||
|
||||
(PROG (NAME RGB)
|
||||
(if NAMES?
|
||||
then (* first try to get a color name)
|
||||
[SETQ NAME (MENU (OR COLORNAMEMENU (SETQ COLORNAMEMENU
|
||||
(CREATE MENU
|
||||
ITEMS _(CONS NEWCOLORITEM
|
||||
(FOR ENTRY IN COLORNAMES
|
||||
COLLECT (CAR ENTRY]
|
||||
(if (NOT NAME)
|
||||
then (* the user clicked outside the menu)
|
||||
(RETURN))
|
||||
[SETQ RGB (SELECTQ NAME
|
||||
(RGB (READCOLOR1 "specify new color"))
|
||||
(CNS (APPLY (FUNCTION CNSTORGB)
|
||||
(GETCNS)))
|
||||
(RETURN (CDR (ASSOC NAME COLORNAMES]
|
||||
(if (NOT (SETQ NAME (TTYIN "New color name? ")))
|
||||
then (* user must have decided that she didn't want to keep
|
||||
(name) the color)
|
||||
(RETURN))
|
||||
(push COLORNAMES (CONS (CAR NAME)
|
||||
RGB))
|
||||
(SETQ COLORNAMEMENU NIL) (* invalidate the menu)
|
||||
(RETURN RGB])
|
||||
|
||||
(GETCNS
|
||||
[LAMBDA NIL (* gbn " 9-Aug-85 03:13")
|
||||
(LIST (MENU CNSLIGHTNESSMENU)
|
||||
(MENU CNSSATURATIONMENU)
|
||||
(MENU CNSHUEMENU])
|
||||
|
||||
(HLSTOCSL
|
||||
[LAMBDA (hue lightness saturation) (* hdj "15-Jul-85 12:14")
|
||||
(LET ((ISLHue (FQUOTIENT (MOD (PLUS hue 240)
|
||||
360)
|
||||
360)))
|
||||
(PROG (c s l)
|
||||
(for old s from DICOLOR.noSaturation to DICOLOR.vivid
|
||||
do (if (EQ s DICOLOR.vivid)
|
||||
then (RETURN))
|
||||
(if (LEQ saturation (PLUS (DICOLOR.saturationNvalue s)
|
||||
(QUOTIENT (DIFFERENCE (DICOLOR.saturationNvalue
|
||||
(ADD1 s))
|
||||
(DICOLOR.saturationNvalue s))
|
||||
2)))
|
||||
then (RETURN)))
|
||||
[if (EQ s DICOLOR.noSaturation)
|
||||
then (SETQ c DICOLOR.achromatic)
|
||||
(for old l from DICOLOR.black to DICOLOR.white
|
||||
do (if (EQ l DICOLOR.white)
|
||||
then (RETURN))
|
||||
(if (LEQ lightness (PLUS (DICOLOR.lightnessNvalue l)
|
||||
(QUOTIENT (DIFFERENCE (DICOLOR.lightnessNvalue
|
||||
(ADD1 l))
|
||||
(DICOLOR.lightnessNvalue
|
||||
l))
|
||||
2)))
|
||||
then (RETURN)))
|
||||
else (for old c from DICOLOR.red to DICOLOR.purplishRed
|
||||
do (* (HELP c))
|
||||
(if (EQ c DICOLOR.purplishRed)
|
||||
then (if (GREATERP ISLHue (PLUS (DICOLOR.hueNvalue c)
|
||||
(QUOTIENT (DIFFERENCE 1 (
|
||||
DICOLOR.hueNvalue
|
||||
c))
|
||||
2)))
|
||||
then (SETQ c DICOLOR.red))
|
||||
(RETURN))
|
||||
(if (LEQ ISLHue (PLUS (DICOLOR.hueNvalue c)
|
||||
(QUOTIENT (DIFFERENCE (DICOLOR.hueNvalue
|
||||
(ADD1 c))
|
||||
(DICOLOR.hueNvalue c))
|
||||
2)))
|
||||
then (RETURN)))
|
||||
(for old l from DICOLOR.veryDark to DICOLOR.veryLight
|
||||
do (if (EQ l DICOLOR.veryLight)
|
||||
then (RETURN))
|
||||
(if (LEQ lightness (PLUS (DICOLOR.lightnessNvalue l)
|
||||
(QUOTIENT (DIFFERENCE (DICOLOR.lightnessNvalue
|
||||
(ADD1 l))
|
||||
(DICOLOR.lightnessNvalue
|
||||
l))
|
||||
2)))
|
||||
then (RETURN]
|
||||
(RETURN (LIST c s l])
|
||||
|
||||
(CSLTOHLS
|
||||
[LAMBDA (c s l) (* hdj "15-Jul-85 12:23")
|
||||
(PROG (hue saturation lightness)
|
||||
(if (EQ c DICOLOR.achromatic)
|
||||
then (SETQ hue 0.0)
|
||||
(SETQ saturation 0.0)
|
||||
(SETQ lightness (DICOLOR.lightnessNvalue l))
|
||||
else (SETQ hue (DICOLOR.hueNvalue c))
|
||||
(SETQ saturation (DICOLOR.saturationNvalue s))
|
||||
(SETQ lightness (DICOLOR.lightnessNvalue l)))
|
||||
(RETURN (LIST (MOD (FPLUS 120 (FTIMES hue 360))
|
||||
360)
|
||||
lightness saturation])
|
||||
|
||||
(RGBTOCNS
|
||||
[LAMBDA (Red Green Blue) (* hdj "15-Jul-85 12:36")
|
||||
(APPLY (FUNCTION CSLTOCNS)
|
||||
(APPLY (FUNCTION HLSTOCSL)
|
||||
(RGBTOHLS Red Green Blue])
|
||||
)
|
||||
|
||||
(RPAQQ DICOLOR.hueMapping ((Achromatic 0.0 -1)
|
||||
(Red 0.0 0)
|
||||
(OrangishRed .01 1)
|
||||
(RedOrange .02 2)
|
||||
(ReddishOrange .03 3)
|
||||
(Orange .04 4)
|
||||
(YellowishOrange .07 5)
|
||||
(OrangeYellow .1 6)
|
||||
(OrangishYellow .13 7)
|
||||
(Yellow .1673 8)
|
||||
(GreenishYellow .2073 9)
|
||||
(YellowGreen .2473 10)
|
||||
(YellowishGreen .2873 11)
|
||||
(Green .3333 12)
|
||||
(BluishGreen .4133 13)
|
||||
(GreenBlue .4933 14)
|
||||
(GreenishBlue .5733 15)
|
||||
(Blue .6666 16)
|
||||
(PurplishBlue .6816 17)
|
||||
(BluePurple .6966 18)
|
||||
(BluishPurple .7116 19)
|
||||
(Purple .73 20)
|
||||
(ReddishPurple .8 21)
|
||||
(PurpleRed .87 22)
|
||||
(PurplishRed .94 23)
|
||||
(BrownishRed .01 24)
|
||||
(RedBrown .02 25)
|
||||
(ReddishBrown .03 26)
|
||||
(Brown .04 27)
|
||||
(YellowishBrown .07 28)
|
||||
(BrownYellow .1 29)
|
||||
(BrownishYellow .13 30)))
|
||||
|
||||
(RPAQQ DICOLOR.lightnessMapping ((Black 0.0 0)
|
||||
(VeryDark .1666 1)
|
||||
(Dark .3333 2)
|
||||
(Medium .5 3)
|
||||
(Light .6666 4)
|
||||
(VeryLight .8333 5)
|
||||
(White 1.0 6)))
|
||||
|
||||
(RPAQQ DICOLOR.saturationMapping ((NoSaturation 0.0 0)
|
||||
(Grayish .25 1)
|
||||
(Moderate .5 2)
|
||||
(Strong .75 3)
|
||||
(Vivid 1.0 4)))
|
||||
|
||||
(RPAQQ NEWCOLORITEM (New% Color (QUOTE CNS)
|
||||
"Allows specification of a new color"
|
||||
(SUBITEMS (RGB (QUOTE RGB)
|
||||
"Specify a new color using Red, Green, Blue sliders")
|
||||
(CNS (QUOTE CNS)
|
||||
"Specify a new color using English"))))
|
||||
|
||||
(RPAQ? COLORNAMEMENU )
|
||||
(DEFINEQ
|
||||
|
||||
(DICOLOR.hueN
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 13:38")
|
||||
(DECLARE (GLOBALVARS DICOLOR.hueMapping))
|
||||
(for ELT in DICOLOR.hueMapping suchthat (EQ (fetch (hueRecord ordering) of ELT)
|
||||
N])
|
||||
|
||||
(DICOLOR.hueNvalue
|
||||
[LAMBDA (N) (* hdj "18-Apr-85 09:58")
|
||||
(fetch (hueRecord value) of (DICOLOR.hueN N])
|
||||
|
||||
(DICOLOR.hueNname
|
||||
[LAMBDA (N) (* hdj "18-Apr-85 10:07")
|
||||
(fetch (hueRecord name) of (DICOLOR.hueN N])
|
||||
|
||||
(DICOLOR.lightnessN
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 13:40")
|
||||
(DECLARE (GLOBALVARS DICOLOR.lightnessMapping))
|
||||
(for ELT in DICOLOR.lightnessMapping suchthat (EQ (fetch (lightnessRecord ordering) of ELT)
|
||||
N])
|
||||
|
||||
(DICOLOR.lightnessNvalue
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 13:36")
|
||||
(fetch (lightnessRecord value) of (DICOLOR.lightnessN N])
|
||||
|
||||
(DICOLOR.lightnessNname
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 14:02")
|
||||
(fetch (lightnessRecord name) of (DICOLOR.lightnessN N])
|
||||
|
||||
(DICOLOR.saturationN
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 13:39")
|
||||
(DECLARE (GLOBALVARS DICOLOR.saturationMapping))
|
||||
(for ELT in DICOLOR.saturationMapping suchthat (EQ (fetch (saturationRecord ordering)
|
||||
of ELT)
|
||||
N])
|
||||
|
||||
(DICOLOR.saturationNvalue
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 13:36")
|
||||
(fetch (saturationRecord value) of (DICOLOR.saturationN N])
|
||||
|
||||
(DICOLOR.saturationNname
|
||||
[LAMBDA (N) (* hdj "17-Apr-85 14:02")
|
||||
(fetch (saturationRecord name) of (DICOLOR.saturationN N])
|
||||
)
|
||||
(DECLARE: DONTCOPY
|
||||
[DECLARE: EVAL@COMPILE
|
||||
|
||||
(RECORD hueRecord (name value ordering))
|
||||
|
||||
(RECORD lightnessRecord (name value ordering))
|
||||
|
||||
(RECORD saturationRecord (name value ordering))
|
||||
]
|
||||
|
||||
|
||||
(RPAQQ DICOLOR.hueConstants (DICOLOR.achromatic DICOLOR.blue DICOLOR.bluePurple DICOLOR.bluishGreen
|
||||
DICOLOR.bluishPurple DICOLOR.brown
|
||||
DICOLOR.brownYellow DICOLOR.brownishRed
|
||||
DICOLOR.brownishYellow DICOLOR.green
|
||||
DICOLOR.greenBlue DICOLOR.greenishBlue
|
||||
DICOLOR.greenishYellow DICOLOR.orange
|
||||
DICOLOR.orangeYellow DICOLOR.orangishRed
|
||||
DICOLOR.orangishYellow DICOLOR.purple
|
||||
DICOLOR.purpleRed DICOLOR.purplishBlue
|
||||
DICOLOR.purplishRed DICOLOR.red DICOLOR.redBrown
|
||||
DICOLOR.redOrange DICOLOR.reddishBrown
|
||||
DICOLOR.reddishOrange DICOLOR.reddishPurple
|
||||
DICOLOR.yellow DICOLOR.yellowGreen
|
||||
DICOLOR.yellowishBrown DICOLOR.yellowishGreen
|
||||
DICOLOR.yellowishOrange))
|
||||
(DECLARE: EVAL@COMPILE
|
||||
|
||||
(RPAQQ DICOLOR.achromatic -1)
|
||||
|
||||
(RPAQQ DICOLOR.blue 16)
|
||||
|
||||
(RPAQQ DICOLOR.bluePurple 18)
|
||||
|
||||
(RPAQQ DICOLOR.bluishGreen 13)
|
||||
|
||||
(RPAQQ DICOLOR.bluishPurple 19)
|
||||
|
||||
(RPAQQ DICOLOR.brown 27)
|
||||
|
||||
(RPAQQ DICOLOR.brownYellow 29)
|
||||
|
||||
(RPAQQ DICOLOR.brownishRed 24)
|
||||
|
||||
(RPAQQ DICOLOR.brownishYellow 30)
|
||||
|
||||
(RPAQQ DICOLOR.green 12)
|
||||
|
||||
(RPAQQ DICOLOR.greenBlue 14)
|
||||
|
||||
(RPAQQ DICOLOR.greenishBlue 15)
|
||||
|
||||
(RPAQQ DICOLOR.greenishYellow 9)
|
||||
|
||||
(RPAQQ DICOLOR.orange 4)
|
||||
|
||||
(RPAQQ DICOLOR.orangeYellow 6)
|
||||
|
||||
(RPAQQ DICOLOR.orangishRed 1)
|
||||
|
||||
(RPAQQ DICOLOR.orangishYellow 7)
|
||||
|
||||
(RPAQQ DICOLOR.purple 20)
|
||||
|
||||
(RPAQQ DICOLOR.purpleRed 22)
|
||||
|
||||
(RPAQQ DICOLOR.purplishBlue 17)
|
||||
|
||||
(RPAQQ DICOLOR.purplishRed 23)
|
||||
|
||||
(RPAQQ DICOLOR.red 0)
|
||||
|
||||
(RPAQQ DICOLOR.redBrown 25)
|
||||
|
||||
(RPAQQ DICOLOR.redOrange 2)
|
||||
|
||||
(RPAQQ DICOLOR.reddishBrown 26)
|
||||
|
||||
(RPAQQ DICOLOR.reddishOrange 3)
|
||||
|
||||
(RPAQQ DICOLOR.reddishPurple 21)
|
||||
|
||||
(RPAQQ DICOLOR.yellow 8)
|
||||
|
||||
(RPAQQ DICOLOR.yellowGreen 10)
|
||||
|
||||
(RPAQQ DICOLOR.yellowishBrown 28)
|
||||
|
||||
(RPAQQ DICOLOR.yellowishGreen 11)
|
||||
|
||||
(RPAQQ DICOLOR.yellowishOrange 5)
|
||||
|
||||
(CONSTANTS DICOLOR.achromatic DICOLOR.blue DICOLOR.bluePurple DICOLOR.bluishGreen
|
||||
DICOLOR.bluishPurple DICOLOR.brown DICOLOR.brownYellow DICOLOR.brownishRed
|
||||
DICOLOR.brownishYellow DICOLOR.green DICOLOR.greenBlue DICOLOR.greenishBlue
|
||||
DICOLOR.greenishYellow DICOLOR.orange DICOLOR.orangeYellow DICOLOR.orangishRed
|
||||
DICOLOR.orangishYellow DICOLOR.purple DICOLOR.purpleRed DICOLOR.purplishBlue
|
||||
DICOLOR.purplishRed DICOLOR.red DICOLOR.redBrown DICOLOR.redOrange DICOLOR.reddishBrown
|
||||
DICOLOR.reddishOrange DICOLOR.reddishPurple DICOLOR.yellow DICOLOR.yellowGreen
|
||||
DICOLOR.yellowishBrown DICOLOR.yellowishGreen DICOLOR.yellowishOrange)
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ DICOLOR.saturationConstants (DICOLOR.noSaturation DICOLOR.grayish DICOLOR.moderate
|
||||
DICOLOR.strong DICOLOR.vivid))
|
||||
(DECLARE: EVAL@COMPILE
|
||||
|
||||
(RPAQQ DICOLOR.noSaturation 0)
|
||||
|
||||
(RPAQQ DICOLOR.grayish 1)
|
||||
|
||||
(RPAQQ DICOLOR.moderate 2)
|
||||
|
||||
(RPAQQ DICOLOR.strong 3)
|
||||
|
||||
(RPAQQ DICOLOR.vivid 4)
|
||||
|
||||
(CONSTANTS DICOLOR.noSaturation DICOLOR.grayish DICOLOR.moderate DICOLOR.strong DICOLOR.vivid)
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ DICOLOR.lightnessConstants (DICOLOR.black DICOLOR.veryDark DICOLOR.dark DICOLOR.medium
|
||||
DICOLOR.light DICOLOR.veryLight DICOLOR.white))
|
||||
(DECLARE: EVAL@COMPILE
|
||||
|
||||
(RPAQQ DICOLOR.black 0)
|
||||
|
||||
(RPAQQ DICOLOR.veryDark 1)
|
||||
|
||||
(RPAQQ DICOLOR.dark 2)
|
||||
|
||||
(RPAQQ DICOLOR.medium 3)
|
||||
|
||||
(RPAQQ DICOLOR.light 4)
|
||||
|
||||
(RPAQQ DICOLOR.veryLight 5)
|
||||
|
||||
(RPAQQ DICOLOR.white 6)
|
||||
|
||||
(CONSTANTS DICOLOR.black DICOLOR.veryDark DICOLOR.dark DICOLOR.medium DICOLOR.light DICOLOR.veryLight
|
||||
DICOLOR.white)
|
||||
)
|
||||
)
|
||||
(PUTPROPS DICOLOR COPYRIGHT ("Xerox Corporation" 1985))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (1005 8438 (CNSMENUINIT 1015 . 1502) (CNSTOCSL 1504 . 2550) (CNSTORGB 2552 . 2782) (
|
||||
CSLTOCNS 2784 . 3683) (DICOLOR.FROM.USER 3685 . 5118) (GETCNS 5120 . 5322) (HLSTOCSL 5324 . 7615) (
|
||||
CSLTOHLS 7617 . 8217) (RGBTOCNS 8219 . 8436)) (9938 12002 (DICOLOR.hueN 9948 . 10228) (
|
||||
DICOLOR.hueNvalue 10230 . 10405) (DICOLOR.hueNname 10407 . 10580) (DICOLOR.lightnessN 10582 . 10892) (
|
||||
DICOLOR.lightnessNvalue 10894 . 11087) (DICOLOR.lightnessNname 11089 . 11280) (DICOLOR.saturationN
|
||||
11282 . 11606) (DICOLOR.saturationNvalue 11608 . 11804) (DICOLOR.saturationNname 11806 . 12000)))))
|
||||
STOP
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
Binary file not shown.
Binary file not shown.
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -1,12 +1,9 @@
|
||||
We've moved to separate releases of medley and maiko.
|
||||
There are separate releases of medley and maiko.
|
||||
Just get the latest version of each.
|
||||
|
||||
Or, you could pick up the medley release and build your own maiko.
|
||||
Medley release is here:
|
||||
Alternatively, you can pick up the medley release, and build your own maiko.
|
||||
|
||||
`medley-`releasename`.tgz`
|
||||
|
||||
Maiko relese is [here](https://github.com/Interlisp/maiko/releases)
|
||||
Get the Maiko release [here](https://github.com/Interlisp/maiko/releases).
|
||||
|
||||
To use (from a shell/terminal window):
|
||||
|
||||
@@ -14,15 +11,19 @@ To use (from a shell/terminal window):
|
||||
```
|
||||
tar -xvfz $tag.tgz
|
||||
```
|
||||
x and the maiko file for your os.arch, e.g.,
|
||||
|
||||
2. Unpack the maiko file for your operating system and CPU type,e.g.,
|
||||
|
||||
```
|
||||
tar -xvfz maiko-210823.linux.x86_64.tgz
|
||||
```
|
||||
This should leave you with two directories, `medley` and `maiko`.
|
||||
|
||||
3. This should leave you with two directories, `medley` and `maiko`.
|
||||
Then you can
|
||||
```
|
||||
cd medley
|
||||
./run-medley -full
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
103
run-medley
103
run-medley
@@ -1,16 +1,18 @@
|
||||
#!/bin/sh
|
||||
# Run Medley
|
||||
#
|
||||
# Syntax: run-medley [--dimensions WIDTHxHEIGHT] \ sets both -g -sc
|
||||
# [-g WIDTHxHEIGHT] \
|
||||
# [-sc WIDTHxHEIGHT] \
|
||||
# [--display X_DISPLAY] \
|
||||
# [--vmem | --vmfile FILE] \
|
||||
# [--nogreet | --greet FILE] \
|
||||
# [-n | -nl |
|
||||
# [URL_OR_FILE]
|
||||
# Syntax: run-medley [--dimensions WIDTHxHEIGHT] # sets both -g -sc
|
||||
# [-g WIDTHxHEIGHT]
|
||||
# [-sc WIDTHxHEIGHT]
|
||||
# [--display X_DISPLAY] # defaults to $DISPLAY or :0
|
||||
# [-prog LDEFILE]
|
||||
# [--vmem | --vmfile FILE]
|
||||
# [--nogreet | --greet FILE |
|
||||
# --loadup FILE ] # will separate from GREET
|
||||
# [-n | -nl | -full | -lisp |
|
||||
# [SYSOUTFILE]
|
||||
|
||||
# Directory variables are accessible from Lisp via UNIX-GETENV
|
||||
# Variables accessible from Lisp via UNIX-GETENV
|
||||
# LDESRCESYSOUT SYSOUT full-file name you want to run
|
||||
# LDEDESTSYSOUT name for destination of SaveVM/LOGOUT
|
||||
# MEDLEYDIR used by init file to set other path variables
|
||||
@@ -53,8 +55,17 @@ export LDEKBDTYPE=x
|
||||
|
||||
while [ "$#" -ne 0 ]; do
|
||||
case "$1" in
|
||||
"-loadup")
|
||||
export MEDLEYLOADUP="$2"
|
||||
export LDEINIT="$2"
|
||||
shift
|
||||
;;
|
||||
"-nogreet" | "--nogreet")
|
||||
export LDEINIT=""
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
|
||||
;;
|
||||
"-greet" | "--greet")
|
||||
export LDEINIT="$2"
|
||||
@@ -120,8 +131,6 @@ while [ "$#" -ne 0 ]; do
|
||||
shift
|
||||
done
|
||||
|
||||
# not set on command line
|
||||
|
||||
if [ -z "$LDESRCESYSOUT" ] ; then
|
||||
if [ -f "$LDEDESTSYSOUT" ] ; then
|
||||
export LDESRCESYSOUT="$LDEDESTSYSOUT"
|
||||
@@ -136,45 +145,39 @@ if [ -z "$geometry" ] ; then
|
||||
screensize="-sc 1440x900"
|
||||
fi
|
||||
|
||||
case "$LDESRCSYSOUT" in
|
||||
"http:*" | "https:*")
|
||||
echo URL not supported yet
|
||||
exit 1
|
||||
esac
|
||||
|
||||
inferred_maikodir=false
|
||||
|
||||
if [ -z "$MAIKODIR" ] ; then
|
||||
# here we try two options relative to MEDLEYDIR: ./maiko and ../maiko
|
||||
# this is highly imperfect, but the user can always set the env variables
|
||||
export MAIKODIR="$MEDLEYDIR/../maiko"
|
||||
if [ ! -d "$MAIKODIR" ] ; then
|
||||
export MAIKODIR="$MEDLEYDIR/maiko"
|
||||
fi
|
||||
inferred_maikodir=true
|
||||
fi
|
||||
|
||||
if [ ! -d "$MAIKODIR/bin" ] ; then
|
||||
echo "MAIKODIR has no bin: $MAIKODIR"
|
||||
if [ inferred_maikodir = true ] ; then
|
||||
echo "I tried to infer it based on your working directory, but that didn't work."
|
||||
echo "Try setting the MAIKODIR environment variable to the right location."
|
||||
fi
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
oldpath="$PATH"
|
||||
|
||||
export PATH=.:"$PATH"
|
||||
cd "$MAIKODIR"/bin
|
||||
export PATH="$MAIKODIR"/`osversion`.`machinetype`:"$oldpath"
|
||||
|
||||
cd "$OLDPWD"
|
||||
|
||||
if ! command -v "$prog" > /dev/null 2>&1; then
|
||||
echo "$prog" not found
|
||||
exit 1
|
||||
# if lde is already on path, don't reset it
|
||||
# otherwise check for MAIKODIR
|
||||
|
||||
if [ -z "$MAIKODIR" ] ; then
|
||||
# try two options relative to MEDLEYDIR: ./maiko and ../maiko
|
||||
MAIKODIR="$MEDLEYDIR/../maiko"
|
||||
if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
|
||||
MAIKODIR="$MEDLEYDIR/maiko"
|
||||
fi
|
||||
fi
|
||||
|
||||
if ! command -v "$MAIKODIR/bin/osversion" > /dev/null 2>&1; then
|
||||
echo "Could not find 'lde' on PATH"
|
||||
echo "nor MAIKODIR with 'bin/osversion' (to look for it)"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
oldpath="$PATH"
|
||||
oldpwd=`pwd`
|
||||
PATH=.:"$PATH"
|
||||
cd "$MAIKODIR"/bin
|
||||
osv=`osversion`
|
||||
mct=`machinetype`
|
||||
newpath="$MAIKODIR"/"$osv.$mct"
|
||||
PATH="$newpath":"$oldpath"
|
||||
cd "$oldpwd"
|
||||
if ! command -v $prog > /dev/null 2>&1; then
|
||||
echo $prog not found in $newpath
|
||||
echo osversion = $osv
|
||||
echo machinetype = $mct
|
||||
exit 1
|
||||
fi
|
||||
fi
|
||||
|
||||
echo "running: $prog $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
|
||||
|
||||
@@ -7,10 +7,6 @@ if [ ! -x run-medley ] ; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# set timestamp
|
||||
mkdir -p ./tmp
|
||||
touch ./tmp/loadup.timestamp
|
||||
|
||||
./scripts/loadup-init.sh && \
|
||||
./scripts/loadup-mid-from-init.sh && \
|
||||
./scripts/loadup-lisp-from-mid.sh && \
|
||||
|
||||
@@ -9,10 +9,15 @@ fi
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
echo '" (IL:MEDLEY-INIT-VARS)(IL:LOAD(QUOTE MEDLEY-UTILS))(IL:MAKE-EXPORTS-ALL)(IL:MAKE-WHEREIS-HASH)(IL:LOGOUT T)"' > tmp/loadup-aux.cm
|
||||
./run-medley $scr -greet "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/tmp/loadup-aux.cm tmp/full.sysout
|
||||
|
||||
if [ tmp/whereis.hash -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -10,7 +10,12 @@ scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
|
||||
|
||||
if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -6,11 +6,17 @@ if [ ! -x run-medley ] ; then
|
||||
echo must run from MEDLEYDIR ;
|
||||
exit 1 ;
|
||||
fi
|
||||
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
|
||||
./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
|
||||
|
||||
if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -9,10 +9,14 @@ fi
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
mkdir -p "$MEDLEYDIR/tmp"
|
||||
# Keep (GREET) from finding an init file
|
||||
mkdir -p $MEDLEYDIR/tmp/logindir
|
||||
export HOME=$MEDLEYDIR/tmp/logindir
|
||||
export LOGINDIR=$MEDLEYDIR/tmp/logindir
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
|
||||
./run-medley $scr -loadup "$MEDLEYDIR"/sources/LOADUP-INIT.LISP loadups/starter.sysout
|
||||
|
||||
if [ tmp/init.dlinit -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
|
||||
./run-medley $scr -loadup "$MEDLEYDIR/sources/LOADUP-LISP.CM" tmp/init-mid.sysout
|
||||
|
||||
if [ tmp/lisp.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -12,7 +12,7 @@ touch tmp/loadup.timestamp
|
||||
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
./run-medley -prog ldeinit -greet $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
|
||||
./run-medley -prog ldeinit -loadup $MEDLEYDIR/sources/XREM.CM $scr -vmem tmp/init-mid.sysout tmp/init.dlinit
|
||||
|
||||
|
||||
echo
|
||||
|
||||
@@ -16,8 +16,9 @@ cd ..
|
||||
echo making medley zip $tag
|
||||
|
||||
tar cfz medley/tmp/$tag.tgz \
|
||||
--exclude-backups --exclude="*.PDF" \
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
medley/docs/dinfo \
|
||||
medley/docs/Documentation\ Tools \
|
||||
medley/greetfiles/SIMPLE-INIT \
|
||||
medley/run-medley \
|
||||
medley/scripts \
|
||||
@@ -28,10 +29,9 @@ tar cfz medley/tmp/$tag.tgz \
|
||||
medley/fonts/postscriptfonts \
|
||||
medley/library/ \
|
||||
medley/lispusers/ \
|
||||
|
||||
# medley/fonts/big medley/fonts/other \
|
||||
# medley/sources/
|
||||
# medley/internal/library \
|
||||
medley/fonts/big medley/fonts/other \
|
||||
medley/sources/ \
|
||||
medley/internal/library \
|
||||
|
||||
cd medley
|
||||
|
||||
|
||||
@@ -1,31 +0,0 @@
|
||||
#!/bin/sh
|
||||
export MEDLEYDIR=`pwd`
|
||||
|
||||
if [ ! -x run-medley ] ; then
|
||||
echo "run from MEDLEYDIR (with MAIKODIR ../maiko)"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
tag=$1
|
||||
if [ -z "$tag" ] ; then
|
||||
tag=nightly-`date +%y%m%d`
|
||||
fi
|
||||
|
||||
cd ../maiko/bin
|
||||
export PATH=.:"$PATH"
|
||||
osarch=`osversion`.`machinetype`
|
||||
|
||||
cd ../..
|
||||
|
||||
echo making maiko-$tag-$osarch.tgz
|
||||
|
||||
tar cfz medley/tmp/maiko-$tag-$osarch.tgz \
|
||||
--exclude "make*" --exclude legacy \
|
||||
maiko/bin \
|
||||
maiko/$osarch/lde*
|
||||
|
||||
cd medley
|
||||
|
||||
echo uploading
|
||||
|
||||
gh release upload --clobber $tag tmp/maiko-$tag-$osarch.tgz
|
||||
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "23-May-91 14:25:00" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;4| 43099
|
||||
(FILECREATED "11-Sep-2021 12:54:19" {DSK}<home>larry>medley>sources>ASTACK.;2 43098
|
||||
|
||||
changes to%: (FNS \STKARG)
|
||||
changes to%: (FNS STKARGNAME)
|
||||
|
||||
previous date%: "20-Feb-91 13:47:06" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>ASTACK.;3|)
|
||||
previous date%: "23-May-91 14:25:00" {DSK}<home>larry>medley>sources>ASTACK.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1982-1987, 1990-1991 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ASTACKCOMS)
|
||||
@@ -501,7 +501,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
|
||||
(T (LISPERROR "ILLEGAL STACK ARG" N])
|
||||
|
||||
(STKARGNAME
|
||||
[LAMBDA (N POS) (* ; "Edited 18-Feb-91 16:55 by jds")
|
||||
[LAMBDA (N POS NOERROR) (* ; "Edited 11-Sep-2021 12:51 by larry")
|
||||
|
||||
(* ;; "Given an interpreted frame and an argument number, return the name of that argument (actually, just the n-th NameTable entry)")
|
||||
|
||||
@@ -552,6 +552,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
|
||||
WORDSPERCELL]
|
||||
(RETURN)))
|
||||
(MAKE-NTENTRY PVARCODE (SUB1 NTENTRY)))
|
||||
(NOERROR (RETURN))
|
||||
(T (LISPERROR "ILLEGAL STACK ARG" N]
|
||||
(RETURN (for NT1 from (fetch (FNHEADER OVERHEADWORDS) of T)
|
||||
by (CONSTANT (WORDSPERNAMEENTRY)) as NT2
|
||||
@@ -789,13 +790,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1991 by Venue & Xerox Co
|
||||
)
|
||||
(PUTPROPS ASTACK COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1519 4724 (ARG 1529 . 1688) (SETARG 1690 . 1874) (\ARG 1876 . 2111) (\ARGPTR 2113 .
|
||||
4455) (\SETARG 4457 . 4722)) (4725 8940 (\RETURN 4735 . 5093) (\STACKARGPTR 5095 . 8938)) (8985 12362
|
||||
(STKNTH 8995 . 9893) (STKNTHNAME 9895 . 10782) (STKNAME 10784 . 10929) (SETSTKNAME 10931 . 12360)) (
|
||||
12363 16138 (STKPOS 12373 . 13294) (STKSCAN 13296 . 13942) (RETFROM 13944 . 14298) (RETTO 14300 .
|
||||
14575) (RESUME 14577 . 15950) (\RESUME 15952 . 16136)) (16139 42186 (STKARG 16149 . 16484) (\STKARG
|
||||
16486 . 21189) (SETSTKARG 21191 . 25374) (STKARGNAME 25376 . 29599) (\SPREADFRAMEP 29601 . 30142) (
|
||||
SETSTKARGNAME 30144 . 33435) (STKNARGS 33437 . 35846) (FRAMESCAN 35848 . 36298) (\INTERPFRAMENT 36300
|
||||
. 36700) (\FRAMESCAN 36702 . 39755) (\VAROFFSET 39757 . 42184)) (42228 42781 (\RECLAIMSTACKP 42238 .
|
||||
42779)))))
|
||||
(FILEMAP (NIL (1470 4675 (ARG 1480 . 1639) (SETARG 1641 . 1825) (\ARG 1827 . 2062) (\ARGPTR 2064 .
|
||||
4406) (\SETARG 4408 . 4673)) (4676 8891 (\RETURN 4686 . 5044) (\STACKARGPTR 5046 . 8889)) (8936 12313
|
||||
(STKNTH 8946 . 9844) (STKNTHNAME 9846 . 10733) (STKNAME 10735 . 10880) (SETSTKNAME 10882 . 12311)) (
|
||||
12314 16089 (STKPOS 12324 . 13245) (STKSCAN 13247 . 13893) (RETFROM 13895 . 14249) (RETTO 14251 .
|
||||
14526) (RESUME 14528 . 15901) (\RESUME 15903 . 16087)) (16090 42185 (STKARG 16100 . 16435) (\STKARG
|
||||
16437 . 21140) (SETSTKARG 21142 . 25325) (STKARGNAME 25327 . 29598) (\SPREADFRAMEP 29600 . 30141) (
|
||||
SETSTKARGNAME 30143 . 33434) (STKNARGS 33436 . 35845) (FRAMESCAN 35847 . 36297) (\INTERPFRAMENT 36299
|
||||
. 36699) (\FRAMESCAN 36701 . 39754) (\VAROFFSET 39756 . 42183)) (42227 42780 (\RECLAIMSTACKP 42237 .
|
||||
42778)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
BIN
sources/BSP.LCOM
BIN
sources/BSP.LCOM
Binary file not shown.
Binary file not shown.
Binary file not shown.
108
sources/DEBUGGER
108
sources/DEBUGGER
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES
|
||||
"DBG")))
|
||||
(IL:FILECREATED "16-Aug-91 17:38:56" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;3| 84381
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES "DBG")) READTABLE
|
||||
"XCL" BASE 10)
|
||||
(IL:FILECREATED "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2| 84311
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS DEBUGGER-EVAL)
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS STACK-FRAME-PROPERTIES)
|
||||
|
||||
IL:|previous| IL:|date:| "16-May-90 15:26:02" IL:|{PELE:MV:ENVOS}<LISPCORE>SOURCES>DEBUGGER.;2|
|
||||
IL:|previous| IL:|date:| "16-Aug-91 17:38:56" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:DEBUGGERCOMS)
|
||||
|
||||
@@ -520,14 +520,13 @@
|
||||
|
||||
(DEFVAR IL:LASTPOS)
|
||||
|
||||
(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
|
||||
(XCL:DEFCOMMAND ("@" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
|
||||
"Set debugger stack pointer to location specified by PLACE (or default)"
|
||||
(FORMAT T "@ = ~S~%" (IL:STKNAME (FIND-DEBUGGER-STACK-FRAME IL:PLACE IL:ENV)))
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV) (DECLARE (SPECIAL
|
||||
IL:BRKVALUES)
|
||||
)
|
||||
(XCL:DEFCOMMAND ("REVERT" :DEBUGGER) (&REST IL:PLACE &ENVIRONMENT IL:ENV)
|
||||
(DECLARE (SPECIAL IL:BRKVALUES))
|
||||
"Unwind to specified frame (or LASTPOS) and enter breakpoint"
|
||||
|
||||
(IL:* IL:|;;| "Find the stack frame that the user asked to unwind to , if any:")
|
||||
@@ -561,7 +560,8 @@
|
||||
(IL:RELSTK IL:POS))))))))
|
||||
(THROW 'DEBUGGER-EXIT NIL)))
|
||||
|
||||
(XCL:DEFCOMMAND ("?=" :DEBUGGER) NIL "Show arguments"
|
||||
(XCL:DEFCOMMAND ("?=" :DEBUGGER) ()
|
||||
"Show arguments"
|
||||
(MULTIPLE-VALUE-BIND (IL:NAME IL:DEFN)
|
||||
(FIND-ORIGINAL-NAME-AND-DEFINITION IL:LASTPOS)
|
||||
(MULTIPLE-VALUE-BIND (IL:LAMBDA-CAR IL:ARGLIST)
|
||||
@@ -589,7 +589,7 @@
|
||||
0 T))))))
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
|
||||
(XCL:DEFCOMMAND ("EVAL" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL IL:EXPRESSION-PROVIDED?))
|
||||
(DECLARE (SPECIAL IL:BRKENV IL:BRKVALUES))
|
||||
"Evaluate expression in debugged context"
|
||||
(XCL:CONDITION-CASE (IF IL:EXPRESSION-PROVIDED?
|
||||
@@ -600,14 +600,15 @@
|
||||
(SI::DEBUGGER-EVAL-ABORTED (IL:C)
|
||||
(VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
|
||||
|
||||
(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) NIL
|
||||
(XCL:DEFCOMMAND ("VALUE" :DEBUGGER :QUIET) ()
|
||||
"Show value from previous evaluation of debug expression"
|
||||
(IF IL:BRKVALUES
|
||||
(VALUES-LIST (CDR IL:BRKVALUES))
|
||||
(PROGN (FORMAT T "Not yet evaluated~&")
|
||||
(VALUES))))
|
||||
|
||||
(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN)) "Unbreak function with breakpoint"
|
||||
(XCL:DEFCOMMAND ("UB" :DEBUGGER) (&OPTIONAL (IL:FN IL:BRKFN))
|
||||
"Unbreak function with breakpoint"
|
||||
(DECLARE (SPECIAL IL:BRKFN))
|
||||
(IL:EVAL (LIST 'XCL:UNBREAK IL:FN)))
|
||||
|
||||
@@ -882,26 +883,32 @@
|
||||
(return nil))))
|
||||
)
|
||||
|
||||
(XCL:DEFCOMMAND ("BT" :DEBUGGER) NIL "Print backtrace of external frames"
|
||||
(XCL:DEFCOMMAND ("BT" :DEBUGGER) ()
|
||||
"Print backtrace of external frames"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :TEST 'XCL::INTERESTING-FRAME-P)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("BT!" :DEBUGGER) NIL "Print backtrace of all frames"
|
||||
(XCL:DEFCOMMAND ("BT!" :DEBUGGER) ()
|
||||
"Print backtrace of all frames"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :TEST NIL)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("BTV" :DEBUGGER) NIL "Print backtrace of frames and special bindings"
|
||||
(XCL:DEFCOMMAND ("BTV" :DEBUGGER) ()
|
||||
"Print backtrace of frames and special bindings"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) NIL "Print backtrace of all frame information"
|
||||
(XCL:DEFCOMMAND ("BTV!" :DEBUGGER) ()
|
||||
"Print backtrace of all frame information"
|
||||
(PRINT-BACKTRACE :FROM IL:LASTPOS :PRINT-VARIABLES T :PRINT-JUNK T)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("DBT" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU NIL T)
|
||||
(XCL:DEFCOMMAND ("DBT" :DEBUGGER) ()
|
||||
(ATTACH-BACKTRACE-MENU NIL T)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) NIL (ATTACH-BACKTRACE-MENU)
|
||||
(XCL:DEFCOMMAND ("DBT!" :DEBUGGER) ()
|
||||
(ATTACH-BACKTRACE-MENU)
|
||||
(VALUES))
|
||||
|
||||
(DEFUN ATTACH-BACKTRACE-MENU (&OPTIONAL IL:TTYWINDOW IL:SKIP)
|
||||
@@ -1209,7 +1216,7 @@
|
||||
0
|
||||
IL:AS I IL:|from| (1+ NUM-ARGS) IL:|to| TOTAL-SLOTS
|
||||
IL:|when| (AND (IL:NEQ NOVALUE (IL:STKARG I POS NOVALUE))
|
||||
(OR (SETF ARGNAME (IL:STKARGNAME I POS))
|
||||
(OR (SETF ARGNAME (IL:STKARGNAME I POS T))
|
||||
(AND LOTS? (SETQ ARGNAME (FORMAT NIL "local ~D" PVAR))
|
||||
))) IL:|collect| (LIST ARGNAME I))))
|
||||
(AND SLOTS (CONS '("locals")
|
||||
@@ -1345,16 +1352,19 @@
|
||||
(T 0)))
|
||||
OUTPUT))
|
||||
|
||||
(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) NIL "Exit this debugger level"
|
||||
(XCL:DEFCOMMAND ("STOP" :DEBUGGER :QUIET) ()
|
||||
"Exit this debugger level"
|
||||
(IL:SETQ IL:BRKVALUES '(IL:ERROR!))
|
||||
(THROW 'DEBUGGER-EXIT NIL))
|
||||
|
||||
(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) NIL "Abort out of debugger"
|
||||
(XCL:DEFCOMMAND ("^" :DEBUGGER :QUIET) ()
|
||||
"Abort out of debugger"
|
||||
(IL:SETQ IL:BRKVALUES '(IL:ERROR!))
|
||||
(THROW 'DEBUGGER-EXIT NIL))
|
||||
|
||||
(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
|
||||
&ENVIRONMENT IL:ENV) "Return value from debugger"
|
||||
(XCL:DEFCOMMAND ("RETURN" :DEBUGGER) (&OPTIONAL (IL:EXPRESSION NIL)
|
||||
&ENVIRONMENT IL:ENV)
|
||||
"Return value from debugger"
|
||||
(XCL:CONDITION-CASE (PROGN (IL:SETQ IL:BRKVALUES (LIST 'RETURN (MULTIPLE-VALUE-LIST (
|
||||
DEBUGGER-EVAL
|
||||
IL:EXPRESSION
|
||||
@@ -1364,20 +1374,23 @@
|
||||
(SI::DEBUGGER-EVAL-ABORTED (IL:C)
|
||||
(VALUES :ABORTED (SI::DEBUGGER-EVAL-ABORTED-CONDITION IL:C)))))
|
||||
|
||||
(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER) "Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
(XCL:DEFCOMMAND ("PR" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
"Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) NIL (DECLARE (SPECIAL IL:BRKENV))
|
||||
(XCL:DEFCOMMAND ("PR!" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
"Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER NIL IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("PROCEED" :DEBUGGER) (&OPTIONAL IL:NAME-OR-NUMBER)
|
||||
"Select and invoke a proceed case."
|
||||
(ESCAPE-FROM-DEBUGGER T IL:NAME-OR-NUMBER)
|
||||
(VALUES))
|
||||
|
||||
(XCL:DEFCOMMAND ("OK" :DEBUGGER :QUIET) ()
|
||||
(DECLARE (SPECIAL IL:BRKENV))
|
||||
"Exit/proceed from debugger"
|
||||
(XCL:CONDITION-CASE (PROGN (WHEN (TYPEP IL:BRKCOND 'SI::BREAKPOINT)
|
||||
|
||||
@@ -1530,6 +1543,27 @@
|
||||
)
|
||||
(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (18680 18967 (IL:WBREAK 18693 . 18965)) (42297 47159 (IL:BAKTRACE 42310 . 45094) (
|
||||
IL:BAKTRACE1 45096 . 47157)) (81689 83655 (IL:FIND-STACK-FRAME 81702 . 83653)))))
|
||||
(IL:FILEMAP (NIL (4639 6450 (XCL:ENTER-DEBUGGER-P 4639 . 6450)) (6452 13574 (XCL:DEBUGGER 6452 . 13574
|
||||
)) (13576 13890 (EMERGENCY-PANIC-LOOP 13576 . 13890)) (13892 15347 (IL:FIND-DEBUGGER-ENTRY-FRAME 13892
|
||||
. 15347)) (15349 16038 (PRINT-ENTRY-MESSAGE 15349 . 16038)) (16040 16341 (SIMPLE-REPORT-CONDITION
|
||||
16040 . 16341)) (16343 18083 (XCL::INTERESTING-FRAME-P 16343 . 18083)) (18668 18955 (IL:WBREAK 18681
|
||||
. 18953)) (19068 20177 (REUSE-CURRENT-WINDOW 19068 . 20177)) (20179 21483 (CREATE-DEBUGGER-WINDOW
|
||||
20179 . 21483)) (21485 22437 (SET-UP-DEBUGGER-WINDOW 21485 . 22437)) (22439 23454 (
|
||||
CLOSE-DEBUGGER-WINDOW 22439 . 23454)) (23456 23942 (RELEASE-DEBUGGER-WINDOW 23456 . 23942)) (23944
|
||||
24881 (NEAR-BY-REGION 23944 . 24881)) (24883 25993 (DEBUGGER-BUTTON-EVENT 24883 . 25993)) (25995 26932
|
||||
(DEBUGGER-MENU-HELP 25995 . 26932)) (31872 33690 (DEBUGGER-EVAL 31872 . 33690)) (33692 38041 (
|
||||
FIND-DEBUGGER-STACK-FRAME 33692 . 38041)) (38043 38782 (FIND-NAMED-STACK-POSITION 38043 . 38782)) (
|
||||
38784 39416 (FIND-ORIGINAL-NAME-AND-DEFINITION 38784 . 39416)) (39418 39552 (STKPTR-CCODE 39418 .
|
||||
39552)) (42143 47005 (IL:BAKTRACE 42156 . 44940) (IL:BAKTRACE1 44942 . 47003)) (47841 54770 (
|
||||
ATTACH-BACKTRACE-MENU 47841 . 54770)) (54772 57983 (REGION-NEXT-TO 54772 . 57983)) (57985 59428 (
|
||||
BACKTRACE-MENU-BUTTONEVENTFN 57985 . 59428)) (59430 63704 (BACKTRACE-ITEM-SELECTED 59430 . 63704)) (
|
||||
63706 67543 (STACK-FRAME-PROPERTIES 63706 . 67543)) (67545 68555 (STACK-FRAME-FETCHFN 67545 . 68555))
|
||||
(68557 69744 (STACK-FRAME-STOREFN 68557 . 69744)) (69746 70321 (STACK-FRAME-VALUE-COMMAND 69746 .
|
||||
70321)) (70323 70733 (STACK-FRAME-PROPERTY 70323 . 70733)) (70735 72720 (MAKE-FRAME-INSPECT-WINDOW
|
||||
70735 . 72720)) (72722 72919 (%RELEASE-STACK-DATUM 72722 . 72919)) (72921 73627 (PRINT-BACKTRACE 72921
|
||||
. 73627)) (76856 76950 (EXIT-DEBUGGER 76856 . 76950)) (76952 77271 (INVOKE-ESCAPE-FROM-MENU 76952 .
|
||||
77271)) (77273 78696 (ESCAPE-FROM-DEBUGGER 77273 . 78696)) (78698 79076 (MENU-FROM-ESCAPE-LIST 78698
|
||||
. 79076)) (79078 80237 (KEYLIST-FROM-ESCAPE-LIST 79078 . 80237)) (80239 81247 (COLLECT-ACTIVE-ESCAPES
|
||||
80239 . 81247)) (81249 81618 (IL:FIND-LEXICAL-ENVIRONMENT 81249 . 81618)) (81619 83585 (
|
||||
IL:FIND-STACK-FRAME 81632 . 83583)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
535
sources/FILEIO
535
sources/FILEIO
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED "13-Aug-2021 18:39:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;87 178368
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-Sep-2021 15:54:14"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;92 178421
|
||||
|
||||
changes to%: (FNS COPYCHARS)
|
||||
changes to%: (RECORDS FDEV)
|
||||
|
||||
previous date%: " 8-Aug-2021 14:53:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;86)
|
||||
previous date%: "13-Aug-2021 18:39:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;91)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -18,14 +18,14 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
[(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
|
||||
FILEIO)
|
||||
|
||||
(* ;; "Device independent IO. This file is used by VAX")
|
||||
(* ;; "Device independent IO. This file is used by VAX")
|
||||
|
||||
(COMS
|
||||
(* ;; "STREAM, FDEV declarations")
|
||||
(* ;; "STREAM, FDEV declarations")
|
||||
|
||||
(DECLARE%: FIRST DOCOPY
|
||||
|
||||
(* ;; "The microcode relies on STREAM being of a particular type, viz. the first type declared in the initial loadup (after VMEMPAGEP)")
|
||||
(* ;; "The microcode relies on STREAM being of a particular type, viz. the first type declared in the initial loadup (after VMEMPAGEP)")
|
||||
|
||||
(INITRECORDS STREAM))
|
||||
(SYSRECORDS STREAM)
|
||||
@@ -38,12 +38,12 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
OVERWRITEABLE READABLE READONLY WRITEABLE)
|
||||
(CONSTANTS * EOLCONVENTIONS)))
|
||||
(FNS STREAMPROP GETSTREAMPROP PUTSTREAMPROP STREAMP)
|
||||
[COMS (* ; "make streams print pretty")
|
||||
[COMS (* ; "make streams print pretty")
|
||||
(FNS \DEFPRINT.BY.NAME \STREAM.DEFPRINT \FDEV.DEFPRINT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'STREAM (FUNCTION \STREAM.DEFPRINT))
|
||||
(DEFPRINT 'FDEV (FUNCTION \FDEV.DEFPRINT]
|
||||
(COMS (* ;
|
||||
"Needed because of STREAM initialization")
|
||||
(COMS (* ;
|
||||
"Needed because of STREAM initialization")
|
||||
(INITVARS (FILELINELENGTH 102)
|
||||
(\STREAM.DEFAULT.MAXBUFFERS 3)))
|
||||
(FNS \GETACCESS \SETACCESS)
|
||||
@@ -51,8 +51,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(RECORDS FDEV FILEGENOBJ)))
|
||||
(INITRECORDS FDEV)
|
||||
(SYSRECORDS FDEV))
|
||||
[COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions")
|
||||
[COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
|
||||
(FNS MAKE-EXTERNALFORMAT)
|
||||
(INITRECORDS EXTERNALFORMAT)
|
||||
@@ -65,7 +65,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(COMS (FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE
|
||||
\THROUGHOUTCHARFN)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT]
|
||||
(COMS (* ; "Device operations")
|
||||
(COMS (* ; "Device operations")
|
||||
(FNS \DEFINEDEVICE \GETDEVICEFROMNAME \GETDEVICEFROMHOSTNAME \REMOVEDEVICE
|
||||
\REMOVEDEVICE.NAMES)
|
||||
(INITVARS (STREAM-AFTER-OPEN-FNS NIL))
|
||||
@@ -74,7 +74,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
\RENAMEFILE \REVALIDATEFILE \PAGED.REVALIDATEFILELST \PAGED.REVALIDATEFILES
|
||||
\PAGED.REVALIDATEFILE \BUFFERED.REVALIDATEFILE \BUFFERED.REVALIDATEFILELST
|
||||
\PRINT-REVALIDATION-RESULT \TRUNCATEFILE \FILE-CONFLICT)
|
||||
(COMS (* ; "Generic enumerator")
|
||||
(COMS (* ; "Generic enumerator")
|
||||
(FNS \GENERATENOFILES \NULLFILEGENERATOR \NOFILESNEXTFILEFN \NOFILESINFOFN)
|
||||
(DECLARE%: DONTCOPY (RECORDS NOFILEGENSTATE)))
|
||||
(FNS \FILE.NOT.OPEN \FILE.WONT.OPEN \ILLEGAL.DEVICEOP \IS.NOT.RANDACCESSP
|
||||
@@ -82,16 +82,16 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(ADDVARS (\FILEDEVICES)
|
||||
(\FILEDEVICENAMES)
|
||||
(\DEVICENAMETODEVICE))
|
||||
(COMS (* ; "Device instances")
|
||||
(COMS (* ; "Device instances")
|
||||
(FNS \FDEVINSTANCE)
|
||||
(MACROS \INHERITFDEVOP.D \INHERITFDEVOP.S))
|
||||
(INITVARS (LOGINHOST/DIR '{DSK})
|
||||
(\CONNECTED.DIRECTORY '{DSK}))
|
||||
(GLOBALVARS LOGINHOST/DIR \CONNECTED.DIRECTORY \FILEDEVICES \FILEDEVICENAMES
|
||||
\DEVICENAMETODEVICE))
|
||||
(COMS (* ; "Directory defaulting")
|
||||
(COMS (* ; "Directory defaulting")
|
||||
(FNS CNDIR DIRECTORYNAME DIRECTORYNAMEP HOSTNAMEP \ADD.CONNECTED.DIR))
|
||||
[COMS (* ; "Binary I/O Public functions")
|
||||
[COMS (* ; "Binary I/O Public functions")
|
||||
(FNS \BACKFILEPTR \BACKPEEKBIN \BACKBIN BIN \BIN \BINS BOUT \BOUT \BOUTS COPYBYTES
|
||||
COPYCHARS COPYFILE \COPYOPENFILE \INFER.FILE.TYPE EOFP FORCEOUTPUT
|
||||
\FLUSH.OPEN.STREAMS CHARSET ACCESS-CHARSET GETEOFPTR GETFILEINFO
|
||||
@@ -99,7 +99,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
BIN16)
|
||||
(PROP (DOPCODE)
|
||||
BOUT)
|
||||
(* ; "Generic functions")
|
||||
(* ; "Generic functions")
|
||||
(FNS \GENERIC.BINS \GENERIC.BOUTS \GENERIC.RENAMEFILE \GENERIC.OPENP \GENERIC.READP
|
||||
\GENERIC.CHARSET)
|
||||
(FNS \MAP-OPEN-STREAMS)
|
||||
@@ -116,7 +116,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(PUTD (CADR PAIR)
|
||||
(GETD (CAR PAIR))
|
||||
T]
|
||||
(COMS (* ; "Internal functions")
|
||||
(COMS (* ; "Internal functions")
|
||||
(FNS \EOF.ACTION \EOSERROR \GETEOFPTR \INCFILEPTR \PEEKBIN \SETCLOSEDFILELENGTH
|
||||
\SETEOFPTR \SETFILEPTR)
|
||||
(FNS \FIXPOUT \FIXPIN)
|
||||
@@ -130,10 +130,10 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
[CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 30]
|
||||
(RECORDS BYTEPTR))
|
||||
(CONSTANTS MaxChar)))
|
||||
(COMS (* ; "Buffered IO")
|
||||
(COMS (* ; "Buffered IO")
|
||||
(FNS \BUFFERED.BIN \BUFFERED.PEEKBIN \BUFFERED.BOUT \BUFFERED.BINS \BUFFERED.BOUTS
|
||||
\BUFFERED.COPYBYTES))
|
||||
[COMS (* ; "NULL device")
|
||||
[COMS (* ; "NULL device")
|
||||
(FNS \NULLDEVICE \NULL.OPENFILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
|
||||
(LOCALVARS . T)
|
||||
@@ -282,58 +282,58 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
|
||||
(DATATYPE STREAM
|
||||
(
|
||||
(* ;; "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now.")
|
||||
(* ;; "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now.")
|
||||
|
||||
(COFFSET WORD) (* ;
|
||||
"Offset in CPPTR of next bin or bout")
|
||||
(CBUFSIZE WORD) (* ;
|
||||
"Offset past last byte in that buffer")
|
||||
(PEEKEDCHARP FLAG) (* ;
|
||||
"if true, PEEKEDCHAR contains value of recent call to unread-char")
|
||||
(ACCESSBITS BITS 3) (* ;
|
||||
"What kind of access file is open for (read, write, append)")
|
||||
(CBUFPTR POINTER) (* ; "Pointer to current buffer")
|
||||
(BYTESIZE BYTE) (* ;
|
||||
"Byte size of stream, always 8 for now")
|
||||
(CHARSET BYTE) (* ; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time")
|
||||
(PEEKEDCHAR WORD) (* ; "value of unread-char call")
|
||||
(CHARPOSITION WORD) (* ; "Used by POSITION etc.")
|
||||
(CBUFMAXSIZE WORD) (* ;
|
||||
"on output, the size of the physical buffer--can't extend beyond this")
|
||||
(COFFSET WORD) (* ;
|
||||
"Offset in CPPTR of next bin or bout")
|
||||
(CBUFSIZE WORD) (* ;
|
||||
"Offset past last byte in that buffer")
|
||||
(PEEKEDCHARP FLAG) (* ;
|
||||
"if true, PEEKEDCHAR contains value of recent call to unread-char")
|
||||
(ACCESSBITS BITS 3) (* ;
|
||||
"What kind of access file is open for (read, write, append)")
|
||||
(CBUFPTR POINTER) (* ; "Pointer to current buffer")
|
||||
(BYTESIZE BYTE) (* ;
|
||||
"Byte size of stream, always 8 for now")
|
||||
(CHARSET BYTE) (* ; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time")
|
||||
(PEEKEDCHAR WORD) (* ; "value of unread-char call")
|
||||
(CHARPOSITION WORD) (* ; "Used by POSITION etc.")
|
||||
(CBUFMAXSIZE WORD) (* ;
|
||||
"on output, the size of the physical buffer--can't extend beyond this")
|
||||
|
||||
(* ;; "-------- Above fields (8 words) potentially known to microcode. --------")
|
||||
(* ;; "-------- Above fields (8 words) potentially known to microcode. --------")
|
||||
|
||||
(NONDEFAULTDATEFLG FLAG)
|
||||
(REVALIDATEFLG FLAG)
|
||||
(MULTIBUFFERHINT FLAG) (* ;
|
||||
"True if stream likes to read and write more than one buffer at a time")
|
||||
(USERCLOSEABLE FLAG) (* ;
|
||||
"Can be closed by CLOSEF; NIL for terminal, dribble...")
|
||||
(FULLFILENAME POINTER) (* ;
|
||||
"Name by which file is known to user")
|
||||
(BINABLE FLAG) (* ; "BIN punts unless this bit on")
|
||||
(BOUTABLE FLAG) (* ; "BOUT punts unless this bit on")
|
||||
(EXTENDABLE FLAG) (* ;
|
||||
"BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512")
|
||||
(CBUFDIRTY FLAG) (* ;
|
||||
"true if BOUT has sullied the current buffer")
|
||||
(DEVICE POINTER) (* ; "FDEV of this guy")
|
||||
(USERVISIBLE FLAG) (* ;
|
||||
"Listed by OPENP; NIL for terminal, dribble ...")
|
||||
(EOLCONVENTION BITS 2) (* ; "End-of-line convention")
|
||||
(NIL FLAG) (* ; "Was NOTXCCS.")
|
||||
(VALIDATION POINTER) (* ;
|
||||
"A number somehow identifying file, used to determine if file has changed in our absence")
|
||||
(CPAGE POINTER) (* ;
|
||||
"CPAGE,,COFFSET constitutes current file pointer for most randaccess streams")
|
||||
(MULTIBUFFERHINT FLAG) (* ;
|
||||
"True if stream likes to read and write more than one buffer at a time")
|
||||
(USERCLOSEABLE FLAG) (* ;
|
||||
"Can be closed by CLOSEF; NIL for terminal, dribble...")
|
||||
(FULLFILENAME POINTER) (* ;
|
||||
"Name by which file is known to user")
|
||||
(BINABLE FLAG) (* ; "BIN punts unless this bit on")
|
||||
(BOUTABLE FLAG) (* ; "BOUT punts unless this bit on")
|
||||
(EXTENDABLE FLAG) (* ;
|
||||
"BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512")
|
||||
(CBUFDIRTY FLAG) (* ;
|
||||
"true if BOUT has sullied the current buffer")
|
||||
(DEVICE POINTER) (* ; "FDEV of this guy")
|
||||
(USERVISIBLE FLAG) (* ;
|
||||
"Listed by OPENP; NIL for terminal, dribble ...")
|
||||
(EOLCONVENTION BITS 2) (* ; "End-of-line convention")
|
||||
(NIL FLAG) (* ; "Was NOTXCCS.")
|
||||
(VALIDATION POINTER) (* ;
|
||||
"A number somehow identifying file, used to determine if file has changed in our absence")
|
||||
(CPAGE POINTER) (* ;
|
||||
"CPAGE,,COFFSET constitutes current file pointer for most randaccess streams")
|
||||
(EPAGE POINTER)
|
||||
(EOFFSET WORD) (* ; "Page, byte offset of eof")
|
||||
(LINELENGTH WORD) (* ;
|
||||
"LINELENGTH of stream, or -1 for no line length")
|
||||
(EOFFSET WORD) (* ; "Page, byte offset of eof")
|
||||
(LINELENGTH WORD) (* ;
|
||||
"LINELENGTH of stream, or -1 for no line length")
|
||||
|
||||
(* ;; "----Following are device-specific fields----")
|
||||
(* ;; "----Following are device-specific fields----")
|
||||
|
||||
(* ;; "Available for device-specific uses, NOT for application use.")
|
||||
(* ;; "Available for device-specific uses, NOT for application use.")
|
||||
|
||||
(F1 POINTER)
|
||||
(F2 POINTER)
|
||||
@@ -346,54 +346,54 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(FW9 WORD)
|
||||
(F10 POINTER)
|
||||
|
||||
(* ;; "----Following only filled in for open streams----")
|
||||
(* ;; "----Following only filled in for open streams----")
|
||||
|
||||
(STRMBINFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(STRMBOUTFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called by \OUTCHAR, the normal character printer.")
|
||||
(ENDOFSTREAMOP POINTER) (* ;
|
||||
"Called if EOF and we try to read.")
|
||||
(OTHERPROPS POINTER) (* ;
|
||||
"PROP LIST for holding other info.")
|
||||
(IMAGEOPS POINTER) (* ; "Image operations vector")
|
||||
(IMAGEDATA POINTER) (* ;
|
||||
"Image instance variables--format depends on IMAGEOPS value")
|
||||
(BUFFS POINTER) (* ;
|
||||
"Buffer chain for pmapped streams")
|
||||
(MAXBUFFERS WORD) (* ;
|
||||
"Max # of buffers the system will allocate.")
|
||||
(LASTCCODE WORD) (* ; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535.")
|
||||
(EXTRASTREAMOP POINTER) (* ;
|
||||
"For use of applications programs, not devices")
|
||||
(INCCODEFN POINTER) (* ; "Set by \EXTERNALFORMAT")
|
||||
(STRMBINFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(STRMBOUTFN POINTER) (* ;
|
||||
"Either the BIN fn from the FDEV, or a trap")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called by \OUTCHAR, the normal character printer.")
|
||||
(ENDOFSTREAMOP POINTER) (* ;
|
||||
"Called if EOF and we try to read.")
|
||||
(OTHERPROPS POINTER) (* ;
|
||||
"PROP LIST for holding other info.")
|
||||
(IMAGEOPS POINTER) (* ; "Image operations vector")
|
||||
(IMAGEDATA POINTER) (* ;
|
||||
"Image instance variables--format depends on IMAGEOPS value")
|
||||
(BUFFS POINTER) (* ;
|
||||
"Buffer chain for pmapped streams")
|
||||
(MAXBUFFERS WORD) (* ;
|
||||
"Max # of buffers the system will allocate.")
|
||||
(LASTCCODE WORD) (* ; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535.")
|
||||
(EXTRASTREAMOP POINTER) (* ;
|
||||
"For use of applications programs, not devices")
|
||||
(INCCODEFN POINTER) (* ; "Set by \EXTERNALFORMAT")
|
||||
(PEEKCCODEFN POINTER)
|
||||
(BACKCCODEFN POINTER)
|
||||
(EXTERNALFORMAT POINTER))
|
||||
(BLOCKRECORD STREAM ((NIL 2 WORD)
|
||||
(UCODEFLAGS1 BITS 1)
|
||||
|
||||
(* ;; "respecification of access bits:")
|
||||
(* ;; "respecification of access bits:")
|
||||
|
||||
(RANDOMWRITEABLE FLAG) (* ;
|
||||
"File open for output (access = OUTPUT or BOTH)")
|
||||
(APPENDABLE FLAG) (* ;
|
||||
"File open for append (OUTPUT or APPEND or BOTH)")
|
||||
(READABLE FLAG) (* ;
|
||||
"File open for read (READ or BOTH)")
|
||||
(RANDOMWRITEABLE FLAG) (* ;
|
||||
"File open for output (access = OUTPUT or BOTH)")
|
||||
(APPENDABLE FLAG) (* ;
|
||||
"File open for append (OUTPUT or APPEND or BOTH)")
|
||||
(READABLE FLAG) (* ;
|
||||
"File open for read (READ or BOTH)")
|
||||
(NIL POINTER)))
|
||||
(BLOCKRECORD STREAM ((NIL 4 WORD)
|
||||
(NIL BITS 14)
|
||||
|
||||
(* ;;
|
||||
"JIS character encoding format specific, overrides CHARSET field.")
|
||||
(* ;;
|
||||
"JIS character encoding format specific, overrides CHARSET field.")
|
||||
|
||||
(IN.KANJIIN FLAG) (* ;
|
||||
"True if input stream is in Kanji-in mode.")
|
||||
(OUT.KANJIIN FLAG) (* ;
|
||||
"True if output stream is in Kanji-in mode.")
|
||||
(IN.KANJIIN FLAG) (* ;
|
||||
"True if input stream is in Kanji-in mode.")
|
||||
(OUT.KANJIIN FLAG) (* ;
|
||||
"True if output stream is in Kanji-in mode.")
|
||||
))
|
||||
[ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
|
||||
(FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM)
|
||||
@@ -809,138 +809,138 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete")
|
||||
(DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete")
|
||||
(RANDOMACCESSP FLAG)
|
||||
(NODIRECTORIES FLAG)
|
||||
(PAGEMAPPED FLAG) (* ;
|
||||
"True if i/o handled by pmap routines")
|
||||
(FDBINABLE FLAG) (* ;
|
||||
"Copied as a microcode flag for INPUT streams formed on this device")
|
||||
(PAGEMAPPED FLAG) (* ;
|
||||
"True if i/o handled by pmap routines")
|
||||
(FDBINABLE FLAG) (* ;
|
||||
"Copied as a microcode flag for INPUT streams formed on this device")
|
||||
(FDBOUTABLE FLAG)
|
||||
(FDEXTENDABLE FLAG)
|
||||
(BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method")
|
||||
(DEVICENAME POINTER) (* ; "Identifying name somehow")
|
||||
(REMOTEP FLAG) (* ;
|
||||
"true if device not local to machine")
|
||||
(SUBDIRECTORIES FLAG) (* ;
|
||||
"true if device has real subdirectories")
|
||||
(INPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their input stream. Method INPUTSTREAM fetches it")
|
||||
(OUTPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it")
|
||||
(DEVICEINFO POINTER) (* ;
|
||||
"arbitrary device-specific info stored here")
|
||||
(OPENFILELST POINTER) (* ;
|
||||
"Default place to keep list of streams open on this device")
|
||||
(BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method")
|
||||
(DEVICENAME POINTER) (* ; "Identifying name somehow")
|
||||
(REMOTEP FLAG) (* ;
|
||||
"true if device not local to machine")
|
||||
(SUBDIRECTORIES FLAG) (* ;
|
||||
"true if device has real subdirectories")
|
||||
(INPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their input stream. Method INPUTSTREAM fetches it")
|
||||
(OUTPUT-INDIRECTED FLAG) (* ;
|
||||
"True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it")
|
||||
(DEVICEINFO POINTER) (* ;
|
||||
"arbitrary device-specific info stored here")
|
||||
(OPENFILELST POINTER) (* ;
|
||||
"Default place to keep list of streams open on this device")
|
||||
|
||||
(* ;; "-----Rest of record consists of device %"methods%"-----")
|
||||
(* ;; "-----Rest of record consists of device %"methods%"-----")
|
||||
|
||||
(* ;; "-----Following fields required of all devices-----")
|
||||
(* ;; "-----Following fields required of all devices-----")
|
||||
|
||||
(HOSTNAMEP POINTER) (* ; "(hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use existing device")
|
||||
(EVENTFN POINTER) (* ;
|
||||
"(device event), called before/after logout, sysout, makesys")
|
||||
(HOSTNAMEP POINTER) (* ; "(hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use existing device")
|
||||
(EVENTFN POINTER) (* ;
|
||||
"(device event), called before/after logout, sysout, makesys")
|
||||
|
||||
(* ;;
|
||||
"-----Following fields required of all named devices, e.g., ones that open files-----")
|
||||
(* ;;
|
||||
"-----Following fields required of all named devices, e.g., ones that open files-----")
|
||||
|
||||
(DIRECTORYNAMEP POINTER) (* ;
|
||||
"(host/dir) => true if directory exists on host")
|
||||
(OPENFILE POINTER) (* ;
|
||||
"(name access recog otherinfo device) => new stream open on this device, or NIL if name not found")
|
||||
(CLOSEFILE POINTER) (* ;
|
||||
"(stream) => closes stream, returns it")
|
||||
(REOPENFILE POINTER) (* ; "(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous")
|
||||
(GETFILENAME POINTER) (* ;
|
||||
"(name recog device) => full file name")
|
||||
(DELETEFILE POINTER) (* ;
|
||||
"(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST")
|
||||
(GENERATEFILES POINTER) (* ; "(device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL when finished")
|
||||
(RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device.")
|
||||
(OPENP POINTER) (* ;
|
||||
"(name access dev) => stream if name is open for access, or all open streams if name = NIL")
|
||||
(REGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => registers stream on its device")
|
||||
(UNREGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => unregisters a stream from its device")
|
||||
(FREEPAGECOUNT POINTER) (* ;
|
||||
"(host/dir dev) => # of free pages on host/dir")
|
||||
(MAKEDIRECTORY POINTER) (* ; "(host/dir dev)")
|
||||
(CHECKFILENAME POINTER) (* ;
|
||||
"(name dev) => name if it is well-formed file name for dev")
|
||||
(HOSTALIVEP POINTER) (* ;
|
||||
"(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true")
|
||||
(BREAKCONNECTION POINTER) (* ;
|
||||
"(host fastp dev) => closes connections to host")
|
||||
(DIRECTORYNAMEP POINTER) (* ;
|
||||
"(host/dir) => true if directory exists on host")
|
||||
(OPENFILE POINTER) (* ;
|
||||
"(name access recog otherinfo device) => new stream open on this device, or NIL if name not found")
|
||||
(CLOSEFILE POINTER) (* ;
|
||||
"(stream) => closes stream, returns it")
|
||||
(REOPENFILE POINTER) (* ; "(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous")
|
||||
(GETFILENAME POINTER) (* ;
|
||||
"(name recog device) => full file name")
|
||||
(DELETEFILE POINTER) (* ;
|
||||
"(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST")
|
||||
(GENERATEFILES POINTER) (* ; "(device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL when finished")
|
||||
(RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device.")
|
||||
(OPENP POINTER) (* ;
|
||||
"(name access dev) => stream if name is open for access, or all open streams if name = NIL")
|
||||
(REGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => registers stream on its device")
|
||||
(UNREGISTERFILE POINTER) (* ;
|
||||
"(stream dev) => unregisters a stream from its device")
|
||||
(FREEPAGECOUNT POINTER) (* ;
|
||||
"(host/dir dev) => # of free pages on host/dir")
|
||||
(MAKEDIRECTORY POINTER) (* ; "(host/dir dev)")
|
||||
(CHECKFILENAME POINTER) (* ;
|
||||
"(name dev) => name if it is well-formed file name for dev")
|
||||
(HOSTALIVEP POINTER) (* ;
|
||||
"(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true")
|
||||
(BREAKCONNECTION POINTER) (* ;
|
||||
"(host fastp dev) => closes connections to host")
|
||||
|
||||
(* ;;
|
||||
"-----The following are required methods for operating on open streams-----")
|
||||
(* ;;
|
||||
"-----The following are required methods for operating on open streams-----")
|
||||
|
||||
(BIN POINTER) (* ; "(stream) => next byte of input")
|
||||
(BOUT POINTER) (* ;
|
||||
"(stream byte) output byte to stream")
|
||||
(PEEKBIN POINTER) (* ;
|
||||
"(stream) => next byte without advancing position in stream")
|
||||
(NIL POINTER) (* ;
|
||||
"Was READCHAR, replaced by READCHARCODE")
|
||||
(NIL POINTER) (* ;
|
||||
"Was WRITECHAR (stream char) => writes char to stream")
|
||||
(NIL POINTER) (* ; "Was PEEKCHAR")
|
||||
(NIL POINTER) (* ; "Was UNREADCHAR")
|
||||
(READP POINTER) (* ;
|
||||
"(stream flag) => T if there is input available from stream right now")
|
||||
(EOFP POINTER) (* ;
|
||||
"(stream) => T if BIN would signal eof.")
|
||||
(BLOCKIN POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(BLOCKOUT POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(FORCEOUTPUT POINTER) (* ;
|
||||
"(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission")
|
||||
(GETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute device) => value of attribute for open stream or name of closed file")
|
||||
(SETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name")
|
||||
(CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file.")
|
||||
(INPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected input stream")
|
||||
(OUTPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected output stream")
|
||||
(BIN POINTER) (* ; "(stream) => next byte of input")
|
||||
(BOUT POINTER) (* ;
|
||||
"(stream byte) output byte to stream")
|
||||
(PEEKBIN POINTER) (* ;
|
||||
"(stream) => next byte without advancing position in stream")
|
||||
(NIL POINTER) (* ;
|
||||
"Was READCHAR, replaced by READCHARCODE")
|
||||
(NIL POINTER) (* ;
|
||||
"Was WRITECHAR (stream char) => writes char to stream")
|
||||
(NIL POINTER) (* ; "Was PEEKCHAR")
|
||||
(NIL POINTER) (* ; "Was UNREADCHAR")
|
||||
(READP POINTER) (* ;
|
||||
"(stream flag) => T if there is input available from stream right now")
|
||||
(EOFP POINTER) (* ;
|
||||
"(stream) => T if BIN would signal eof.")
|
||||
(BLOCKIN POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(BLOCKOUT POINTER) (* ;
|
||||
"(stream buffer byteoffset nbytes)")
|
||||
(FORCEOUTPUT POINTER) (* ;
|
||||
"(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission")
|
||||
(GETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute device) => value of attribute for open stream or name of closed file")
|
||||
(SETFILEINFO POINTER) (* ;
|
||||
"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name")
|
||||
(CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file.")
|
||||
(INPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected input stream")
|
||||
(OUTPUTSTREAM POINTER) (* ;
|
||||
"(stream) => indirected output stream")
|
||||
|
||||
(* ;; "-----Following are required of random-access streams-----")
|
||||
(* ;; "-----Following are required of random-access streams-----")
|
||||
|
||||
(GETFILEPTR POINTER)
|
||||
(GETEOFPTR POINTER)
|
||||
(SETFILEPTR POINTER)
|
||||
(BACKFILEPTR POINTER) (* ; "(stream) backs up `fileptr' by one. Stream is only required to be able to do this once, i.e. one-character buffer suffices")
|
||||
(SETEOFPTR POINTER) (* ;
|
||||
"(stream length) => truncates or lengthens stream to indicated length")
|
||||
(LASTC POINTER) (* ;
|
||||
"Should be possible only if RANDOMACCESSP")
|
||||
(BACKFILEPTR POINTER) (* ; "(stream) backs up `fileptr' by one. Stream is only required to be able to do this once, i.e. one-character buffer suffices")
|
||||
(SETEOFPTR POINTER) (* ;
|
||||
"(stream length) => truncates or lengthens stream to indicated length")
|
||||
(LASTC POINTER) (* ;
|
||||
"Should be possible only if RANDOMACCESSP")
|
||||
|
||||
(* ;; "-----Following used for buffered streams-----")
|
||||
(* ;; "-----Following used for buffered streams-----")
|
||||
|
||||
(GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg")
|
||||
(RELEASEBUFFER POINTER) (* ;
|
||||
"(stream) => Does whatever appropriate when CBUFPTR is released")
|
||||
(GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg")
|
||||
(RELEASEBUFFER POINTER) (* ;
|
||||
"(stream) => Does whatever appropriate when CBUFPTR is released")
|
||||
|
||||
(* ;; "-----Following used for pagemapped streams-----")
|
||||
(* ;; "-----Following used for pagemapped streams-----")
|
||||
|
||||
(READPAGES POINTER) (* ; "(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)")
|
||||
(WRITEPAGES POINTER) (* ;
|
||||
"(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream")
|
||||
(TRUNCATEFILE POINTER) (* ;
|
||||
"(stream page offset) make stream's eof be at page,offset, discarding anything after it")
|
||||
(READPAGES POINTER) (* ; "(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)")
|
||||
(WRITEPAGES POINTER) (* ;
|
||||
"(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream")
|
||||
(TRUNCATEFILE POINTER) (* ;
|
||||
"(stream page offset) make stream's eof be at page,offset, discarding anything after it")
|
||||
|
||||
(* ;; "-----For window system, argh-----")
|
||||
(* ;; "-----For window system, argh-----")
|
||||
|
||||
(WINDOWOPS POINTER) (* ; "window system operations")
|
||||
(WINDOWDATA POINTER) (* ; "data for window systems")
|
||||
(WINDOWOPS POINTER) (* ; "window system operations")
|
||||
(WINDOWDATA POINTER) (* ; "data for window systems")
|
||||
|
||||
(* ;; "-----For any stream (here to not recompile everything)-----")
|
||||
(* ;; "-----For any stream (here to not recompile everything)-----")
|
||||
|
||||
(DEFAULTEXTERNALFORMAT POINTER) (* ;
|
||||
"Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).")
|
||||
(DEFAULTEXTERNALFORMAT POINTER) (* ;
|
||||
"Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).")
|
||||
)
|
||||
DIRECTORYNAMEP _ (FUNCTION NILL)
|
||||
HOSTNAMEP _ (FUNCTION NILL)
|
||||
@@ -957,7 +957,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
OPENP _ (FUNCTION NILL)
|
||||
UNREGISTERFILE _ (FUNCTION NILL)
|
||||
CHARSETFN _ (FUNCTION \GENERIC.CHARSET)
|
||||
BREAKCONNECTION _ (FUNCTION NILL))
|
||||
BREAKCONNECTION _ (FUNCTION NILL)
|
||||
DEFAULTEXTERNALFORMAT _ *DEFAULT-EXTERNALFORMAT*)
|
||||
|
||||
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
|
||||
)
|
||||
@@ -1186,22 +1187,22 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(EOL BITS 2)
|
||||
(NIL BITS 1)
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)))
|
||||
)
|
||||
|
||||
@@ -2947,8 +2948,8 @@ update the map")
|
||||
|
||||
(PUTPROPS \CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?)
|
||||
|
||||
(* ;;
|
||||
"Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns")
|
||||
(* ;;
|
||||
"Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns")
|
||||
|
||||
(CL:TYPECASE PATHNAME?
|
||||
(PATHNAME (INTERLISP-NAMESTRING PATHNAME?))
|
||||
@@ -3395,44 +3396,44 @@ 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))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (28411 31901 (STREAMPROP 28421 . 28855) (GETSTREAMPROP 28857 . 29330) (PUTSTREAMPROP
|
||||
29332 . 31749) (STREAMP 31751 . 31899)) (31944 34463 (\DEFPRINT.BY.NAME 31954 . 33106) (
|
||||
\STREAM.DEFPRINT 33108 . 34156) (\FDEV.DEFPRINT 34158 . 34461)) (34721 39762 (\GETACCESS 34731 . 35185
|
||||
) (\SETACCESS 35187 . 39760)) (63079 64332 (MAKE-EXTERNALFORMAT 63089 . 64330)) (65565 73394 (
|
||||
\INSTALL.EXTERNALFORMAT 65575 . 67024) (\REMOVE.EXTERNALFORMAT 67026 . 67857) (FIND-FORMAT 67859 .
|
||||
68676) (\EXTERNALFORMAT 68678 . 73392)) (73717 75580 (\CREATE.THROUGH.EXTERNALFORMAT 73727 . 74529) (
|
||||
\THROUGHIN 74531 . 74955) (\THROUGHBACKCCODE 74957 . 75228) (\THROUGHOUTCHARFN 75230 . 75578)) (75688
|
||||
81657 (\DEFINEDEVICE 75698 . 78014) (\GETDEVICEFROMNAME 78016 . 78489) (\GETDEVICEFROMHOSTNAME 78491
|
||||
. 79535) (\REMOVEDEVICE 79537 . 80660) (\REMOVEDEVICE.NAMES 80662 . 81655)) (81697 106357 (\CLOSEFILE
|
||||
81707 . 82532) (\DELETEFILE 82534 . 82828) (\DEVICEEVENT 82830 . 84600) (\GENERATEFILES 84602 . 85080
|
||||
) (\GENERATENEXTFILE 85082 . 85733) (\GENERATEFILEINFO 85735 . 86196) (\GETFILENAME 86198 . 86587) (
|
||||
\GENERIC.OUTFILEP 86589 . 87059) (\OPENFILE 87061 . 89639) (\DO.PARAMS.AT.OPEN 89641 . 92194) (
|
||||
\RENAMEFILE 92196 . 92620) (\REVALIDATEFILE 92622 . 95224) (\PAGED.REVALIDATEFILELST 95226 . 96784) (
|
||||
\PAGED.REVALIDATEFILES 96786 . 98505) (\PAGED.REVALIDATEFILE 98507 . 100790) (\BUFFERED.REVALIDATEFILE
|
||||
100792 . 103078) (\BUFFERED.REVALIDATEFILELST 103080 . 104264) (\PRINT-REVALIDATION-RESULT 104266 .
|
||||
104681) (\TRUNCATEFILE 104683 . 105074) (\FILE-CONFLICT 105076 . 106355)) (106393 111056 (
|
||||
\GENERATENOFILES 106403 . 108499) (\NULLFILEGENERATOR 108501 . 108745) (\NOFILESNEXTFILEFN 108747 .
|
||||
110738) (\NOFILESINFOFN 110740 . 111054)) (111175 113083 (\FILE.NOT.OPEN 111185 . 111698) (
|
||||
\FILE.WONT.OPEN 111700 . 112028) (\ILLEGAL.DEVICEOP 112030 . 112312) (\IS.NOT.RANDACCESSP 112314 .
|
||||
112760) (\STREAM.NOT.OPEN 112762 . 113081)) (113218 115516 (\FDEVINSTANCE 113228 . 115514)) (117066
|
||||
124440 (CNDIR 117076 . 118381) (DIRECTORYNAME 118383 . 122566) (DIRECTORYNAMEP 122568 . 123184) (
|
||||
HOSTNAMEP 123186 . 123993) (\ADD.CONNECTED.DIR 123995 . 124438)) (124485 151872 (\BACKFILEPTR 124495
|
||||
. 124683) (\BACKPEEKBIN 124685 . 125046) (\BACKBIN 125048 . 125399) (BIN 125401 . 125618) (\BIN
|
||||
125620 . 125897) (\BINS 125899 . 126185) (BOUT 126187 . 126549) (\BOUT 126551 . 126866) (\BOUTS 126868
|
||||
. 127179) (COPYBYTES 127181 . 130513) (COPYCHARS 130515 . 134181) (COPYFILE 134183 . 134980) (
|
||||
\COPYOPENFILE 134982 . 138055) (\INFER.FILE.TYPE 138057 . 139011) (EOFP 139013 . 139310) (FORCEOUTPUT
|
||||
139312 . 139559) (\FLUSH.OPEN.STREAMS 139561 . 139917) (CHARSET 139919 . 141583) (ACCESS-CHARSET
|
||||
141585 . 141802) (GETEOFPTR 141804 . 142054) (GETFILEINFO 142056 . 145249) (\TYPE.FROM.FILETYPE 145251
|
||||
. 145721) (\FILETYPE.FROM.TYPE 145723 . 145902) (GETFILEPTR 145904 . 146156) (SETFILEINFO 146158 .
|
||||
149771) (SETFILEPTR 149773 . 151492) (BOUT16 151494 . 151679) (BIN16 151681 . 151870)) (151975 157180
|
||||
(\GENERIC.BINS 151985 . 152265) (\GENERIC.BOUTS 152267 . 152532) (\GENERIC.RENAMEFILE 152534 . 154365)
|
||||
(\GENERIC.OPENP 154367 . 155682) (\GENERIC.READP 155684 . 156725) (\GENERIC.CHARSET 156727 . 157178))
|
||||
(157181 157520 (\MAP-OPEN-STREAMS 157191 . 157518)) (159390 161470 (\EOF.ACTION 159400 . 159651) (
|
||||
\EOSERROR 159653 . 159846) (\GETEOFPTR 159848 . 160030) (\INCFILEPTR 160032 . 160382) (\PEEKBIN 160384
|
||||
. 160575) (\SETCLOSEDFILELENGTH 160577 . 160911) (\SETEOFPTR 160913 . 161101) (\SETFILEPTR 161103 .
|
||||
161468)) (161471 162013 (\FIXPOUT 161481 . 161781) (\FIXPIN 161783 . 162011)) (162014 162580 (\BOUTEOL
|
||||
162024 . 162578)) (165672 175536 (\BUFFERED.BIN 165682 . 166534) (\BUFFERED.PEEKBIN 166536 . 167318)
|
||||
(\BUFFERED.BOUT 167320 . 168180) (\BUFFERED.BINS 168182 . 171867) (\BUFFERED.BOUTS 171869 . 173670) (
|
||||
\BUFFERED.COPYBYTES 173672 . 175534)) (175565 177917 (\NULLDEVICE 175575 . 177593) (\NULL.OPENFILE
|
||||
177595 . 177915)))))
|
||||
(FILEMAP (NIL (28396 31886 (STREAMPROP 28406 . 28840) (GETSTREAMPROP 28842 . 29315) (PUTSTREAMPROP
|
||||
29317 . 31734) (STREAMP 31736 . 31884)) (31929 34448 (\DEFPRINT.BY.NAME 31939 . 33091) (
|
||||
\STREAM.DEFPRINT 33093 . 34141) (\FDEV.DEFPRINT 34143 . 34446)) (34706 39747 (\GETACCESS 34716 . 35170
|
||||
) (\SETACCESS 35172 . 39745)) (63132 64385 (MAKE-EXTERNALFORMAT 63142 . 64383)) (65618 73447 (
|
||||
\INSTALL.EXTERNALFORMAT 65628 . 67077) (\REMOVE.EXTERNALFORMAT 67079 . 67910) (FIND-FORMAT 67912 .
|
||||
68729) (\EXTERNALFORMAT 68731 . 73445)) (73770 75633 (\CREATE.THROUGH.EXTERNALFORMAT 73780 . 74582) (
|
||||
\THROUGHIN 74584 . 75008) (\THROUGHBACKCCODE 75010 . 75281) (\THROUGHOUTCHARFN 75283 . 75631)) (75741
|
||||
81710 (\DEFINEDEVICE 75751 . 78067) (\GETDEVICEFROMNAME 78069 . 78542) (\GETDEVICEFROMHOSTNAME 78544
|
||||
. 79588) (\REMOVEDEVICE 79590 . 80713) (\REMOVEDEVICE.NAMES 80715 . 81708)) (81750 106410 (\CLOSEFILE
|
||||
81760 . 82585) (\DELETEFILE 82587 . 82881) (\DEVICEEVENT 82883 . 84653) (\GENERATEFILES 84655 . 85133
|
||||
) (\GENERATENEXTFILE 85135 . 85786) (\GENERATEFILEINFO 85788 . 86249) (\GETFILENAME 86251 . 86640) (
|
||||
\GENERIC.OUTFILEP 86642 . 87112) (\OPENFILE 87114 . 89692) (\DO.PARAMS.AT.OPEN 89694 . 92247) (
|
||||
\RENAMEFILE 92249 . 92673) (\REVALIDATEFILE 92675 . 95277) (\PAGED.REVALIDATEFILELST 95279 . 96837) (
|
||||
\PAGED.REVALIDATEFILES 96839 . 98558) (\PAGED.REVALIDATEFILE 98560 . 100843) (\BUFFERED.REVALIDATEFILE
|
||||
100845 . 103131) (\BUFFERED.REVALIDATEFILELST 103133 . 104317) (\PRINT-REVALIDATION-RESULT 104319 .
|
||||
104734) (\TRUNCATEFILE 104736 . 105127) (\FILE-CONFLICT 105129 . 106408)) (106446 111109 (
|
||||
\GENERATENOFILES 106456 . 108552) (\NULLFILEGENERATOR 108554 . 108798) (\NOFILESNEXTFILEFN 108800 .
|
||||
110791) (\NOFILESINFOFN 110793 . 111107)) (111228 113136 (\FILE.NOT.OPEN 111238 . 111751) (
|
||||
\FILE.WONT.OPEN 111753 . 112081) (\ILLEGAL.DEVICEOP 112083 . 112365) (\IS.NOT.RANDACCESSP 112367 .
|
||||
112813) (\STREAM.NOT.OPEN 112815 . 113134)) (113271 115569 (\FDEVINSTANCE 113281 . 115567)) (117119
|
||||
124493 (CNDIR 117129 . 118434) (DIRECTORYNAME 118436 . 122619) (DIRECTORYNAMEP 122621 . 123237) (
|
||||
HOSTNAMEP 123239 . 124046) (\ADD.CONNECTED.DIR 124048 . 124491)) (124538 151925 (\BACKFILEPTR 124548
|
||||
. 124736) (\BACKPEEKBIN 124738 . 125099) (\BACKBIN 125101 . 125452) (BIN 125454 . 125671) (\BIN
|
||||
125673 . 125950) (\BINS 125952 . 126238) (BOUT 126240 . 126602) (\BOUT 126604 . 126919) (\BOUTS 126921
|
||||
. 127232) (COPYBYTES 127234 . 130566) (COPYCHARS 130568 . 134234) (COPYFILE 134236 . 135033) (
|
||||
\COPYOPENFILE 135035 . 138108) (\INFER.FILE.TYPE 138110 . 139064) (EOFP 139066 . 139363) (FORCEOUTPUT
|
||||
139365 . 139612) (\FLUSH.OPEN.STREAMS 139614 . 139970) (CHARSET 139972 . 141636) (ACCESS-CHARSET
|
||||
141638 . 141855) (GETEOFPTR 141857 . 142107) (GETFILEINFO 142109 . 145302) (\TYPE.FROM.FILETYPE 145304
|
||||
. 145774) (\FILETYPE.FROM.TYPE 145776 . 145955) (GETFILEPTR 145957 . 146209) (SETFILEINFO 146211 .
|
||||
149824) (SETFILEPTR 149826 . 151545) (BOUT16 151547 . 151732) (BIN16 151734 . 151923)) (152028 157233
|
||||
(\GENERIC.BINS 152038 . 152318) (\GENERIC.BOUTS 152320 . 152585) (\GENERIC.RENAMEFILE 152587 . 154418)
|
||||
(\GENERIC.OPENP 154420 . 155735) (\GENERIC.READP 155737 . 156778) (\GENERIC.CHARSET 156780 . 157231))
|
||||
(157234 157573 (\MAP-OPEN-STREAMS 157244 . 157571)) (159443 161523 (\EOF.ACTION 159453 . 159704) (
|
||||
\EOSERROR 159706 . 159899) (\GETEOFPTR 159901 . 160083) (\INCFILEPTR 160085 . 160435) (\PEEKBIN 160437
|
||||
. 160628) (\SETCLOSEDFILELENGTH 160630 . 160964) (\SETEOFPTR 160966 . 161154) (\SETFILEPTR 161156 .
|
||||
161521)) (161524 162066 (\FIXPOUT 161534 . 161834) (\FIXPIN 161836 . 162064)) (162067 162633 (\BOUTEOL
|
||||
162077 . 162631)) (165725 175589 (\BUFFERED.BIN 165735 . 166587) (\BUFFERED.PEEKBIN 166589 . 167371)
|
||||
(\BUFFERED.BOUT 167373 . 168233) (\BUFFERED.BINS 168235 . 171920) (\BUFFERED.BOUTS 171922 . 173723) (
|
||||
\BUFFERED.COPYBYTES 173725 . 175587)) (175618 177970 (\NULLDEVICE 175628 . 177646) (\NULL.OPENFILE
|
||||
177648 . 177968)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,103 +1,103 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-99 22:10:46" {DSK}<project>medley3.5>sources>FONTPROFILE.;2 29960
|
||||
(FILECREATED " 6-Sep-2021 19:11:32"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;4 30288
|
||||
|
||||
changes to%: (VARS FONTPROFILECOMS)
|
||||
(ALISTS (FONTDEFS NS)
|
||||
(FONTDEFS BIGGERNS))
|
||||
changes to%: (ALISTS (FONTDEFS BIGGERNS))
|
||||
|
||||
previous date%: " 9-Jul-91 18:38:04" {DSK}<project>medley3.5>sources>FONTPROFILE.;1)
|
||||
previous date%: " 6-Sep-2021 15:52:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTPROFILECOMS)
|
||||
|
||||
(RPAQQ FONTPROFILECOMS
|
||||
(
|
||||
(* ;; "FONT")
|
||||
(* ;; "FONT")
|
||||
|
||||
(ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER NS BIGGERNS))
|
||||
(ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
|
||||
[VARS (FONTVARS '(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")]
|
||||
(* ; " for %"user%" defined words")]
|
||||
(P (MOVD? 'NILL 'WINDOWTITLEFONT))
|
||||
(FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE)
|
||||
(INITVARS (FONTESCAPECHAR (CHARACTER 6))
|
||||
@@ -242,7 +242,11 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All ri
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 12 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR]
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (MODERN 10))
|
||||
(COMMENTFONT 6 (MODERN 8)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR]
|
||||
[BIGGERNS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
@@ -263,89 +267,93 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All ri
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 14 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR])
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (MODERN 12))
|
||||
(COMMENTFONT 6 (MODERN 10)
|
||||
(MODERN 8 MIR)
|
||||
(MODERN 10 MIR])
|
||||
|
||||
(ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
|
||||
|
||||
(RPAQQ FONTVARS
|
||||
(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")))
|
||||
(* ; " for %"user%" defined words")))
|
||||
|
||||
(MOVD? 'NILL 'WINDOWTITLEFONT)
|
||||
(DEFINEQ
|
||||
@@ -591,8 +599,8 @@ Copyright (c) 1986, 1988, 1990, 1991, 1999 by Venue & Xerox Corporation. All ri
|
||||
|
||||
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL)
|
||||
(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999))
|
||||
(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (16000 27584 (FONTSET 16010 . 22351) (FONTPROFILE 22353 . 24702) (FONTPROFILE.ADDDEVICE
|
||||
24704 . 27582)) (27820 29719 (FONTMAPARRAY 27830 . 29717)))))
|
||||
(FILEMAP (NIL (16323 27907 (FONTSET 16333 . 22674) (FONTPROFILE 22676 . 25025) (FONTPROFILE.ADDDEVICE
|
||||
25027 . 27905)) (28143 30042 (FONTMAPARRAY 28153 . 30040)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,608 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "12-Mar-93 11:02:28" {DSK}<project>medley2.0>patches>FONTPROFILEPATCH.;4 30621
|
||||
|
||||
changes to%: (ALISTS (FONTDEFS HUGE)
|
||||
(FONTDEFS BIG)
|
||||
(FONTDEFS MEDIUM)
|
||||
(FONTDEFS STANDARD)
|
||||
(FONTDEFS BIGGER)
|
||||
(FONTDEFS BIGGERNS)
|
||||
(FONTDEFS NS))
|
||||
|
||||
previous date%: "11-Mar-93 11:51:49" {DSK}<project>medley2.0>patches>FONTPROFILEPATCH.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1993 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTPROFILEPATCHCOMS)
|
||||
|
||||
(RPAQQ FONTPROFILEPATCHCOMS
|
||||
(
|
||||
(* ;; "FONT")
|
||||
|
||||
(ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER BIGGERNS NS))
|
||||
(ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
|
||||
[VARS (FONTVARS '(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")]
|
||||
(P (MOVD? 'NILL 'WINDOWTITLEFONT))
|
||||
(FNS FONTSET FONTPROFILE FONTPROFILE.ADDDEVICE)
|
||||
(INITVARS (FONTESCAPECHAR (CHARACTER 6))
|
||||
(FONTFNS)
|
||||
(FONTWORDS))
|
||||
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (FONTSET 'STANDARD]
|
||||
(GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS)
|
||||
(FNS FONTMAPARRAY)
|
||||
(INITVARS (\FONTMAPCACHE))
|
||||
(P (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL))))
|
||||
|
||||
|
||||
|
||||
(* ;; "FONT")
|
||||
|
||||
|
||||
(ADDTOVAR FONTDEFS
|
||||
[HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(BOLDFONT 2 (MODERN 24 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 18 MRR)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 36 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(TEXTFONT 5 (CLASSIC 24)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 24 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
[BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(TEXTFONT 5 (CLASSIC 18)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(BOLDFONT 2 (MODERN 18 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 12 MRR)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 24 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 18 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
[MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(BOLDFONT 2 (MODERN 14 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 10)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 18)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(TEXTFONT 5 (CLASSIC 14)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 14 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
[STANDARD (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
|
||||
(GACHA 8)
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (HELVETICA 10 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BOLDFONT 2 (HELVETICA 10 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (HELVETICA 8)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(TINYFONT 6 (GACHA 8)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6))
|
||||
(BIGFONT 4 (HELVETICA 12 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (HELVETICA 10))
|
||||
(COMMENTFONT 6 (HELVETICA 10)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8))
|
||||
(TEXTFONT 7 (TIMESROMAN 10)
|
||||
NIL
|
||||
(CLASSIC 10]
|
||||
[BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (HELVETICA 12 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BOLDFONT 2 (HELVETICA 12 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (HELVETICA 10)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(TINYFONT 6 (GACHA 10)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6))
|
||||
(BIGFONT 4 (HELVETICA 14 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (HELVETICA 12))
|
||||
(COMMENTFONT 6 (HELVETICA 12)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8))
|
||||
(TEXTFONT 7 (TIMESROMAN 12)
|
||||
NIL
|
||||
(CLASSIC 10]
|
||||
[BIGGERNS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
(FIRSTCOL . 60)
|
||||
(PRETTYLCOM . 25)
|
||||
(FONTESCAPECHAR . %)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (TERMINAL 12)
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (MODERN 12 BIR)
|
||||
(MODERN 8 BIR)
|
||||
(MODERN 8 BIR))
|
||||
(BOLDFONT 2 (MODERN 12 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 10)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 14 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR]
|
||||
[NS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
(FIRSTCOL . 60)
|
||||
(PRETTYLCOM . 25)
|
||||
(FONTESCAPECHAR . %)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (TERMINAL 10)
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8))
|
||||
(ITALICFONT 1 (MODERN 10 BIR)
|
||||
(MODERN 8 BIR)
|
||||
(MODERN 8 BIR))
|
||||
(BOLDFONT 2 (MODERN 10 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(LITTLEFONT 3 (MODERN 8)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(BIGFONT 4 (MODERN 12 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR])
|
||||
|
||||
(ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
|
||||
|
||||
(RPAQQ FONTVARS
|
||||
(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
|
||||
(BOLDFONT (FONTCOPY DEFAULTFONT 'FACE 'BOLD))
|
||||
(* ; "default BOLD")
|
||||
(ITALICFONT (FONTCOPY DEFAULTFONT 'FACE 'ITALIC))
|
||||
(LITTLEFONT DEFAULTFONT)
|
||||
(* ; " should usually be smaller")
|
||||
(TINYFONT LITTLEFONT)
|
||||
(* ; "and this one smaller still")
|
||||
(BIGFONT BOLDFONT)
|
||||
(* ; "should be bigger still")
|
||||
(TEXTFONT DEFAULTFONT)
|
||||
(* ; "default for text")
|
||||
(TEXTBOLDFONT BOLDFONT)
|
||||
(* ; "default for bold text")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for window system, processes")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(MENUFONT DEFAULTFONT T)
|
||||
(BOLDMENUFONT (FONTCOPY MENUFONT 'FACE 'BOLD))
|
||||
(* ; "if not supplied")
|
||||
(INTERRUPTMENUFONT DEFAULTFONT T)
|
||||
(* ; "used by control-B")
|
||||
(DEFAULTICONFONT MENUFONT)
|
||||
(* ; "for shrinking windows")
|
||||
(BACKTRACEFONT TINYFONT T)
|
||||
(* ; " for backtrace in debugger")
|
||||
(WINDOWTITLEFONT MENUFONT)
|
||||
((WINDOWTITLEFONT WINDOWTITLEFONT)
|
||||
NIL)
|
||||
(* ; " used for titles of all windows")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for Exec")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(PROMPTFONT LITTLEFONT)
|
||||
(* ; "for printing out prompts")
|
||||
(INPUTFONT BOLDFONT)
|
||||
(* ; "for user typein in Exec")
|
||||
(PRINTOUTFONT DEFAULTFONT)
|
||||
(* ; " for intermediate typin in Exec")
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
|
||||
(* ;; "Fonts for prettyprinting")
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(COMMENTFONT LITTLEFONT)
|
||||
(* ; "for comments ")
|
||||
(PRETTYCOMFONT BOLDFONT)
|
||||
(* ; " for words being defined")
|
||||
(CLISPFONT BOLDFONT)
|
||||
(* ; " for keywords & CLISP")
|
||||
(SYSTEMFONT DEFAULTFONT)
|
||||
(* ; " for %"system%" words(?)")
|
||||
(LAMBDAFONT BIGFONT)
|
||||
(* ; "for words being defined")
|
||||
(USERFONT BOLDFONT)
|
||||
(* ; " for %"user%" defined words")))
|
||||
|
||||
(MOVD? 'NILL 'WINDOWTITLEFONT)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTSET
|
||||
[LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds")
|
||||
(COND
|
||||
[NAME
|
||||
(LET
|
||||
[(TEM (FASSOC NAME FONTDEFS))
|
||||
(OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY]
|
||||
(OR TEM (ERROR NAME "not a defined font configuration"))
|
||||
|
||||
(* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.")
|
||||
|
||||
(for X in FONTVARS when (AND (CL:SYMBOLP (CAR X))
|
||||
(NEQ (CAR X)
|
||||
'*)
|
||||
(NEQ (CAR X)
|
||||
(CADR X))) do (SETTOPVAL (CAR X)))
|
||||
[MAPC (CDR TEM)
|
||||
(FUNCTION (LAMBDA (X)
|
||||
(/SETTOPVAL (CAR X)
|
||||
(CDR X]
|
||||
[PROG (BASICCLASSES)
|
||||
(for X in FONTPROFILE
|
||||
do (PROG (SEEN (NAME (CAR X))
|
||||
(FONTS X))
|
||||
LP [COND
|
||||
((MEMB (CAR FONTS)
|
||||
SEEN)
|
||||
(ERROR "Circular font profile specification" X))
|
||||
(T (push SEEN (CAR FONTS]
|
||||
[SETQ FONTS (CDR (COND
|
||||
((OR (NULL (CADR FONTS))
|
||||
(LISTP (CADR FONTS)))
|
||||
(*)
|
||||
(* ;
|
||||
"This skips over the now-defunct NIL or list-of-escape sequence")
|
||||
(CDR FONTS))
|
||||
(T FONTS]
|
||||
(COND
|
||||
((OR (NLISTP FONTS)
|
||||
(LITATOM (CAR FONTS)))(* ;
|
||||
"Indirect thru another's font spec")
|
||||
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
|
||||
((NIL DEFAULTFONT)
|
||||
(* ;
|
||||
"Don't let DEFAULTFONT loop thru itself")
|
||||
(AND (NOT (MEMB 'DEFAULTFONT SEEN
|
||||
))
|
||||
'DEFAULTFONT))
|
||||
(CAR FONTS))
|
||||
FONTPROFILE))
|
||||
(GO LP)))
|
||||
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS
|
||||
'DISPLAY]
|
||||
(* ;
|
||||
"Now we have a font class datastructure")
|
||||
))
|
||||
(AND NAME (/SETTOPVAL NAME FONTS))
|
||||
|
||||
(* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")
|
||||
|
||||
))
|
||||
(AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY]
|
||||
[for X in FONTVARS when (NEQ (CAR X)
|
||||
'*)
|
||||
do (COND
|
||||
((LISTP (CAR X))
|
||||
(EVAL (CAR X)))
|
||||
[(CADDR X)
|
||||
(SET (CAR X)
|
||||
(FONTCREATE (OR (GETTOPVAL (CAR X))
|
||||
(EVAL (CADR X))
|
||||
DEFAULTFONT)
|
||||
NIL NIL NIL 'DISPLAY]
|
||||
(T (OR (GETTOPVAL (CAR X))
|
||||
(AND (CADR X)
|
||||
(SET (CAR X)
|
||||
(EVAL (CADR X]
|
||||
(CL:WHEN CHANGE-WINDOWS?
|
||||
(CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY))
|
||||
(for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X))
|
||||
do (DSPFONT DEFAULTFONT X)))
|
||||
(DSPFONT WINDOWTITLEFONT WindowTitleDisplayStream)
|
||||
(SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT)))
|
||||
(MAPC CACHEDMENUS 'SET)
|
||||
[for W in (OPENWINDOWS) do [COND
|
||||
[(OR (EQ (WINDOWPROP W 'RESHAPEFN)
|
||||
'DONT)
|
||||
(WINDOWPROP W 'MAINWINDOW]
|
||||
(T
|
||||
(* ;;
|
||||
"don't reshape if can't or if this window is attached to another.")
|
||||
|
||||
(SHAPEW W (WINDOWREGION W]
|
||||
(COND
|
||||
((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
|
||||
(FUNCTION \TEDIT.PROCIDLEFN))
|
||||
(WINDOWPROP W 'REPAINTFN))
|
||||
(REDISPLAYW W])
|
||||
|
||||
(* ;; "Set the new font profile name, and return the old one, so he can restore later.")
|
||||
|
||||
(PROG1 FONTNAME (SETQ FONTNAME NAME]
|
||||
(T (* ;
|
||||
"He passed in NIL, so return font profile name in effect.")
|
||||
FONTNAME])
|
||||
|
||||
(FONTPROFILE
|
||||
[LAMBDA (PROFILE) (* lmm "10-Sep-86 12:33")
|
||||
[PROG (BASICCLASSES)
|
||||
(for X in PROFILE
|
||||
do (PROG (SEEN (NAME (CAR X))
|
||||
(FONTS X))
|
||||
LP [COND
|
||||
((MEMB (CAR FONTS)
|
||||
SEEN)
|
||||
(ERROR "Circular font profile specification" X))
|
||||
(T (push SEEN (CAR FONTS]
|
||||
[SETQ FONTS (CDR (COND
|
||||
((OR (NULL (CADR FONTS))
|
||||
(LISTP (CADR FONTS)))
|
||||
(* ;
|
||||
"This skips over the now-defunct NIL or list-of-escape sequence")
|
||||
(CDR FONTS))
|
||||
(T FONTS]
|
||||
(COND
|
||||
((OR (NLISTP FONTS)
|
||||
(LITATOM (CAR FONTS))) (* Indirect thru another's font spec)
|
||||
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
|
||||
((NIL DEFAULTFONT)
|
||||
(* Don't let DEFAULTFONT loop thru
|
||||
itself)
|
||||
(AND (NOT (MEMB 'DEFAULTFONT SEEN))
|
||||
'DEFAULTFONT))
|
||||
(CAR FONTS))
|
||||
PROFILE))
|
||||
(GO LP)))
|
||||
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY]
|
||||
(* Now we have a font class
|
||||
datastructure)
|
||||
))
|
||||
(AND NAME (/SETATOMVAL NAME FONTS))
|
||||
|
||||
(* NIL for the class-name means just establish the font-correspondences but
|
||||
don't connect them up with a pretty class name.)
|
||||
|
||||
))
|
||||
(AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY]
|
||||
T])
|
||||
|
||||
(FONTPROFILE.ADDDEVICE
|
||||
[LAMBDA (NEWDEVICE OLDDEVICE) (* ; "Edited 3-Mar-93 14:46 by rmk:")
|
||||
|
||||
(* ;; "Fills in all fontprofile specifications so that an entry for NEWDEVICE is present for each fontclass. Nothing is changed if the entry is already there, otherwise the specification for the class currently provided for OLDDEVICE will be used for NEWDEVICE.")
|
||||
|
||||
(DECLARE (USEDFREE FONTDEFS FONTNAME))
|
||||
(SETQ NEWDEVICE (U-CASE NEWDEVICE))
|
||||
(SETQ OLDDEVICE (U-CASE OLDDEVICE))
|
||||
[FOR FD IN FONTDEFS
|
||||
DO (FOR FC OLDSPEC IN (CDR (ASSOC 'FONTPROFILE (CDR FD)))
|
||||
UNLESS (LITATOM (CADR FC))
|
||||
DO (SETQ FC (CDR FC)) (* ; "Skip over name")
|
||||
(CL:WHEN [SETQ OLDSPEC (SELECTQ OLDDEVICE
|
||||
(DISPLAY (CADR FC))
|
||||
(INTERPRESS (CADDDR FC))
|
||||
(PRESS (CADDR FC))
|
||||
(CADR (ASSOC OLDDEVICE (CDDDDR FC]
|
||||
[SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
(* ;
|
||||
"Fill in NIL's for missing DISPLAY, PRESS, or INTERPRESS")
|
||||
[SELECTQ NEWDEVICE
|
||||
(DISPLAY (OR (CAR FC)
|
||||
(RPLACA FC OLDSPEC)))
|
||||
(INTERPRESS (OR (CADDR FC)
|
||||
(RPLACA [PROGN [SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
(OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
OLDSPEC)))
|
||||
(PRESS (OR (CADDR FC)
|
||||
(RPLACA [OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
OLDSPEC)))
|
||||
(OR (CADR (ASSOC NEWDEVICE (CDDDR FC)))
|
||||
(PROGN (PROGN [SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
[SETQ FC (OR (CDR FC)
|
||||
(CDR (RPLACD FC (CONS]
|
||||
(PUSH (CDR FC)
|
||||
(LIST NEWDEVICE OLDSPEC])]
|
||||
(FONTSET FONTNAME])
|
||||
)
|
||||
|
||||
(RPAQ? FONTESCAPECHAR (CHARACTER 6))
|
||||
|
||||
(RPAQ? FONTFNS )
|
||||
|
||||
(RPAQ? FONTWORDS )
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(FONTSET 'STANDARD)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS FONTPROFILE FONTESCAPECHAR FONTDEFS)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FONTMAPARRAY
|
||||
[LAMBDA (FONTCLASSES) (* lmm "28-Sep-86 14:23")
|
||||
|
||||
(* ;; "Makes a font array from a font-mapping list of fontclasses. The array provides a fast map from font# to font classes/descriptors. This function caches the last array. If IMAGETYPES is given, then the FD's are pre-computed for the imagetypes it. Otherwise, the first use of the fontclass for that imagetype would cause the fontcreate to be done.")
|
||||
|
||||
(PROG (FA (MAXFONT 0)
|
||||
(MINFONT 100))
|
||||
[COND
|
||||
((NULL \FONTMAPCACHE))
|
||||
((OR (NULL FONTCLASSES)
|
||||
(EQUAL FONTCLASSES (CAR \FONTMAPCACHE)))
|
||||
(RETURN (CDR \FONTMAPCACHE]
|
||||
[for F PRETTYFONT# in FONTCLASSES do (SETQ PRETTYFONT# (fetch (FONTCLASS
|
||||
PRETTYFONT#)
|
||||
of F))
|
||||
(COND
|
||||
((IGREATERP PRETTYFONT# MAXFONT)
|
||||
(SETQ MAXFONT PRETTYFONT#)))
|
||||
(COND
|
||||
((ILESSP PRETTYFONT# 1)
|
||||
(ERROR "Invalid font number"
|
||||
PRETTYFONT# F))
|
||||
((ILESSP PRETTYFONT# MINFONT)
|
||||
(SETQ MINFONT PRETTYFONT#]
|
||||
(SETQ FA (ARRAY MAXFONT))
|
||||
(for F in FONTCLASSES do (SETA FA (fetch (FONTCLASS PRETTYFONT#)
|
||||
of F)
|
||||
F))
|
||||
(for I from 1 to MAXFONT unless (ELT FA I)
|
||||
do (SETA FA I (ELT FA MINFONT)))
|
||||
(SETQ \FONTMAPCACHE (CONS (COPY FONTCLASSES)
|
||||
FA))
|
||||
(RETURN FA])
|
||||
)
|
||||
|
||||
(RPAQ? \FONTMAPCACHE )
|
||||
|
||||
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL)
|
||||
(PUTPROPS FONTPROFILEPATCH COPYRIGHT ("Xerox Corporation" 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (16158 27897 (FONTSET 16168 . 22509) (FONTPROFILE 22511 . 25015) (FONTPROFILE.ADDDEVICE
|
||||
25017 . 27895)) (28133 30403 (FONTMAPARRAY 28143 . 30401)))))
|
||||
STOP
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,7 +1,7 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 8-Aug-2021 00:19:22" ("compiled on "
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7) " 6-Aug-2021 20:53:08"
|
||||
"COMPILE-FILEd" in "FULL 6-Aug-2021 ..." dated " 6-Aug-2021 20:53:13")
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-Sep-2021 16:23:29" ("compiled on "
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;10) " 6-Sep-2021 15:59:15"
|
||||
"COMPILE-FILEd" in "FULL 6-Sep-2021 ..." dated " 6-Sep-2021 15:59:21")
|
||||
(FILECREATED " 8-Aug-2021 00:19:22" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7
|
||||
268927 changes to%: (FNS READBITMAP) previous date%: " 1-Aug-2021 23:41:37"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;6)
|
||||
@@ -120,18 +120,18 @@ NIL | ||||