Eliminate implicit calls to \FILEOUTCHARFN (#529)
* Eliminate implicit calls to \FILEOUTCHARFN Also, update DATE to modern readtable (don't know what it does), add LLETHER to EXPORTFILES in FILESETS (may also need the file that exports pup records). * Further fixups for EXPORTFILES also fixing/compiling PLAINTEXTSTREAM * Remove garbage files DATE and PLAINTEXTSTREAM from checkin Co-authored-by: Larry Masinter <LMM@acm.org>
This commit is contained in:
rmkaplan
GitHub
Binary file not shown.
Binary file not shown.
531
lispusers/DATE
531
lispusers/DATE
@@ -1,531 +0,0 @@
|
||||
(FILECREATED "18-Feb-87 15:42:27" {SUMEX-AIM}PS:<TMAX.SOURCES>DATE.;4 19668
|
||||
|
||||
previous date: "17-Feb-87 14:29:37" {SUMEX-AIM}<GILMURRAY.LISP>DATE.;7)
|
||||
|
||||
|
||||
(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT DATECOMS)
|
||||
|
||||
(RPAQQ DATECOMS ((* Developed under support from NIH grant RR-00785.)
|
||||
(* Written by Frank Gilmurray and Sami Shaio.)
|
||||
(FNS DATEOBJ DATEOBJP DATE.DISPLAYFN DATE.IMAGEBOXFN CURRENT.DISPLAY.FONT DATE.PUTFN
|
||||
DATE.GETFN DATE.BUTTONEVENTINFN DATES.TEMPLATE AMPM DATES.MENU.APPLY
|
||||
DATES.MENU.WHENSELECTEDFN DATES.SET FINDDAY FINDHOUR FINDMONTH FINDTIME FINDYEAR NUMP
|
||||
WHICHDATE)
|
||||
(RECORDS DATEOBJ STREAM FONTCLASS)))
|
||||
|
||||
|
||||
|
||||
(* Developed under support from NIH grant RR-00785.)
|
||||
|
||||
|
||||
|
||||
|
||||
(* Written by Frank Gilmurray and Sami Shaio.)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(DATEOBJ
|
||||
(LAMBDA (TEMPLATE) (* fsg "23-Jul-86 09:53")
|
||||
(* Create an instance of a date imageobj.
|
||||
A dateobj is also defined as a record with a
|
||||
datestring field. *)
|
||||
(LET* ((TEMPLATE.TYPE (OR TEMPLATE '(M D Y F)))
|
||||
(DATEANDTIME (MKSTRING (DATE)))
|
||||
(DISPLAYDATE (MKSTRING (DATES.TEMPLATE DATEANDTIME TEMPLATE.TYPE)))
|
||||
(NEWOBJ (IMAGEOBJCREATE (create DATEOBJ
|
||||
DATESTRING _ DATEANDTIME
|
||||
DISPLAY.DATE _ DISPLAYDATE
|
||||
TEMPLATE.DATE _ TEMPLATE.TYPE)
|
||||
(IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
|
||||
(FUNCTION DATE.IMAGEBOXFN)
|
||||
(FUNCTION DATE.PUTFN)
|
||||
(FUNCTION DATE.GETFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION DATE.BUTTONEVENTINFN)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)))))
|
||||
(* By convention, every image object will have a type
|
||||
property associated with it that will facilitate
|
||||
imageobj mapping in a TEdit file.)
|
||||
(IMAGEOBJPROP NEWOBJ 'TYPE
|
||||
'DATEOBJ)
|
||||
NEWOBJ)))
|
||||
|
||||
(DATEOBJP
|
||||
(LAMBDA (IMOBJ) (* ss: "24-Jun-85 16:33")
|
||||
|
||||
(* Tests an imageobj to see if it is a date imageobject. By convention, testing functions for an imageobject will
|
||||
be named (CONCAT <type of imageobj> "P"))
|
||||
|
||||
|
||||
(AND IMOBJ (EQ (IMAGEOBJPROP IMOBJ 'TYPE)
|
||||
'DATEOBJ))))
|
||||
|
||||
(DATE.DISPLAYFN
|
||||
(LAMBDA (OBJ STREAM STREAMTYPE HOSTSTREAM) (* fsg "17-Feb-87 09:28")
|
||||
|
||||
(* * Display function for date imageobjs.)
|
||||
|
||||
|
||||
(PRIN1 (fetch DISPLAY.DATE of (fetch OBJECTDATUM of OBJ))
|
||||
STREAM)))
|
||||
|
||||
(DATE.IMAGEBOXFN
|
||||
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* fsg "15-Feb-87 14:05")
|
||||
|
||||
(* * Return the ImageBox for the date string. The size is determined by the stream's current font.)
|
||||
|
||||
|
||||
(DSPFONT (CURRENT.DISPLAY.FONT STREAM)
|
||||
STREAM)
|
||||
(create IMAGEBOX
|
||||
XSIZE _(STRINGWIDTH (fetch DISPLAY.DATE of (fetch OBJECTDATUM of OBJ))
|
||||
STREAM)
|
||||
YSIZE _(FONTPROP STREAM 'HEIGHT)
|
||||
YDESC _(FONTPROP STREAM 'DESCENT)
|
||||
XKERN _ 0)))
|
||||
|
||||
(CURRENT.DISPLAY.FONT
|
||||
(LAMBDA (STREAM) (* fsg "17-Feb-87 10:19")
|
||||
|
||||
(* * Return the current font. This function is here instead of TMAX because the DATE code is also used in the
|
||||
LetterHead code.)
|
||||
|
||||
|
||||
(LET ((CURRENT.FONT (fetch CLFONT of (with TEXTSTREAM
|
||||
(TEXTSTREAM (CAR (fetch \WINDOW
|
||||
of TEXTOBJ)))
|
||||
CURRENTLOOKS))))
|
||||
(COND
|
||||
((TYPENAMEP CURRENT.FONT 'FONTDESCRIPTOR)
|
||||
CURRENT.FONT)
|
||||
((TYPENAMEP CURRENT.FONT 'FONTCLASS)
|
||||
(fetch DISPLAYFD of CURRENT.FONT))
|
||||
(T (SHOULDNT "Can't get current font"))))))
|
||||
|
||||
(DATE.PUTFN
|
||||
(LAMBDA (DATEOBJ STREAM) (* fsg " 4-Feb-87 09:40")
|
||||
(PRIN2 (LIST 'Date
|
||||
(fetch (DATEOBJ TEMPLATE.DATE) of (fetch OBJECTDATUM of DATEOBJ)))
|
||||
STREAM)))
|
||||
|
||||
(DATE.GETFN
|
||||
(LAMBDA (STREAM) (* fsg " 4-Feb-87 09:42")
|
||||
(OR (WINDOWPROP (PROCESSPROP (THIS.PROCESS)
|
||||
'WINDOW)
|
||||
'IMAGEOBJ.MENUW)
|
||||
(AND (FGETD 'TSP.FMMENU)
|
||||
(TSP.FMMENU (TEXTSTREAM (PROCESSPROP (THIS.PROCESS)
|
||||
'WINDOW)))))
|
||||
(APPLY 'DATEOBJ
|
||||
(CDR (READ STREAM)))))
|
||||
|
||||
(DATE.BUTTONEVENTINFN
|
||||
(LAMBDA (DATEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
|
||||
(* fsg "26-Jan-87 10:06")
|
||||
(AND (MOUSESTATE MIDDLE)
|
||||
(LET ((DATE.MENU (create MENU
|
||||
TITLE _ "Date Menu"
|
||||
ITEMS _ '((Month% Day,% Year (DATES.TEMPLATE DATE
|
||||
'(M D Y F))
|
||||
|
||||
"Insert current date as %"March 8, 1952%"")
|
||||
(Month/Day/Year (DATES.TEMPLATE DATE '(M D Y A))
|
||||
"Insert current date as %"3/8/52%"")
|
||||
(Day% Month,% Year (DATES.TEMPLATE DATE
|
||||
'(D M Y F))
|
||||
|
||||
"Insert current date as %"8 March, 1952%"")
|
||||
(Day/Month/Year (DATES.TEMPLATE DATE '(D M Y A))
|
||||
"Insert current date as %"8/3/52%"")
|
||||
(Time (DATES.TEMPLATE DATE '(T F))
|
||||
"Insert current time as %"four thirty p.m.%"")
|
||||
(Numbered% Time (DATES.TEMPLATE DATE '(T A))
|
||||
|
||||
"Insert current time as %"4:30 p.m.%"")
|
||||
(Military% Time (DATES.TEMPLATE DATE '(T E))
|
||||
"Insert current time as %"16:30%""))
|
||||
WHENSELECTEDFN _(FUNCTION DATES.MENU.WHENSELECTEDFN))))
|
||||
(PUTMENUPROP DATE.MENU 'IMAGEOBJ
|
||||
DATEOBJ)
|
||||
(MENU DATE.MENU)
|
||||
'CHANGED))))
|
||||
|
||||
(DATES.TEMPLATE
|
||||
(LAMBDA (DATE TEMPLATE) (* fsg "24-Jul-86 14:43")
|
||||
|
||||
(* * comment)
|
||||
|
||||
|
||||
(COND
|
||||
(TEMPLATE (LET ((VERSION (if (EQUAL (LAST TEMPLATE)
|
||||
'(A))
|
||||
then 'ABBREV
|
||||
else (if (EQUAL (LAST TEMPLATE)
|
||||
'(F))
|
||||
then 'FULL
|
||||
else 'EURO)))
|
||||
(FUNCLST '((D FINDDAY)
|
||||
(M FINDMONTH)
|
||||
(Y FINDYEAR))))
|
||||
(COND
|
||||
((EQ (CAR TEMPLATE)
|
||||
T)
|
||||
(FINDTIME DATE VERSION))
|
||||
(T (LET ((CH (if (EQ VERSION 'ABBREV)
|
||||
then "/"
|
||||
else " ")))
|
||||
(CONCAT (APPLY (CADR (ASSOC (CAR TEMPLATE)
|
||||
FUNCLST))
|
||||
(LIST DATE VERSION))
|
||||
CH
|
||||
(APPLY (CADR (ASSOC (CADR TEMPLATE)
|
||||
FUNCLST))
|
||||
(LIST DATE VERSION))
|
||||
(if (EQUAL CH " ")
|
||||
then ", "
|
||||
else CH)
|
||||
(APPLY (CADR (ASSOC (CADDR TEMPLATE)
|
||||
FUNCLST))
|
||||
(LIST DATE VERSION))))))))
|
||||
(DATE))))
|
||||
|
||||
(AMPM
|
||||
(LAMBDA (HOUR)
|
||||
(if (OR (LESSP (MKATOM HOUR)
|
||||
12)
|
||||
(EQUAL (MKATOM HOUR)
|
||||
24))
|
||||
then "a.m."
|
||||
else "p.m.")))
|
||||
|
||||
(DATES.MENU.APPLY
|
||||
(LAMBDA (ITEM MENU) (* fsg "31-Jul-86 10:18")
|
||||
|
||||
(* This function serves the purpose of calculating the stream and the editing window from information stored on the
|
||||
window containing the menu. It then applies the appropiate function for each ITEM in the menu*)
|
||||
|
||||
|
||||
(SETQ ITEM (COND
|
||||
((ATOM ITEM)
|
||||
ITEM)
|
||||
(T (CAR ITEM))))
|
||||
(LET* ((DATE.RECORD (fetch OBJECTDATUM of (GETMENUPROP MENU 'IMAGEOBJ)))
|
||||
(DATE (fetch DATESTRING of DATE.RECORD)))
|
||||
(COND
|
||||
((fetch ITEMS of MENU)
|
||||
(LET ((FUNCALL (CADR (ASSOC ITEM (fetch ITEMS of MENU)))))
|
||||
(replace DISPLAY.DATE of DATE.RECORD with (EVAL FUNCALL))
|
||||
(replace TEMPLATE.DATE of DATE.RECORD with (CADAR (LAST FUNCALL)))))))))
|
||||
|
||||
(DATES.MENU.WHENSELECTEDFN
|
||||
(LAMBDA (ITEM MENU MB) (* fsg "28-Jul-86 14:57")
|
||||
(COND
|
||||
((OR (EQ MB 'LEFT)
|
||||
(EQ MB 'MIDDLE))
|
||||
(DATES.MENU.APPLY ITEM MENU)))))
|
||||
|
||||
(DATES.SET
|
||||
(LAMBDA (PROPERTY VALUE)
|
||||
(WINDOWPROP (CREATEW)
|
||||
PROPERTY VALUE)
|
||||
VALUE))
|
||||
|
||||
(FINDDAY
|
||||
(LAMBDA (OLDDATE VERSION) (* shw: " 1-Jul-85 11:28")
|
||||
(MKATOM (if (NUMP (SUBSTRING OLDDATE 1 2))
|
||||
then (SUBSTRING OLDDATE 1 2)
|
||||
else (SUBSTRING OLDDATE 2 2)))))
|
||||
|
||||
(FINDHOUR
|
||||
(LAMBDA (HOUR) (* ss: " 8-Feb-86 17:49")
|
||||
(COND
|
||||
((LESSP (MKATOM HOUR)
|
||||
13)
|
||||
(COND
|
||||
((LESSP (MKATOM HOUR)
|
||||
10)
|
||||
(MKSTRING (CADR (UNPACK HOUR))))
|
||||
(T HOUR)))
|
||||
(T (MKSTRING (SELECTQ (MKATOM HOUR)
|
||||
(13 1)
|
||||
(14 2)
|
||||
(15 3)
|
||||
(16 4)
|
||||
(17 5)
|
||||
(18 6)
|
||||
(19 7)
|
||||
(20 8)
|
||||
(21 9)
|
||||
(22 10)
|
||||
(23 11)
|
||||
(24 12)
|
||||
NIL))))))
|
||||
|
||||
(FINDMONTH
|
||||
(LAMBDA (OLDDATE VERSION) (* shw: " 1-Jul-85 11:38")
|
||||
(PROG ((DATES '((Jan 1 January)
|
||||
(Feb 2 February)
|
||||
(Mar 3 March)
|
||||
(Apr 4 April)
|
||||
(May 5 May)
|
||||
(Jun 6 June)
|
||||
(Jul 7 July)
|
||||
(Aug 8 August)
|
||||
(Sep 9 September)
|
||||
(Oct 10 October)
|
||||
(Nov 11 November)
|
||||
(Dec 12 December)))
|
||||
(OUTPUT NIL))
|
||||
(if (EQ VERSION 'ABBREV)
|
||||
then (SETQ OUTPUT (CAR (CDR (ASSOC (MKATOM (SUBSTRING OLDDATE 4 6))
|
||||
DATES))))
|
||||
else (SETQ OUTPUT (CAR (CDDR (ASSOC (MKATOM (SUBSTRING OLDDATE 4 6))
|
||||
DATES)))))
|
||||
(RETURN OUTPUT))))
|
||||
|
||||
(FINDTIME
|
||||
(LAMBDA (OLDDATE VERSION) (* shw: "24-Jul-85 15:39")
|
||||
(LET ((HOUR (SUBSTRING OLDDATE 11 12))
|
||||
(MINUTES (SUBSTRING OLDDATE 14 15)))
|
||||
(if (EQUAL VERSION 'ABBREV)
|
||||
then (CONCAT (FINDHOUR HOUR)
|
||||
":" MINUTES " " (AMPM HOUR))
|
||||
else (if (EQUAL VERSION 'EURO)
|
||||
then (SUBSTRING OLDDATE 11 15)
|
||||
else (CONCAT (SELECTQ (if (LESSP (MKATOM MINUTES)
|
||||
46)
|
||||
then (MKATOM (FINDHOUR HOUR))
|
||||
else (PLUS 1 (MKATOM (FINDHOUR HOUR))))
|
||||
(1 "one")
|
||||
(2 "two")
|
||||
(3 "three")
|
||||
(4 "four")
|
||||
(5 "five")
|
||||
(6 "six")
|
||||
(7 "seven")
|
||||
(8 "eight")
|
||||
(9 "nine")
|
||||
(10 "ten")
|
||||
(11 "eleven")
|
||||
(12 "twelve")
|
||||
NIL)
|
||||
" "
|
||||
(if (AND (GREATERP (MKATOM MINUTES)
|
||||
15)
|
||||
(LESSP (MKATOM MINUTES)
|
||||
45))
|
||||
then "thirty"
|
||||
else "o'clock")
|
||||
" "
|
||||
(if (AND (GREATERP (MKATOM MINUTES)
|
||||
44)
|
||||
(EQUAL (FINDHOUR HOUR)
|
||||
"11"))
|
||||
then (if (EQUAL (AMPM HOUR)
|
||||
"a.m.")
|
||||
then "p.m."
|
||||
else "a.m.")
|
||||
else (AMPM HOUR))))))))
|
||||
|
||||
(FINDYEAR
|
||||
(LAMBDA (OLDDATE VERSION) (* shw: " 1-Jul-85 11:31")
|
||||
(if (EQ VERSION 'ABBREV)
|
||||
then (MKATOM (SUBSTRING OLDDATE 8 9))
|
||||
else (MKATOM (CONCAT "19" (SUBSTRING OLDDATE 8 9))))))
|
||||
|
||||
(NUMP
|
||||
(LAMBDA (N) (* edited: " 4-Apr-86 17:55")
|
||||
(* changed)
|
||||
(NOT (NULL (NUMBERP (MKATOM N))))))
|
||||
|
||||
(WHICHDATE
|
||||
(LAMBDA (VAR1 VAR2 YEAR OLDDATE VERSION) (* edited " 1-Jan-00 00:00")
|
||||
|
||||
(* * comment)
|
||||
|
||||
|
||||
(PROG (DIVIDER)
|
||||
(SETQ DIVIDER (if (EQ VERSION 'ABBREV)
|
||||
then "/"
|
||||
else " "))
|
||||
(RETURN (MKATOM (CONCAT (APPLY VAR1 (LIST OLDDATE VERSION))
|
||||
DIVIDER
|
||||
(APPLY VAR2 (LIST OLDDATE VERSION))
|
||||
DIVIDER
|
||||
(APPLY YEAR (LIST OLDDATE VERSION))))))))
|
||||
)
|
||||
[DECLARE: EVAL@COMPILE
|
||||
|
||||
(RECORD DATEOBJ (DATESTRING DISPLAY.DATE TEMPLATE.DATE))
|
||||
|
||||
(DATATYPE STREAM ( (* First 4 words are fixed for BIN, BOUT opcodes.
|
||||
Length of whole datatype is multiple of 4, so
|
||||
quad-aligned)
|
||||
(COFFSET WORD) (* Offset in CPPTR of next bin or bout)
|
||||
(CBUFSIZE WORD) (* Offset past last byte in that buffer)
|
||||
(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)
|
||||
(NIL BITS 5)
|
||||
(CBUFPTR POINTER) (* Pointer to current buffer)
|
||||
(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...)
|
||||
(USERVISIBLE FLAG) (* Listed by OPENP; NIL for terminal, dribble ...)
|
||||
(ACCESSBITS BITS 3) (* What kind of access file is open for
|
||||
(read, write, append))
|
||||
(FULLFILENAME POINTER) (* Name by which file is known to user)
|
||||
(DEVICE POINTER) (* FDEV of this guy)
|
||||
(VALIDATION POINTER) (* A number somehow identifying file, used to
|
||||
determine if file has changed in our absence)
|
||||
(EPAGE WORD)
|
||||
(EOFFSET WORD) (* Page, byte offset of eof)
|
||||
(* Following are device-specific fields)
|
||||
(F1 POINTER)
|
||||
(F2 POINTER)
|
||||
(F3 POINTER)
|
||||
(F4 POINTER)
|
||||
(F5 POINTER)
|
||||
(FW6 WORD)
|
||||
(FW7 WORD) (* Following only filled in for open streams)
|
||||
(BYTESIZE BYTE)
|
||||
(BUFFS POINTER)
|
||||
(CPAGE WORD)
|
||||
(FW8 WORD)
|
||||
(MAXBUFFERS WORD)
|
||||
(CHARPOSITION WORD) (* Used by POSITION etc.)
|
||||
(DIRTYBITS WORD)
|
||||
(LINELENGTH WORD)
|
||||
(EOLCONVENTION BITS 2) (* End-of-line convention)
|
||||
(CBUFDIRTY FLAG)
|
||||
(NIL BITS 5)
|
||||
(OUTCHARFN POINTER)
|
||||
(ENDOFSTREAMOP POINTER) (* For use of applications programs, not devices)
|
||||
(OTHERPROPS POINTER)
|
||||
(IMAGEOPS POINTER) (* Image operations vector)
|
||||
(IMAGEDATA POINTER) (* Image instance variables--format depends on
|
||||
IMAGEOPS value)
|
||||
(EXTRASTREAMOP POINTER)
|
||||
(STRMBINFN POINTER) (* Either the BIN fn from the FDEV, or a trap)
|
||||
(STRMBOUTFN POINTER) (* Either the BIN fn from the FDEV, or a trap)
|
||||
(CBUFMAXSIZE WORD)
|
||||
(FW9 WORD)
|
||||
(F10 POINTER) (* the current character set for this stream.
|
||||
gbn 4-2-85)
|
||||
(CHARSET BYTE))
|
||||
(BLOCKRECORD STREAM ((NIL 2 WORD)
|
||||
(UCODEFLAGS BYTE)
|
||||
(NIL POINTER)))
|
||||
(ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
|
||||
(FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM)
|
||||
DATUM))
|
||||
(NAMEDP (AND (fetch (STREAM FULLFILENAME) of DATUM)
|
||||
T))))
|
||||
(SYNONYM CBUFPTR (CPPTR))
|
||||
USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ NoBits BUFFS _ NIL BYTESIZE _ 8
|
||||
CBUFPTR _ NIL MAXBUFFERS _(PROGN (DECLARE (GLOBALVARS
|
||||
\STREAM.DEFAULT.MAXBUFFERS))
|
||||
\STREAM.DEFAULT.MAXBUFFERS)
|
||||
CHARPOSITION _ 0 LINELENGTH _(PROGN (DECLARE (GLOBALVARS FILELINELENGTH))
|
||||
FILELINELENGTH)
|
||||
OUTCHARFN _(FUNCTION \FILEOUTCHARFN)
|
||||
ENDOFSTREAMOP _(FUNCTION \EOSERROR)
|
||||
IMAGEOPS _ \NOIMAGEOPS EOLCONVENTION _(SELECTQ (SYSTEMTYPE)
|
||||
(D CR.EOLC)
|
||||
(VAX LF.EOLC)
|
||||
(JERICHO CRLF.EOLC)
|
||||
CR.EOLC)
|
||||
STRMBINFN _(FUNCTION \STREAM.NOT.OPEN)
|
||||
STRMBOUTFN _(FUNCTION \STREAM.NOT.OPEN))
|
||||
|
||||
(DATATYPE FONTCLASS ((PRETTYFONT# BYTE)
|
||||
DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
|
||||
]
|
||||
(/DECLAREDATATYPE 'STREAM
|
||||
'(WORD WORD FLAG FLAG FLAG (BITS 5)
|
||||
POINTER FLAG FLAG FLAG FLAG FLAG (BITS 3)
|
||||
POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER
|
||||
WORD WORD BYTE POINTER WORD WORD WORD WORD WORD WORD (BITS 2)
|
||||
FLAG
|
||||
(BITS 5)
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD
|
||||
POINTER BYTE)
|
||||
'((STREAM 0 (BITS . 15))
|
||||
(STREAM 1 (BITS . 15))
|
||||
(STREAM 2 (FLAGBITS . 0))
|
||||
(STREAM 2 (FLAGBITS . 16))
|
||||
(STREAM 2 (FLAGBITS . 32))
|
||||
(STREAM 2 (BITS . 52))
|
||||
(STREAM 2 POINTER)
|
||||
(STREAM 4 (FLAGBITS . 0))
|
||||
(STREAM 4 (FLAGBITS . 16))
|
||||
(STREAM 4 (FLAGBITS . 32))
|
||||
(STREAM 4 (FLAGBITS . 48))
|
||||
(STREAM 4 (FLAGBITS . 64))
|
||||
(STREAM 4 (BITS . 82))
|
||||
(STREAM 4 POINTER)
|
||||
(STREAM 6 POINTER)
|
||||
(STREAM 8 POINTER)
|
||||
(STREAM 10 (BITS . 15))
|
||||
(STREAM 11 (BITS . 15))
|
||||
(STREAM 12 POINTER)
|
||||
(STREAM 14 POINTER)
|
||||
(STREAM 16 POINTER)
|
||||
(STREAM 18 POINTER)
|
||||
(STREAM 20 POINTER)
|
||||
(STREAM 22 (BITS . 15))
|
||||
(STREAM 23 (BITS . 15))
|
||||
(STREAM 20 (BITS . 7))
|
||||
(STREAM 24 POINTER)
|
||||
(STREAM 26 (BITS . 15))
|
||||
(STREAM 27 (BITS . 15))
|
||||
(STREAM 28 (BITS . 15))
|
||||
(STREAM 29 (BITS . 15))
|
||||
(STREAM 30 (BITS . 15))
|
||||
(STREAM 31 (BITS . 15))
|
||||
(STREAM 24 (BITS . 1))
|
||||
(STREAM 24 (FLAGBITS . 32))
|
||||
(STREAM 24 (BITS . 52))
|
||||
(STREAM 32 POINTER)
|
||||
(STREAM 34 POINTER)
|
||||
(STREAM 36 POINTER)
|
||||
(STREAM 38 POINTER)
|
||||
(STREAM 40 POINTER)
|
||||
(STREAM 42 POINTER)
|
||||
(STREAM 44 POINTER)
|
||||
(STREAM 46 POINTER)
|
||||
(STREAM 48 (BITS . 15))
|
||||
(STREAM 49 (BITS . 15))
|
||||
(STREAM 50 POINTER)
|
||||
(STREAM 50 (BITS . 7)))
|
||||
'52)
|
||||
(/DECLAREDATATYPE 'FONTCLASS
|
||||
'(BYTE POINTER POINTER POINTER POINTER POINTER)
|
||||
'((FONTCLASS 0 (BITS . 7))
|
||||
(FONTCLASS 0 POINTER)
|
||||
(FONTCLASS 2 POINTER)
|
||||
(FONTCLASS 4 POINTER)
|
||||
(FONTCLASS 6 POINTER)
|
||||
(FONTCLASS 8 POINTER))
|
||||
'10)
|
||||
(PUTPROPS DATE COPYRIGHT ("Leland Stanford Junior University" 1987))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (850 12872 (DATEOBJ 862 . 2359) (DATEOBJP 2363 . 2736) (DATE.DISPLAYFN 2740 . 3015) (
|
||||
DATE.IMAGEBOXFN 3019 . 3575) (CURRENT.DISPLAY.FONT 3579 . 4284) (DATE.PUTFN 4288 . 4541) (DATE.GETFN
|
||||
4545 . 4956) (DATE.BUTTONEVENTINFN 4960 . 6275) (DATES.TEMPLATE 6279 . 7439) (AMPM 7443 . 7615) (
|
||||
DATES.MENU.APPLY 7619 . 8538) (DATES.MENU.WHENSELECTEDFN 8542 . 8780) (DATES.SET 8784 . 8895) (FINDDAY
|
||||
8899 . 9154) (FINDHOUR 9158 . 9662) (FINDMONTH 9666 . 10427) (FINDTIME 10431 . 11846) (FINDYEAR 11850
|
||||
. 12124) (NUMP 12128 . 12368) (WHICHDATE 12372 . 12869)))))
|
||||
STOP
|
||||
@@ -1,282 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "15-Jan-98 09:49:00" {DSK}<project>medley2.0>lispusers>PLAINTEXTSTREAM.;48 16624
|
||||
|
||||
changes to%: (FNS WRITEPLAINTEXTPAGE PLAINTEXTOUTCHARFN OPENPLAINTEXTSTREAM CLEARPLAINTEXTPAGE
|
||||
MAKEPLAINTEXTPAGE)
|
||||
(MACROS PLAINTEXTPARAM)
|
||||
(VARS PLAINTEXTSTREAMCOMS)
|
||||
(RECORDS PLAINTEXTIMAGEDATA)
|
||||
|
||||
previous date%: "11-Jan-98 23:04:10" {DSK}<project>medley2.0>lispusers>PLAINTEXTSTREAM.;29)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1998 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PLAINTEXTSTREAMCOMS)
|
||||
|
||||
(RPAQQ PLAINTEXTSTREAMCOMS
|
||||
[(ADDVARS (DEFAULTFILETYPELIST (PLAINTEXT . TEXT)
|
||||
(PT . TEXT)))
|
||||
(FNS OPENPLAINTEXTSTREAM PLAINTEXTOUTCHARFN PLAINTEXT.TEDIT PLAINTEXT.TEXT)
|
||||
(FNS WRITEPLAINTEXTPAGE)
|
||||
(MACROS PLAINTEXTPARAM)
|
||||
(RECORDS PLAINTEXTIMAGEDATA)
|
||||
[ADDVARS [PRINTFILETYPES (PLAINTEXT (EXTENSION (PT PLAINTEXT]
|
||||
(IMAGESTREAMTYPES (PLAINTEXT (OPENSTREAM OPENPLAINTEXTSTREAM)
|
||||
(FONTCREATE \CREATEDISPLAYFONT)
|
||||
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY]
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P [OR (RECLOOK 'STREAM)
|
||||
(EVAL (SYSRECLOOK1 'STREAM]
|
||||
(OR (RECLOOK 'IMAGEOPS)
|
||||
(EVAL (SYSRECLOOK1 'IMAGEOPS])
|
||||
|
||||
(ADDTOVAR DEFAULTFILETYPELIST (PLAINTEXT . TEXT)
|
||||
(PT . TEXT))
|
||||
(DEFINEQ
|
||||
|
||||
(OPENPLAINTEXTSTREAM
|
||||
[LAMBDA (FILE OPTIONS) (* ; "Edited 15-Jan-98 00:04 by rmk:")
|
||||
|
||||
(* ;; "Assert that scale is one, so that display fonts etc. can be used.")
|
||||
|
||||
(LET [(STREAM (OPENSTREAM FILE 'OUTPUT NIL '((SEQUENTIAL T]
|
||||
(REPLACE (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION PLAINTEXTOUTCHARFN))
|
||||
[REPLACE (STREAM IMAGEDATA) OF STREAM
|
||||
WITH (CREATE PLAINTEXTIMAGEDATA
|
||||
PTPAGE _ (CL:MAKE-ARRAY (ADD1 (TIMES 72 11))
|
||||
:INITIAL-ELEMENT NIL)
|
||||
PTXPOSITION _ 0
|
||||
PTYPOSITION _ (TIMES 72 11)
|
||||
PTRIGHTMARGIN _ (FIX (TIMES 8.5 72))
|
||||
PTLEFTMARGIN _ 0
|
||||
PTCLIPPINGREGION _ (CREATE REGION
|
||||
LEFT _ 0
|
||||
BOTTOM _ 0
|
||||
WIDTH _ (FIX (TIMES 8.5 72))
|
||||
HEIGHT _ (TIMES 72 11]
|
||||
[REPLACE (STREAM IMAGEOPS) OF STREAM
|
||||
WITH (CREATE IMAGEOPS USING (FETCH (STREAM IMAGEOPS) OF STREAM)
|
||||
IMAGETYPE _ 'PLAINTEXT IMFONT _
|
||||
[FUNCTION (LAMBDA (STREAM FONT)
|
||||
(CL:WHEN FONT
|
||||
[PLAINTEXTPARAM
|
||||
PTLINEFEED
|
||||
(IMINUS (FONTPROP FONT 'HEIGHT])
|
||||
(PLAINTEXTPARAM PTFONT FONT]
|
||||
IMCLIPPINGREGION _
|
||||
[FUNCTION (LAMBDA (STREAM REGION)
|
||||
(CL:WHEN (AND REGION
|
||||
(NOT (TYPE? REGION
|
||||
REGION)))
|
||||
(\ILLEGAL.ARG REGION))
|
||||
(PLAINTEXTPARAM PTCLIPPINGREGION REGION]
|
||||
IMXPOSITION _ [FUNCTION (LAMBDA (STREAM POS)
|
||||
(PLAINTEXTPARAM PTXPOSITION
|
||||
POS T]
|
||||
IMYPOSITION _ [FUNCTION (LAMBDA (STREAM POS)
|
||||
(PLAINTEXTPARAM PTYPOSITION
|
||||
POS T]
|
||||
IMMOVETO _ [FUNCTION (LAMBDA (STREAM X Y)
|
||||
(PLAINTEXTPARAM PTXPOSITION X
|
||||
T)
|
||||
(PLAINTEXTPARAM PTYPOSITION Y
|
||||
T]
|
||||
IMLEFTMARGIN _ [FUNCTION (LAMBDA (STREAM M)
|
||||
(PLAINTEXTPARAM
|
||||
PTLEFTMARGIN M T]
|
||||
IMRIGHTMARGIN _ [FUNCTION (LAMBDA (STREAM M)
|
||||
(PLAINTEXTPARAM
|
||||
PTRIGHTMARGIN M T]
|
||||
IMLINEFEED _ [FUNCTION (LAMBDA (STREAM DY)
|
||||
(PLAINTEXTPARAM PTLINEFEED
|
||||
DY T]
|
||||
IMSPACEFACTOR _ [FUNCTION (LAMBDA NIL 1]
|
||||
IMFONTCREATE _ 'DISPLAY IMSTRINGWIDTH _
|
||||
[FUNCTION (LAMBDA (STREAM STR RDTBL)
|
||||
(STRINGWIDTH STR
|
||||
(FETCH PTFONT
|
||||
OF (FETCH (STREAM
|
||||
IMAGEDATA)
|
||||
OF STREAM))
|
||||
RDTBL RDTBL]
|
||||
IMCHARWIDTH _ [FUNCTION (LAMBDA (STREAM CHARCODE)
|
||||
(CHARWIDTH
|
||||
CHARCODE
|
||||
(FETCH PTFONT
|
||||
OF
|
||||
(FETCH (STREAM
|
||||
IMAGEDATA)
|
||||
OF STREAM]
|
||||
IMCLOSEFN _ (FUNCTION WRITEPLAINTEXTPAGE)
|
||||
IMCHARSET _ [FUNCTION (LAMBDA (STREAM CHARSET)
|
||||
|
||||
(* ;; "If we had another illegal character set value, then we could simply fix it so that the character set didn't match anything, which would cause the character set shift to be put out on the next character")
|
||||
|
||||
(COND
|
||||
((\IOMODEP STREAM
|
||||
'OUTPUT T)
|
||||
(\BOUT STREAM
|
||||
NSCHARSETSHIFT)
|
||||
(COND
|
||||
((EQ CHARSET T)
|
||||
(\BOUT STREAM
|
||||
NSCHARSETSHIFT
|
||||
)
|
||||
(\BOUT STREAM 0))
|
||||
(T (\BOUT STREAM
|
||||
CHARSET]
|
||||
IMDRAWPOLYGON _ (FUNCTION NILL)
|
||||
IMDRAWPOINT _ (FUNCTION NILL)
|
||||
IMSCALE _ (FUNCTION (LAMBDA NIL 1]
|
||||
(DSPFONT '(GACHA 10)
|
||||
STREAM)
|
||||
STREAM])
|
||||
|
||||
(PLAINTEXTOUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE) (* ; "Edited 15-Jan-98 00:06 by rmk:")
|
||||
|
||||
(* ;; "Put character data in PAGE entry indexed by current yposition")
|
||||
|
||||
(LET ((IMDATA (FETCH IMAGEDATA OF STREAM)))
|
||||
(SELCHARQ CHARCODE
|
||||
(CR
|
||||
(* ;; "Set parameters but don't output--that means we can do lots of moving around, up and down, and still come out OK.")
|
||||
|
||||
(REPLACE PTXPOSITION OF IMDATA WITH 0)
|
||||
(ADD (FETCH PTYPOSITION OF IMDATA)
|
||||
(FETCH PTLINEFEED OF IMDATA)))
|
||||
(FORM (WRITEPLAINTEXTPAGE STREAM)
|
||||
(BOUT STREAM (CHARCODE FORM))
|
||||
(REPLACE PTXPOSITION OF IMDATA WITH 0)
|
||||
(REPLACE PTYPOSITION OF IMDATA WITH (TIMES 72 11)))
|
||||
(LF (ADD (FETCH PTYPOSITION OF IMDATA)
|
||||
(FETCH PTLINEFEED OF IMDATA)))
|
||||
(CL:PUSH [LIST (FETCH PTXPOSITION OF IMDATA)
|
||||
CHARCODE
|
||||
(ADD (FETCH PTXPOSITION OF IMDATA)
|
||||
(CHARWIDTH CHARCODE (FETCH PTFONT OF IMDATA]
|
||||
(CL:SVREF (FETCH PTPAGE OF IMDATA)
|
||||
(FETCH PTYPOSITION OF IMDATA])
|
||||
|
||||
(PLAINTEXT.TEDIT
|
||||
[LAMBDA (FILE PTFILE) (* ; "Edited 8-Jan-98 06:17 by rmk:")
|
||||
(* ; "Edited 18-Sep-91 18:16 by jds")
|
||||
|
||||
(* ;; "Make a plaintext file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.")
|
||||
|
||||
[COND
|
||||
((STRINGP FILE)
|
||||
(SETQ FILE (MKATOM FILE]
|
||||
(SETQ FILE (OPENTEXTSTREAM FILE))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PTFILE T NIL NIL NIL 'PLAINTEXT)
|
||||
PTFILE])
|
||||
|
||||
(PLAINTEXT.TEXT
|
||||
[LAMBDA (FILE PTFILE FONTS HEADING TABS) (* ; "Edited 8-Jan-98 06:20 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"The effect of this should be to throw away font change characters and coerce characters to ISO8859")
|
||||
|
||||
(TEXTTOIMAGEFILE FILE PTFILE 'PLAINTEXT FONTS HEADING TABS])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(WRITEPLAINTEXTPAGE
|
||||
[LAMBDA (STREAM) (* ; "Edited 15-Jan-98 09:48 by rmk:")
|
||||
(LET [(PAGE (FETCH PTPAGE OF (FETCH IMAGEDATA OF STREAM]
|
||||
|
||||
(* ;;
|
||||
"Have to run through y-positions indexed backwards, since have to print higher positions first.")
|
||||
|
||||
(FOR YPOS LINE LASTYPOS DIFF (DLF _ (FONTPROP DEFAULTFONT 'HEIGHT))
|
||||
(DSP _ (CHARWIDTH (CHARCODE SPACE)
|
||||
DEFAULTFONT)) FROM (SUB1 (CL:ARRAY-DIMENSION PAGE 0)) TO 0
|
||||
BY -1 FIRST (SETQ LASTYPOS YPOS) WHEN (SETQ LINE (CL:SVREF PAGE YPOS))
|
||||
DO (SETQ DIFF (- LASTYPOS YPOS))
|
||||
(CL:WHEN (IGREATERP DIFF DLF) (* ; "Distance is more than a line")
|
||||
|
||||
(* ;;
|
||||
"Start at 2 because one was already put out at the end of the previous line")
|
||||
|
||||
(FOR I FROM 2 TO (IQUOTIENT DIFF DLF)
|
||||
DO (BOUT STREAM (CHARCODE CR))))
|
||||
(SORT LINE T) (* ; "To print from left to right")
|
||||
(FOR C (LASTX _ 0) IN LINE
|
||||
DO (SETQ DIFF (- (POP C)
|
||||
LASTX))
|
||||
(CL:WHEN (IGREATERP DIFF DSP) (* ; "Distance is more than a space")
|
||||
(FOR I FROM 1 TO (IQUOTIENT DIFF DLF)
|
||||
DO (BOUT STREAM (CHARCODE SPACE))))
|
||||
[IF (ILEQ (CAR C)
|
||||
127)
|
||||
THEN (BOUT STREAM (CAR C))
|
||||
ELSE
|
||||
|
||||
(* ;; "Should coerce to ISO8859. If get something below 256, use it. Otherwise, try to print charactername")
|
||||
|
||||
(LET (STRING)
|
||||
(SETQ STRING (SELCHARQ (CAR C)
|
||||
(phi "phi")
|
||||
(MEMBEROF "memb")
|
||||
(UC-SIGMA "Sigma")
|
||||
(46,123 "Pi")
|
||||
(357,147 "o")
|
||||
NIL))
|
||||
(IF STRING
|
||||
THEN (BOUT STREAM (CHARCODE \))
|
||||
(FOR I C FROM 1
|
||||
WHILE (SETQ C (NTHCHARCODE STRING I))
|
||||
DO (BOUT STREAM C))
|
||||
(BOUT STREAM (CHARCODE \))
|
||||
ELSE (BOUT STREAM (CHARCODE ~]
|
||||
(SETQ LASTX (CADR C)))
|
||||
(\FILEOUTCHARFN STREAM (CHARCODE CR))
|
||||
(SETQ LASTYPOS YPOS)
|
||||
|
||||
(* ;; "Now clear the entry")
|
||||
|
||||
(CL:SETF (CL:SVREF PAGE YPOS)
|
||||
NIL])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PLAINTEXTPARAM MACRO
|
||||
[(PNAME PVAL NUMBERPFLAG)
|
||||
(PROG1 (FETCH PNAME OF (FETCH (STREAM IMAGEDATA) OF STREAM))
|
||||
[LET ((PV PVAL))
|
||||
(CL:WHEN PV
|
||||
(REPLACE PNAME OF (FETCH (STREAM IMAGEDATA) OF STREAM)
|
||||
WITH (COND
|
||||
('NUMBERPFLAG (OR (NUMBERP PV)
|
||||
(\ILLEGAL.ARG PV)))
|
||||
(T PV))))])])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD PLAINTEXTIMAGEDATA (PTPAGE PTXPOSITION PTYPOSITION PTFONT PTLINEFEED PTRIGHTMARGIN
|
||||
PTLEFTMARGIN PTCLIPPINGREGION))
|
||||
)
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (PLAINTEXT (EXTENSION (PT PLAINTEXT))))
|
||||
|
||||
(ADDTOVAR IMAGESTREAMTYPES (PLAINTEXT (OPENSTREAM OPENPLAINTEXTSTREAM)
|
||||
(FONTCREATE \CREATEDISPLAYFONT)
|
||||
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
|
||||
(CREATECHARSET \CREATECHARSET.DISPLAY)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
[OR (RECLOOK 'STREAM)
|
||||
(EVAL (SYSRECLOOK1 'STREAM]
|
||||
|
||||
[OR (RECLOOK 'IMAGEOPS)
|
||||
(EVAL (SYSRECLOOK1 'IMAGEOPS]
|
||||
)
|
||||
(PUTPROPS PLAINTEXTSTREAM COPYRIGHT ("Xerox Corporation" 1998))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1746 11976 (OPENPLAINTEXTSTREAM 1756 . 9644) (PLAINTEXTOUTCHARFN 9646 . 11087) (
|
||||
PLAINTEXT.TEDIT 11089 . 11661) (PLAINTEXT.TEXT 11663 . 11974)) (11977 15294 (WRITEPLAINTEXTPAGE 11987
|
||||
. 15292)))))
|
||||
STOP
|
||||
BIN
sources/BSP.LCOM
BIN
sources/BSP.LCOM
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Oct-2021 16:06:59"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;17 6482
|
||||
(FILECREATED "17-Oct-2021 13:52:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;15 6457
|
||||
|
||||
changes to%: (VARS EXPORTFILES)
|
||||
|
||||
previous date%: "17-Oct-2021 13:52:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;16)
|
||||
previous date%: "17-Oct-2021 12:43:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;14)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -72,8 +72,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
|
||||
(MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR
|
||||
LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
|
||||
ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER
|
||||
IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS
|
||||
DTDECLARE))
|
||||
IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS))
|
||||
|
||||
(RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW))
|
||||
|
||||
|
||||
102
sources/JAPANESE
102
sources/JAPANESE
@@ -1,18 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 8-Aug-2021 13:28:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17 62025
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN)
|
||||
(FILECREATED "17-Oct-2021 13:54:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;18 61702
|
||||
|
||||
previous date%: " 6-Aug-2021 17:07:29"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;16)
|
||||
changes to%: (VARS JAPANESECOMS)
|
||||
|
||||
previous date%: " 8-Aug-2021 13:28:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT JAPANESECOMS)
|
||||
|
||||
(RPAQQ JAPANESECOMS
|
||||
[ (* ; "XCCS to JIS converter")
|
||||
[COMS (* ; "JIS to XCCS conversion table.")
|
||||
[ (* ; "XCCS to JIS converter")
|
||||
[COMS (* ; "JIS to XCCS conversion table.")
|
||||
(VARS *JIS-TO-XCCS-CONV-NO-FONT-TABLE* *JIS-TO-XCCS-CODE-MAP*
|
||||
*HANKAKU-TO-ZENKAKU-CODE-MAP*)
|
||||
(GLOBALVARS *JIS-TO-XCCS-CONV-NO-FONT-TABLE* *JIS-TO-XCCS-CONV-TABLE-LIST*
|
||||
@@ -22,29 +23,28 @@
|
||||
*HANKAKU-TO-ZENKAKU-CONV-TABLE* *ZENKAKU-TO-HANKAKU-CONV-TABLE*)
|
||||
(FNS \MAKE.JIS.TO.XCCS.CONV.TABLE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAKE.JIS.TO.XCCS.CONV.TABLE]
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS))
|
||||
(FNS \JISIN \JISPEEK \BACKJISCCODE \SHIFTJISIN \SHIFTJISPEEK \BACKSHIFTJISCCODE \EUCIN
|
||||
\EUCPEEK \BACKEUCCODE)
|
||||
(FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN)
|
||||
[COMS (FNS CONVHANKAKU)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.XCCS.TO.JIS
|
||||
\DO.CONV.XCCS.TO.JIS \ASCIIP
|
||||
\NOT.EQUIVALENT.TO.JIS
|
||||
\CONV.HANKAKU.TO.ZENKAKUP
|
||||
\CONV.ZENKAKU.KANA]
|
||||
(COMS (FNS CONVHANKAKU)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (MACROS \CONV.XCCS.TO.JIS \DO.CONV.XCCS.TO.JIS
|
||||
\ASCIIP \NOT.EQUIVALENT.TO.JIS
|
||||
\CONV.HANKAKU.TO.ZENKAKUP \CONV.ZENKAKU.KANA)
|
||||
))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(* ;; "JIS specific macro")
|
||||
(* ;; "JIS specific macro")
|
||||
|
||||
(MACROS \EXTRACT.NO.FONT.CODE \EXTARACT.CONV.TABLE \NOT.EQUIVALENT.TO.XCCS
|
||||
\EXTRACT.SET \EXTRACT.CODE \CHNAGE.KI.MODE \KIMODEP \HANKAKUP \KANJIP
|
||||
\NOTGAIJIP \INVALID.TENP \CONV.HANKAKU.KANA \OUTKI \OUTKO)
|
||||
|
||||
(* ;; "Shift-JIS specific macro")
|
||||
(* ;; "Shift-JIS specific macro")
|
||||
|
||||
(MACROS \CONV.SJIS.TO.JIS \CONV.JIS.TO.SJIS \SJIS.KANJI.FIRST.BYTEP)
|
||||
|
||||
(* ;; "EUC specific macro")
|
||||
(* ;; "EUC specific macro")
|
||||
|
||||
(MACROS \EUC.KANJI.FIRST.BYTEP \GAIJIP \EUC.HANKAKUP))
|
||||
(FNS \CREATE.JIS.EXTERNALFORMAT \CREATE.SHIFTJIS.EXTERNALFORMAT \CREATE.EUC.EXTERNALFORMAT)
|
||||
@@ -449,11 +449,11 @@
|
||||
(\MAKE.JIS.TO.XCCS.CONV.TABLE)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \CONV.JIS.TO.XCCS MACRO [OPENLAMBDA (KU TEN)
|
||||
|
||||
(* ;;; "Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS.")
|
||||
(* ;;; "Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS.")
|
||||
|
||||
(COND
|
||||
((\NOT.EQUIVALENT.TO.XCCS KU)
|
||||
@@ -464,13 +464,13 @@
|
||||
(PUTPROPS \DO.CONV.JIS.TO.XCCS MACRO
|
||||
[(KU TEN)
|
||||
|
||||
(* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
|
||||
(* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
|
||||
|
||||
(COND
|
||||
((\INVALID.TENP TEN)
|
||||
*DEFAULT-NOT-CONVERTED-FAT-CODE*)
|
||||
(T (SELECTQ KU
|
||||
((33 34 38) (* ; "1, 2 and 6 KU")
|
||||
((33 34 38) (* ; "1, 2 and 6 KU")
|
||||
[LET* ((CONVTABLE (\EXTARACT.CONV.TABLE KU))
|
||||
(SET (\EXTRACT.SET TEN CONVTABLE))
|
||||
(CODE (\EXTRACT.CODE TEN CONVTABLE)))
|
||||
@@ -479,41 +479,38 @@
|
||||
(LOGOR (UNFOLD SET 256)
|
||||
CODE))
|
||||
(T (COND
|
||||
((EQ CODE 255) (* ; "Not defined in JIS.")
|
||||
((EQ CODE 255) (* ; "Not defined in JIS.")
|
||||
*DEFAULT-NOT-CONVERTED-FAT-CODE*)
|
||||
(T (* ;
|
||||
"Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.")
|
||||
(T (* ;
|
||||
"Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.")
|
||||
(COND
|
||||
(*REPLACE-NO-FONT-CODE*
|
||||
*DEFAULT-NOT-CONVERTED-FAT-CODE*)
|
||||
(T (\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 256)
|
||||
TEN])
|
||||
(35 (* ; "3 KU")
|
||||
(* ;
|
||||
"Alpha numeric codes are all defined as single byte codes in XCCS.")
|
||||
(35 (* ; "3 KU")
|
||||
(* ;
|
||||
"Alpha numeric codes are all defined as single byte codes in XCCS.")
|
||||
TEN)
|
||||
(40 (* ; "8 KU")
|
||||
(40 (* ; "8 KU")
|
||||
(COND
|
||||
[(< 0 TEN 33)
|
||||
(COND
|
||||
(*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*)
|
||||
(T (\EXTRACT.NO.FONT.CODE (LOGOR KU TEN]
|
||||
(T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
|
||||
(116 (* ; "84 KU")
|
||||
(116 (* ; "84 KU")
|
||||
(COND
|
||||
((< 0 TEN 5)
|
||||
(LOGOR 29952 TEN))
|
||||
(T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
|
||||
(117 (* ; "85 KU")
|
||||
(117 (* ; "85 KU")
|
||||
(COND
|
||||
((< 0 TEN 28)
|
||||
(LOGOR 29696 TEN))
|
||||
(T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
|
||||
*DEFAULT-NOT-CONVERTED-FAT-CODE*])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1055,11 +1052,11 @@
|
||||
(ARG ARGS 2))))])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC)
|
||||
|
||||
(* ;;; "Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode.")
|
||||
(* ;;; "Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode.")
|
||||
|
||||
(OR (COND
|
||||
((\ASCIIP CC)
|
||||
@@ -1067,8 +1064,8 @@
|
||||
((\NOT.EQUIVALENT.TO.JIS CC)
|
||||
(\DO.CONV.XCCS.TO.JIS CC))
|
||||
((\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM)
|
||||
(* ;
|
||||
"ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.")
|
||||
(* ;
|
||||
"ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.")
|
||||
(\CONV.ZENKAKU.KANA CC))
|
||||
(T CC))
|
||||
CC)))
|
||||
@@ -1104,9 +1101,6 @@
|
||||
(PUTPROPS \CONV.ZENKAKU.KANA MACRO ((CHAR)
|
||||
(GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*)))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -1120,7 +1114,7 @@
|
||||
|
||||
(PUTPROPS \NOT.EQUIVALENT.TO.XCCS MACRO ((KU)
|
||||
|
||||
(* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here.")
|
||||
(* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here.")
|
||||
|
||||
(OR (EQ KU 33)
|
||||
(EQ KU 34)
|
||||
@@ -1141,8 +1135,8 @@
|
||||
|
||||
(PUTPROPS \CHNAGE.KI.MODE MACRO [OPENLAMBDA (ST INPUTFLG ENTERP)
|
||||
|
||||
(* ;;;
|
||||
"INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.")
|
||||
(* ;;;
|
||||
"INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.")
|
||||
|
||||
(COND
|
||||
[INPUTFLG (COND
|
||||
@@ -1161,7 +1155,7 @@
|
||||
|
||||
(PUTPROPS \KIMODEP MACRO [OPENLAMBDA (ST INPUTFLG)
|
||||
|
||||
(* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.")
|
||||
(* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.")
|
||||
|
||||
(COND
|
||||
[INPUTFLG (ffetch (STREAM IN.KANJIIN)
|
||||
@@ -1201,7 +1195,7 @@
|
||||
|
||||
(PUTPROPS \CONV.SJIS.TO.JIS MACRO [OPENLAMBDA (HI LO)
|
||||
|
||||
(* ;;; "Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively.")
|
||||
(* ;;; "Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively.")
|
||||
|
||||
[SETQ CH1 (IDIFFERENCE HI (COND
|
||||
((> HI 159)
|
||||
@@ -1220,7 +1214,7 @@
|
||||
|
||||
(PUTPROPS \CONV.JIS.TO.SJIS MACRO [OPENLAMBDA (HI LO)
|
||||
|
||||
(* ;;; "Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively.")
|
||||
(* ;;; "Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively.")
|
||||
|
||||
[SETQ CH2 (COND
|
||||
((ODDP HI)
|
||||
@@ -1313,11 +1307,11 @@
|
||||
(ADDTOVAR LAMA CONVHANKAKU)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10976 16192 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10986 . 16190)) (19836 45193 (\JISIN 19846 .
|
||||
26482) (\JISPEEK 26484 . 33110) (\BACKJISCCODE 33112 . 33652) (\SHIFTJISIN 33654 . 35046) (
|
||||
\SHIFTJISPEEK 35048 . 37154) (\BACKSHIFTJISCCODE 37156 . 37742) (\EUCIN 37744 . 39447) (\EUCPEEK 39449
|
||||
. 43028) (\BACKEUCCODE 43030 . 45191)) (45194 49042 (\JISOUTCHARFN 45204 . 46614) (\SHIFTJISOUTCHARFN
|
||||
46616 . 47716) (\EUCOUTCHARFN 47718 . 49040)) (49043 49362 (CONVHANKAKU 49053 . 49360)) (60086 61580
|
||||
(\CREATE.JIS.EXTERNALFORMAT 60096 . 60484) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60486 . 61189) (
|
||||
\CREATE.EUC.EXTERNALFORMAT 61191 . 61578)))))
|
||||
(FILEMAP (NIL (10791 16007 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10801 . 16005)) (19582 44939 (\JISIN 19592 .
|
||||
26228) (\JISPEEK 26230 . 32856) (\BACKJISCCODE 32858 . 33398) (\SHIFTJISIN 33400 . 34792) (
|
||||
\SHIFTJISPEEK 34794 . 36900) (\BACKSHIFTJISCCODE 36902 . 37488) (\EUCIN 37490 . 39193) (\EUCPEEK 39195
|
||||
. 42774) (\BACKEUCCODE 42776 . 44937)) (44940 48788 (\JISOUTCHARFN 44950 . 46360) (\SHIFTJISOUTCHARFN
|
||||
46362 . 47462) (\EUCOUTCHARFN 47464 . 48786)) (48789 49108 (CONVHANKAKU 48799 . 49106)) (59763 61257
|
||||
(\CREATE.JIS.EXTERNALFORMAT 59773 . 60161) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60163 . 60866) (
|
||||
\CREATE.EUC.EXTERNALFORMAT 60868 . 61255)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
sources/SPP.LCOM
BIN
sources/SPP.LCOM
Binary file not shown.
Reference in New Issue
Block a user