Compare commits
13 Commits
medley-240
...
medley-240
| Author | SHA1 | Date | |
|---|---|---|---|
|
bda5cf1606 | ||
|
44b1f8a7f3 | ||
|
|
d5cc219895 | ||
|
a1a99c04cd | ||
|
|
f6eb5d9846 | ||
|
|
90dc568bae | ||
|
|
720ce08483 | ||
|
|
9b82f1a7c2 | ||
|
|
e92381b706 | ||
|
|
2341531ac3 | ||
|
|
8df2418f97 | ||
|
|
5437fac7aa | ||
|
fa39f9ec5d |
@@ -1,20 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Oct-2023 00:20:01" {WMEDLEY}<library>CLIPBOARD.;8 9130
|
||||
(FILECREATED "31-Mar-2024 06:51:14" {DSK}<home>larry>il>medley>library>CLIPBOARD.;2 8932
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.EXTRACTTOCLIPBOARD)
|
||||
:CHANGES-TO (FNS INSTALL-CLIPBOARD)
|
||||
(VARS CLIPBOARDCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 7-Jul-2022 23:53:01" {WMEDLEY}<library>CLIPBOARD.;7)
|
||||
:PREVIOUS-DATE "19-Oct-2023 00:20:01" {DSK}<home>larry>il>medley>library>CLIPBOARD.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CLIPBOARDCOMS)
|
||||
|
||||
(RPAQQ CLIPBOARDCOMS
|
||||
[ (* ; "Enable copy and paste")
|
||||
(FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE
|
||||
CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
|
||||
(FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD CLIPBOARD-COPY-STREAM
|
||||
CLIPBOARD-PASTE-STREAM)
|
||||
(FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD)
|
||||
(FNS SEDIT.COPYTOCLIPBOARD)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
|
||||
@@ -31,19 +32,22 @@
|
||||
(DEFINEQ
|
||||
|
||||
(INSTALL-CLIPBOARD
|
||||
[LAMBDA NIL (* ; "Edited 24-Jun-2021 21:14 by rmk:")
|
||||
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
|
||||
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
|
||||
(CL:WHEN (GETD 'LISPINTERRUPTS.PASTE)
|
||||
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG)
|
||||
(MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS))
|
||||
[LAMBDA NIL (* ; "Edited 30-Mar-2024 22:22 by lmm")
|
||||
(* ; "Edited 24-Jun-2021 21:14 by rmk:")
|
||||
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
|
||||
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
|
||||
(INTERRUPTCHAR (CHARCODE "Meta,v")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(INTERRUPTCHAR (CHARCODE "Meta,V")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
|
||||
(/PUTASSOC 'PASTE [LIST (LIST (CHARCODE "1,v")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(LIST (CHARCODE "1,V")
|
||||
'(PASTEFROMCLIPBOARD]
|
||||
LISPINTERRUPTS)
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
|
||||
|
||||
(* ;; "Paste")
|
||||
(* ;; "Paste")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
@@ -52,7 +56,7 @@
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Copy")
|
||||
(* ;; "Copy")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
|
||||
(FUNCTION TEDIT.COPYTOCLIPBOARD)
|
||||
@@ -61,7 +65,7 @@
|
||||
(FUNCTION TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Extract")
|
||||
(* ;; "Extract")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
|
||||
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
|
||||
@@ -69,8 +73,8 @@
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
|
||||
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE))
|
||||
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
|
||||
"SEDIT copy: INTERRUPTCHAR does paste")
|
||||
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
|
||||
"SEDIT copy: INTERRUPTCHAR does paste")
|
||||
(SEDIT:ADD-COMMAND "Meta,c" 'SEDIT.COPYTOCLIPBOARD "M-c" "Copy to clipboard")
|
||||
(SEDIT:ADD-COMMAND "Meta,C" 'SEDIT.COPYTOCLIPBOARD)
|
||||
(SEDIT:RESET-COMMANDS))])
|
||||
@@ -104,17 +108,6 @@
|
||||
THEN (COPYINSERT STR)
|
||||
ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C])
|
||||
|
||||
(LISPINTERRUPTS.PASTE
|
||||
[LAMBDA NIL (* ; "Edited 18-Apr-2018 22:59 by rmk:")
|
||||
|
||||
(* ;; "So paste interrupts will be installed in every process")
|
||||
|
||||
(APPEND [LIST (LIST (CHARCODE "1,v")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(LIST (CHARCODE "1,V")
|
||||
'(PASTEFROMCLIPBOARD]
|
||||
(LISPINTERRUPTS.ORIG])
|
||||
|
||||
(CLIPBOARD-COPY-STREAM
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk")
|
||||
(* ; "Edited 23-Feb-2021 22:11 by rmk:")
|
||||
@@ -196,10 +189,9 @@
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS CLIPBOARD COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1196 6505 (INSTALL-CLIPBOARD 1206 . 3138) (GETCLIPBOARD 3140 . 3514) (PUTCLIPBOARD 3516
|
||||
. 3921) (PASTEFROMCLIPBOARD 3923 . 4841) (LISPINTERRUPTS.PASTE 4843 . 5264) (CLIPBOARD-COPY-STREAM
|
||||
5266 . 5781) (CLIPBOARD-PASTE-STREAM 5783 . 6503)) (6506 7273 (TEDIT.COPYTOCLIPBOARD 6516 . 6797) (
|
||||
TEDIT.EXTRACTTOCLIPBOARD 6799 . 7271)) (7274 8813 (SEDIT.COPYTOCLIPBOARD 7284 . 8811)))))
|
||||
(FILEMAP (NIL (1243 6345 (INSTALL-CLIPBOARD 1253 . 3401) (GETCLIPBOARD 3403 . 3777) (PUTCLIPBOARD 3779
|
||||
. 4184) (PASTEFROMCLIPBOARD 4186 . 5104) (CLIPBOARD-COPY-STREAM 5106 . 5621) (CLIPBOARD-PASTE-STREAM
|
||||
5623 . 6343)) (6346 7113 (TEDIT.COPYTOCLIPBOARD 6356 . 6637) (TEDIT.EXTRACTTOCLIPBOARD 6639 . 7111)) (
|
||||
7114 8653 (SEDIT.COPYTOCLIPBOARD 7124 . 8651)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
445
library/UNICODE
445
library/UNICODE
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Feb-2024 13:49:35" {WMEDLEY}<library>UNICODE.;57 88440
|
||||
(FILECREATED "27-Mar-2024 23:07:42" {WMEDLEY}<library>UNICODE.;73 100984
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS INVERT-ALL-UNICODE-MAPPINGS UNICODE-EXTEND-TRANSLATION?)
|
||||
:CHANGES-TO (FNS UNICODE-EXTEND-TRANSLATION? INVERT-ALL-UNICODE-MAPPINGS ALL-UNICODE-MAPPINGS
|
||||
MERGE-UNICODE-TRANSLATION-TABLES)
|
||||
(VARS UNICODECOMS)
|
||||
|
||||
:PREVIOUS-DATE " 4-Feb-2024 12:42:00" {WMEDLEY}<library>UNICODE.;56)
|
||||
:PREVIOUS-DATE "27-Mar-2024 14:50:54" {WMEDLEY}<library>UNICODE.;72)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNICODECOMS)
|
||||
@@ -15,6 +17,8 @@
|
||||
((COMS (* ; "External formats")
|
||||
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
|
||||
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16BE.BACKCCODEFN)
|
||||
(FNS UTF16LE.OUTCHARFN UTF16LE.INCCODEFN UTF16LE.PEEKCCODEFN \UTF16LE.BACKCCODEFN)
|
||||
(FNS READBOM WRITEBOM)
|
||||
(INITVARS (EXTERNALEOL 'LF))
|
||||
(FNS MAKE-UNICODE-FORMATS)
|
||||
(P (MAKE-UNICODE-FORMATS EXTERNALEOL))
|
||||
@@ -35,7 +39,7 @@
|
||||
"Make translation tables for UTF external formats")
|
||||
(FNS MAKE-UNICODE-TRANSLATION-TABLES MERGE-UNICODE-TRANSLATION-TABLES
|
||||
MERGE-UNICODE-TRANSLATION-TABLES1)
|
||||
(FNS INVERT-ALL-UNICODE-MAPPINGS)
|
||||
(FNS INVERT-ALL-UNICODE-MAPPINGS ALL-UNICODE-MAPPINGS)
|
||||
(INITVARS (*XCCSTOUNICODE*)
|
||||
(*UNICODETOXCCS*)
|
||||
(*INVERTED-UNICODE-MAPPINGS*))
|
||||
@@ -66,6 +70,7 @@
|
||||
16]
|
||||
(VARS UNICODE-MAPPING-HEADER))
|
||||
(FNS UTF8HEXSTRING XTOUSTRING XCCSSTRING)
|
||||
(FNS UNHEXSTRING)
|
||||
(FNS SHOWCHARS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS)
|
||||
EXPORTS.ALL))
|
||||
@@ -336,27 +341,29 @@
|
||||
(UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) DO (\WOUT STREAM C])
|
||||
|
||||
(UTF16BE.INCCODEFN
|
||||
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:05 by rmk:")
|
||||
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 10-Mar-2024 12:00 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 16:05 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior")
|
||||
"Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(LET (CODE BYTE1 BYTE2 COUNT)
|
||||
(IF [AND (SMALLP (SETQ BYTE1 (\BIN STREAM)))
|
||||
(SMALLP (SETQ BYTE2 (\BIN STREAM]
|
||||
(SMALLP (SETQ BYTE2 (\BIN STREAM]
|
||||
THEN (SETQ COUNT 2)
|
||||
(SETQ CODE (LOGOR (LLSH (\BIN STREAM)
|
||||
8)
|
||||
(\BIN STREAM)))
|
||||
(CL:UNLESS RAW
|
||||
(SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
|
||||
CODE
|
||||
(SETQ CODE (create WORD
|
||||
HIBYTE _ (\BIN STREAM)
|
||||
LOBYTE _ (\BIN STREAM)))
|
||||
(CL:UNLESS RAW
|
||||
(SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
|
||||
CODE
|
||||
ELSE (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
|
||||
|
||||
(UTF16BE.PEEKCCODEFN
|
||||
[LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:58 by rmk:")
|
||||
[LAMBDA (STREAM NOERROR RAW) (* ; "Edited 10-Mar-2024 12:01 by rmk")
|
||||
(* ; "Edited 14-Jun-2021 22:58 by rmk:")
|
||||
|
||||
(* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")
|
||||
|
||||
@@ -366,35 +373,36 @@
|
||||
(SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
|
||||
(IF BYTE1
|
||||
THEN (\BIN STREAM)
|
||||
(SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
|
||||
(\BACKFILEPTR STREAM)
|
||||
(IF BYTE2
|
||||
THEN (SETQ CODE (LOGOR (LLSH BYTE1 8)
|
||||
BYTE2))
|
||||
(CL:IF RAW
|
||||
CODE
|
||||
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL)
|
||||
(SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
|
||||
(\BACKFILEPTR STREAM)
|
||||
(IF BYTE2
|
||||
THEN (SETQ CODE (create WORD
|
||||
HIBYTE _ BYTE1
|
||||
LOBYTE _ BYTE2))
|
||||
(CL:IF RAW
|
||||
CODE
|
||||
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL)
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
|
||||
|
||||
(\UTF16BE.BACKCCODEFN
|
||||
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 19-Jul-2022 15:14 by rmk")
|
||||
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 10-Mar-2024 12:02 by rmk")
|
||||
(* ; "Edited 19-Jul-2022 15:14 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 16:07 by rmk:")
|
||||
|
||||
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")
|
||||
|
||||
(* ;; "Common for big-ending and little-ending")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(LET (CODE (BYTE2 (\PEEKBIN STREAM)))
|
||||
(IF (\BACKFILEPTR STREAM)
|
||||
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
|
||||
(SETQ CODE (LOGOR (LLSH BYTE2 8)
|
||||
(\PEEKBIN STREAM)))
|
||||
(SETQ CODE (create WORD
|
||||
HIBYTE _ (\PEEKBIN STREAM)
|
||||
LOBYTE _ BYTE2))
|
||||
(CL:IF RAW
|
||||
CODE
|
||||
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
|
||||
@@ -402,12 +410,164 @@
|
||||
THEN (SETQ *BYTECOUNTER* -1)
|
||||
NIL)))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(UTF16LE.OUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 10-Mar-2024 11:58 by rmk")
|
||||
(* ; "Edited 8-Aug-2021 13:09 by rmk:")
|
||||
(* ; "Edited 30-Jan-2020 23:08 by rmk:")
|
||||
|
||||
(* ;; "PRINT UTF16 sequence for CHARCODE. Do not do XCCS to UNICODE translation if RAW.")
|
||||
|
||||
(* ;; "Not sure about EOL conversion if truly %"raw%"")
|
||||
|
||||
(IF (EQ CHARCODE (CHARCODE EOL))
|
||||
THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
|
||||
ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM)
|
||||
(IPLUS16 1 DATUM)))
|
||||
(FOR C INSIDE (CL:IF RAW
|
||||
CHARCODE
|
||||
(UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*))
|
||||
DO (BOUT STREAM (fetch LOBYTE of CHARCODE))
|
||||
(BOUT STREAM (fetch HIBYTE of CHARCODE])
|
||||
|
||||
(UTF16LE.INCCODEFN
|
||||
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 10-Mar-2024 12:03 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 16:05 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(LET (CODE BYTE1 BYTE2 COUNT)
|
||||
(IF [AND (SMALLP (SETQ BYTE1 (\BIN STREAM)))
|
||||
(SMALLP (SETQ BYTE2 (\BIN STREAM]
|
||||
THEN (SETQ COUNT 2)
|
||||
(SETQ CODE (create WORD
|
||||
LOBYTE _ (\BIN STREAM)
|
||||
HIBYTE _ (\BIN STREAM)))
|
||||
(CL:UNLESS RAW
|
||||
(SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
|
||||
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
|
||||
CODE
|
||||
ELSE (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
|
||||
|
||||
(UTF16LE.PEEKCCODEFN
|
||||
[LAMBDA (STREAM NOERROR RAW) (* ; "Edited 10-Mar-2024 11:43 by rmk")
|
||||
(* ; "Edited 14-Jun-2021 22:58 by rmk:")
|
||||
|
||||
(* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")
|
||||
|
||||
(* ;; "Do not do UNICODE to XCCS translation if RAW")
|
||||
|
||||
(LET (BYTE1 BYTE2 CODE)
|
||||
(SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
|
||||
(IF BYTE1
|
||||
THEN (\BIN STREAM)
|
||||
(SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
|
||||
(\BACKFILEPTR STREAM)
|
||||
(IF BYTE2
|
||||
THEN (SETQ CODE (LOGOR (LLSH BYTE2 8)
|
||||
BYTE1))
|
||||
(CL:IF RAW
|
||||
CODE
|
||||
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL)
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
|
||||
|
||||
(\UTF16LE.BACKCCODEFN
|
||||
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 10-Mar-2024 12:04 by rmk")
|
||||
(* ; "Edited 19-Jul-2022 15:14 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 16:07 by rmk:")
|
||||
|
||||
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(CL:WHEN (\BACKFILEPTR STREAM)
|
||||
(LET (CODE (BYTE2 (\PEEKBIN STREAM)))
|
||||
(IF (\BACKFILEPTR STREAM)
|
||||
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
|
||||
(SETQ CODE (create WORD
|
||||
HIBYTE _ BYTE2
|
||||
LOBYTE _ (\PEEKBIN STREAM)))
|
||||
(CL:IF RAW
|
||||
CODE
|
||||
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
|
||||
ELSEIF COUNTP
|
||||
THEN (SETQ *BYTECOUNTER* -1)
|
||||
NIL)))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(READBOM
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 11-Mar-2024 23:53 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 13:01 by rmk")
|
||||
|
||||
(* ;; "If COUNTP, this must be under a generic \INCCODE that binds *BYTECOUNTER*")
|
||||
|
||||
(* ;; "Reads and decodes the BOM bytes. If BOM ispresent, the stream is left at the first following byte, otherwise the stream is reset to its position on entry (presumably 0).")
|
||||
|
||||
(* ;; "I used the UNHEXTRING constants so that the hex bytes are visible in the code, maybe there's another function that does that?")
|
||||
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
(SELECTC (\PEEKBIN STREAM T)
|
||||
((UNHEXSTRING "EF")
|
||||
(BIN STREAM)
|
||||
(if (EQ (CONSTANT (UNHEXSTRING "BB"))
|
||||
(\PEEKBIN STREAM T))
|
||||
then (BIN STREAM)
|
||||
(if (EQ (CONSTANT (UNHEXSTRING "BF"))
|
||||
(\PEEKBIN STREAM T))
|
||||
then (BIN STREAM)
|
||||
(CL:WHEN COUNTP (add *BYTECOUNTER* 3))
|
||||
:UTF-8
|
||||
else (\BACKFILEPTR STREAM))
|
||||
else (\BACKFILEPTR STREAM)))
|
||||
((UNHEXSTRING "FE")
|
||||
(BIN STREAM)
|
||||
(if (EQ (CONSTANT (UNHEXSTRING "FF"))
|
||||
(\PEEKBIN STREAM T))
|
||||
then (BIN STREAM)
|
||||
(CL:WHEN COUNTP (add *BYTECOUNTER* 2))
|
||||
:UTF-16BE
|
||||
else (\BACKFILEPTR STREAM)))
|
||||
((UNHEXSTRING "FF")
|
||||
(BIN STREAM)
|
||||
(if (EQ (CONSTANT (UNHEXSTRING "FE"))
|
||||
(\PEEKBIN STREAM T))
|
||||
then (BIN STREAM)
|
||||
(CL:WHEN COUNTP (add *BYTECOUNTER* 2))
|
||||
:UTF-16LE
|
||||
else (\BACKFILEPTR STREAM)))
|
||||
NIL])
|
||||
|
||||
(WRITEBOM
|
||||
[LAMBDA (STREAM FORMAT) (* ; "Edited 16-Mar-2024 20:53 by rmk")
|
||||
(* ; "Edited 11-Mar-2024 23:53 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 13:01 by rmk")
|
||||
|
||||
(* ;; "Writes a BOM that represents FORMAT (:UTF-8, :UTF16-BE, :UTF16-LE")
|
||||
|
||||
(SELECTQ FORMAT
|
||||
(:UTF-8 (BOUT STREAM (CONSTANT (UNHEXSTRING "EF")))
|
||||
(BOUT STREAM (CONSTANT (UNHEXSTRING "BB")))
|
||||
(BOUT STREAM (CONSTANT (UNHEXSTRING "BF"))))
|
||||
(:UTF-16BE (BOUT STREAM (CONSTANT (UNHEXSTRING "FE")))
|
||||
(BOUT STREAM (CONSTANT (UNHEXSTRING "FF"))))
|
||||
(:UTF-16LE (BOUT STREAM (CONSTANT (UNHEXSTRING "FF")))
|
||||
(BOUT STREAM (UNHEXSTRING "FE")))
|
||||
NIL])
|
||||
)
|
||||
|
||||
(RPAQ? EXTERNALEOL 'LF)
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-UNICODE-FORMATS
|
||||
[LAMBDA (EXTERNALEOL) (* ; "Edited 8-Dec-2023 15:19 by rmk")
|
||||
[LAMBDA (EXTERNALEOL) (* ; "Edited 10-Mar-2024 11:55 by rmk")
|
||||
(* ; "Edited 8-Dec-2023 15:19 by rmk")
|
||||
(* ; "Edited 19-Jul-2022 15:36 by rmk")
|
||||
(* ; "Edited 6-Aug-2021 16:08 by rmk:")
|
||||
|
||||
@@ -442,6 +602,20 @@
|
||||
(\UTF16BE.BACKCCODEFN STREAM COUNTP T]
|
||||
[FUNCTION (LAMBDA (STREAM CHARCODE)
|
||||
(UTF16BE.OUTCHARFN STREAM CHARCODE T]
|
||||
NIL EXTERNALEOL NIL NIL NIL (FUNCTION NILL))
|
||||
(MAKE-EXTERNALFORMAT :UTF-16LE (FUNCTION UTF16LE.INCCODEFN)
|
||||
(FUNCTION UTF16LE.PEEKCCODEFN)
|
||||
(FUNCTION \UTF16LE.BACKCCODEFN)
|
||||
(FUNCTION UTF16LE.OUTCHARFN)
|
||||
NIL EXTERNALEOL NIL NIL NIL (FUNCTION NILL))
|
||||
(MAKE-EXTERNALFORMAT :UTF-16LE-RAW [FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(UTF16LE.INCCODEFN STREAM COUNTP T]
|
||||
[FUNCTION (LAMBDA (STREAM NOERROR)
|
||||
(UTF16LE.PEEKCCODEFN STREAM NOERROR T]
|
||||
[FUNCTION (LAMBDA (STREAM COUNTP)
|
||||
(\UTF16LE.BACKCCODEFN STREAM COUNTP T]
|
||||
[FUNCTION (LAMBDA (STREAM CHARCODE)
|
||||
(UTF16LE.OUTCHARFN STREAM CHARCODE T]
|
||||
NIL EXTERNALEOL NIL NIL NIL (FUNCTION NILL])
|
||||
)
|
||||
|
||||
@@ -487,37 +661,36 @@
|
||||
NEXTCODE])
|
||||
|
||||
(UNICODE-EXTEND-TRANSLATION?
|
||||
[LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 5-Feb-2024 13:48 by rmk")
|
||||
[LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 27-Mar-2024 23:02 by rmk")
|
||||
(* ; "Edited 5-Feb-2024 13:48 by rmk")
|
||||
(* ; "Edited 3-Feb-2024 12:40 by rmk")
|
||||
|
||||
(* ;; "There is currently no mapping for CODE in TRANSLATION-TABLE, hopefully just because the relevant character-set mapping as not be installed. We infer from TRANSLATION-TABLE whether CODE is an XCCS or UNICODE code.")
|
||||
(* ;; "There is currently no mapping for CODE in TRANSLATION-TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TRANSLATION-TABLE whether CODE is an XCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ")
|
||||
|
||||
(* ;; "The relevant mapping file, if any, can be determined directly from an XCCS code, since the mapping files are indexed by XCCS charset.")
|
||||
(LET (MAPPING FILE (INVERTED (EQ TRANSLATION-TABLE *UNICODETOXCCS*)))
|
||||
(SETQ FILE (FINDFILE (CL:IF INVERTED
|
||||
'INVERTED-UNICODE-MAPPINGS.TXT
|
||||
'UNICODE-MAPPINGS.TXT)
|
||||
T UNICODEDIRECTORIES))
|
||||
(CL:WHEN FILE
|
||||
(SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT)
|
||||
(FFILEPOS (CONCAT "[" (LRSH CODE 8)
|
||||
" ")
|
||||
STREAM NIL NIL NIL T)
|
||||
(READ STREAM)))
|
||||
(CL:WHEN MAPPING
|
||||
|
||||
(* ;; "To find the file for a Unicode code by first running it through the precomputed inverted Unicode-to-XCCS inverted index, and then find the charset file for the corresponding XCCS code. Presumably that has the inverted mapping for future fast lookups.")
|
||||
(* ;;
|
||||
"Merge MAPPING into both tables, respecting the direction indicated by TRANSLATION-TABLE.")
|
||||
|
||||
(LET (XCCSCODE NEWMAPPING INVERTEDFILE)
|
||||
[SETQ XCCSCODE (if (EQ TRANSLATION-TABLE *XCCSTOUNICODE*)
|
||||
then CODE
|
||||
elseif (SETQ INVERTEDFILE (FINDFILE 'INVERTED-UNICODE-MAPPINGS.TXT T
|
||||
UNICODEDIRECTORIES))
|
||||
then
|
||||
(* ;; "Note that we open/scan the inverted file for each unknown character, read the relevant character set (if any), get the XCCS code, and throw away what we just read. We will have installed all of the characters in the XCCS charset corresponding to CODE, that will catch a lot of what would otherwise be future unknowns (e.g. all Greeks are in). We may hit the same one repeatedly for Unicode JIS, since they appear to be scattered across XCCS.")
|
||||
(if INVERTED
|
||||
then (MERGE-UNICODE-TRANSLATION-TABLES MAPPING *UNICODETOXCCS* *XCCSTOUNICODE*)
|
||||
else (MERGE-UNICODE-TRANSLATION-TABLES MAPPING *XCCSTOUNICODE* *UNICODETOXCCS*))
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM INVERTEDFILE :INPUT)
|
||||
(FFILEPOS (CONCAT "[" (LRSH CODE 8)
|
||||
" ")
|
||||
STREAM NIL NIL NIL T)
|
||||
(CADR (ASSOC CODE (READ STREAM]
|
||||
(CL:WHEN (AND XCCSCODE (SETQ NEWMAPPING (READ-UNICODE-MAPPING XCCSCODE T T)))
|
||||
(* ;;
|
||||
"Hopefully we have now installed and can retrieve the mapping for CODE in its translation table.")
|
||||
|
||||
(* ;; "Whatever we find, we merge it in both directions--the tables bound to these variables are the only game in town.")
|
||||
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES NEWMAPPING)
|
||||
|
||||
(* ;; "CODE's charset may not have a mapping for idiosyncratic CODE. ")
|
||||
|
||||
(UNICODE.TRANSLATE CODE TRANSLATION-TABLE T))])
|
||||
(UNICODE.TRANSLATE CODE TRANSLATION-TABLE T)))])
|
||||
|
||||
(UTF8.BINCODE
|
||||
[LAMBDA (STREAM RAW) (* ; "Edited 4-Feb-2024 01:06 by rmk")
|
||||
@@ -1019,30 +1192,26 @@
|
||||
(LIST LTORARRAY RTOLARRAY])
|
||||
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES
|
||||
[LAMBDA (ADDITION TARGET) (* ; "Edited 3-Feb-2024 12:46 by rmk")
|
||||
[LAMBDA (ADDITION TABLE INVERSETABLE) (* ; "Edited 27-Mar-2024 12:10 by rmk")
|
||||
(* ; "Edited 3-Feb-2024 12:46 by rmk")
|
||||
(* ; "Edited 31-Jan-2024 10:06 by rmk")
|
||||
|
||||
(* ;; "ADDITION is a pair containing an LTOR array and an inverse RTOL array. TARGET is either NIL or an array pair.. If NIL, the current values of *XCCSTOUNICODE* and *UNICODETOXCCS* are used.")
|
||||
(* ;; "ADDITION is a pair containing a mapping array and its inverse, or a list that maps codes in the forward direction. ")
|
||||
|
||||
(* ;; "The ADDTION mappings are merged destructively into the TARGET mappings. This assumes that there are as yet no uncoded elements in the ADDITION hash arrays.")
|
||||
(* ;; "The forward ADDITION mappings are merged destructively into TABLE and its inverses are merged into INVERSETABLE. ")
|
||||
|
||||
(LET (TLTORARRAY TRTOLARRAY)
|
||||
(CL:UNLESS (AND (LISTP ADDITION)
|
||||
(CL:ARRAYP (CAR ADDITION))
|
||||
(CL:ARRAYP (CADR ADDITION)))
|
||||
(SETQ ADDITION (MAKE-UNICODE-TRANSLATION-TABLES ADDITION)))
|
||||
(if (NULL TARGET)
|
||||
then (SETQ TLTORARRAY *XCCSTOUNICODE*)
|
||||
(SETQ TRTOLARRAY *UNICODETOXCCS*)
|
||||
elseif (LISTP TARGET)
|
||||
then (SETQ TLTORARRAY (CAR TARGET))
|
||||
(SETQ TRTOLARRAY (CADR TARGET))
|
||||
else (\ILLEGAL.ARG TARGET))
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES1 (CAR ADDITION)
|
||||
TLTORARRAY)
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES1 (CADR ADDITION)
|
||||
TRTOLARRAY)
|
||||
(LIST TLTORARRAY TRTOLARRAY])
|
||||
(CL:UNLESS (AND (LISTP ADDITION)
|
||||
(CL:ARRAYP (CAR ADDITION))
|
||||
(CL:ARRAYP (CADR ADDITION)))
|
||||
|
||||
(* ;; "Make temporary mapping arrays when ADDTION is a list of corresponding code-pairs.")
|
||||
|
||||
(SETQ ADDITION (MAKE-UNICODE-TRANSLATION-TABLES ADDITION)))
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES1 (CAR ADDITION)
|
||||
TABLE)
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES1 (CADR ADDITION)
|
||||
INVERSETABLE)
|
||||
(LIST TABLE INVERSETABLE])
|
||||
|
||||
(MERGE-UNICODE-TRANSLATION-TABLES1
|
||||
[LAMBDA (ADDARRAY TARGETARRAY) (* ; "Edited 2-Feb-2024 13:18 by rmk")
|
||||
@@ -1104,10 +1273,11 @@
|
||||
(DEFINEQ
|
||||
|
||||
(INVERT-ALL-UNICODE-MAPPINGS
|
||||
[LAMBDA (MAKEFILE) (* ; "Edited 5-Feb-2024 13:14 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 27-Mar-2024 14:50 by rmk")
|
||||
(* ; "Edited 5-Feb-2024 13:14 by rmk")
|
||||
(* ; "Edited 3-Feb-2024 09:16 by rmk")
|
||||
|
||||
(* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and iproduces a 2-level index that maps each UNICODE code back to the one or more XCCS corresponding XCCS codes.")
|
||||
(* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps each UNICODE code back to the one or more XCCS corresponding XCCS codes.")
|
||||
|
||||
(* ;; "The first index level groups all the unicode codes that have the same high-ordere byte. The index is sorted by the high-order bytes, the pairs within each group are sorted by their unicode. If a given unicode maps to multiple XCCS codes, the pair with the lowest XCCS code comes first.")
|
||||
|
||||
@@ -1115,7 +1285,7 @@
|
||||
|
||||
(* ;; " (CADR (ASSOC UCODE (CADR (ASSOC (LRSH UCODE 8) INDEX)))).")
|
||||
|
||||
(* ;; "If IMAKEFILE is given, the resulting is written to that file.")
|
||||
(* ;; "If FILE is given, the resulting is written to that file.")
|
||||
|
||||
(LET (INDEX)
|
||||
[for M in (READ-UNICODE-MAPPING (for N in XCCS-CHARSETS collect (CAR N))
|
||||
@@ -1139,11 +1309,70 @@
|
||||
(ILESSP (CADR M1)
|
||||
(CADR M2]
|
||||
(SETQ INDEX (SORT INDEX T)) (* ; "Sort groups")
|
||||
(if MAKEFILE
|
||||
then (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'DIRECTORY (CAR (MKLIST UNICODEDIRECTORIES
|
||||
(if FILE
|
||||
then (CL:WITH-OPEN-FILE (STREAM [PACKFILENAME 'DIRECTORY (CAR (MKLIST UNICODEDIRECTORIES
|
||||
))
|
||||
'BODY
|
||||
'INVERTED-UNICODE-MAPPINGS.TXT)
|
||||
(CL:IF (EQ FILE T)
|
||||
'INVERTED-UNICODE-MAPPINGS.TXT
|
||||
(PACKFILENAME 'BODY FILE 'EXTENSION
|
||||
'TXT))]
|
||||
:DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
|
||||
|
||||
(* ;; "We can FFILEPOS for %"[nnn %" then READ. Or just READFILE")
|
||||
|
||||
(for I in INDEX do (PRINTOUT STREAM "[" (CAR I)
|
||||
" "
|
||||
(CADR I)
|
||||
"]" T))
|
||||
(FULLNAME STREAM))
|
||||
else INDEX])
|
||||
|
||||
(ALL-UNICODE-MAPPINGS
|
||||
[LAMBDA (FILE) (* ; "Edited 27-Mar-2024 14:48 by rmk")
|
||||
(* ; "Edited 5-Feb-2024 13:14 by rmk")
|
||||
(* ; "Edited 3-Feb-2024 09:16 by rmk")
|
||||
|
||||
(* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and iproduces a 2-level index that maps each XCCS code to the corresponding UNICODE.")
|
||||
|
||||
(* ;; "The first index level groups all the XCCS codes in the same character set. The index is sorted by the high-order bytes, the pairs within each group are sorted by their XCCS code. ")
|
||||
|
||||
(* ;; "GIven a XCCS code, the lookup for the corresonding Unicode is")
|
||||
|
||||
(* ;; " (CADR (ASSOC XCCSCODE (CADR (ASSOC (LRSH XCCSCODE 8) INDEX)))).")
|
||||
|
||||
(* ;; "If FILE is given, the resulting is written to that file. If FILE is T, the file is UNICODE-MAPPINGS.TXT")
|
||||
|
||||
(LET (INDEX)
|
||||
[for M in (READ-UNICODE-MAPPING (for N in XCCS-CHARSETS collect (CAR N))
|
||||
T)
|
||||
do (push [CDR (OR (ASSOC (LRSH (CAR M)
|
||||
8)
|
||||
INDEX)
|
||||
(CAR (push INDEX (CONS (LRSH (CAR M)
|
||||
8]
|
||||
(LIST (CAR M)
|
||||
(CADR M]
|
||||
|
||||
(* ;; "Push the sublists down an extra CONS, so that a subsequent READ will get them all.")
|
||||
|
||||
[for I in INDEX do (change (CDR I)
|
||||
(CONS (SORT DATUM (FUNCTION (LAMBDA (M1 M2)
|
||||
(OR (ILESSP (CAR M1)
|
||||
(CAR M2))
|
||||
(AND (EQ (CAR M1)
|
||||
(CAR M2))
|
||||
(ILESSP (CADR M1)
|
||||
(CADR M2]
|
||||
(SETQ INDEX (SORT INDEX T)) (* ; "Sort groups")
|
||||
(if FILE
|
||||
then (CL:WITH-OPEN-FILE (STREAM [PACKFILENAME 'DIRECTORY (CAR (MKLIST UNICODEDIRECTORIES
|
||||
))
|
||||
'BODY
|
||||
(CL:IF (EQ FILE T)
|
||||
'UNICODE-MAPPINGS.TXT
|
||||
(PACKFILENAME 'BODY FILE 'EXTENSION
|
||||
'TXT))]
|
||||
:DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
|
||||
|
||||
(* ;; "We can FFILEPOS for %"[nnn %" then READ. Or just READFILE")
|
||||
@@ -1580,6 +1809,25 @@
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(UNHEXSTRING
|
||||
[LAMBDA (HSTRING) (* ; "Edited 10-Mar-2024 12:56 by rmk")
|
||||
|
||||
(* ;; "Converts a hexstring to its number.")
|
||||
|
||||
(for I B (N _ 0) from 1 while (SETQ B (NTHCHARCODE HSTRING I))
|
||||
do [SETQ N (IPLUS (LLSH N 4)
|
||||
(if (AND (IGEQ B (CHARCODE 0))
|
||||
(ILEQ B (CHARCODE 9)))
|
||||
then (IDIFFERENCE B (CHARCODE 0))
|
||||
elseif (AND (IGEQ (SETQ B (UCASECODE B))
|
||||
(CHARCODE A))
|
||||
(ILEQ B (CHARCODE F)))
|
||||
then (IPLUS 10 (IDIFFERENCE B (CHARCODE A)))
|
||||
else (ERROR "INVALID HEX CHARACTER" (NTHCHARCODE HSTRING I]
|
||||
finally (RETURN N])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(SHOWCHARS
|
||||
[LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 26-Jan-2024 14:18 by mth")
|
||||
(* ; "Edited 1-Aug-2020 09:27 by rmk:")
|
||||
@@ -1618,20 +1866,23 @@
|
||||
|
||||
(PUTPROPS UNICODE FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3915 18061 (UTF8.OUTCHARFN 3925 . 6723) (UTF8.INCCODEFN 6725 . 12337) (UTF8.PEEKCCODEFN
|
||||
12339 . 17079) (\UTF8.BACKCCODEFN 17081 . 18059)) (18062 21929 (UTF16BE.OUTCHARFN 18072 . 18982) (
|
||||
UTF16BE.INCCODEFN 18984 . 19883) (UTF16BE.PEEKCCODEFN 19885 . 20956) (\UTF16BE.BACKCCODEFN 20958 .
|
||||
21927)) (21959 24240 (MAKE-UNICODE-FORMATS 21969 . 24238)) (24337 33379 (UNICODE.UNMAPPED 24347 .
|
||||
26421) (UNICODE-EXTEND-TRANSLATION? 26423 . 29002) (UTF8.BINCODE 29004 . 31583) (\UTF8.FETCHCODE 31585
|
||||
. 33377)) (33380 38901 (UTF8.VALIDATE 33390 . 35987) (UTF8-SIZE-FROM-BYTE1 35989 . 36421) (
|
||||
NUTF8-BYTE1-BYTES 36423 . 37160) (NUTF8-CODE-BYTES 37162 . 38219) (NUTF8-STRING-BYTES 38221 . 38899))
|
||||
(40332 40681 (XTOUCODE 40342 . 40510) (UTOXCODE 40512 . 40679)) (41624 47670 (
|
||||
READ-UNICODE-MAPPING-FILENAMES 41634 . 44581) (READ-UNICODE-MAPPING 44583 . 47668)) (47737 61373 (
|
||||
MAKE-UNICODE-TRANSLATION-TABLES 47747 . 56819) (MERGE-UNICODE-TRANSLATION-TABLES 56821 . 58261) (
|
||||
MERGE-UNICODE-TRANSLATION-TABLES1 58263 . 61371)) (61374 64671 (INVERT-ALL-UNICODE-MAPPINGS 61384 .
|
||||
64669)) (65639 78070 (WRITE-UNICODE-MAPPING 65649 . 69399) (WRITE-UNICODE-INCLUDED 69401 . 74123) (
|
||||
WRITE-UNICODE-MAPPING-HEADER 74125 . 75373) (WRITE-UNICODE-MAPPING-FILENAME 75375 . 76905) (HEXSTRING
|
||||
76907 . 78068)) (78071 78747 (XCCS-UTF8-AFTER-OPEN 78081 . 78745)) (81272 86774 (UTF8HEXSTRING 81282
|
||||
. 83487) (XTOUSTRING 83489 . 86409) (XCCSSTRING 86411 . 86772)) (86775 88285 (SHOWCHARS 86785 . 88283
|
||||
)))))
|
||||
(FILEMAP (NIL (4211 18357 (UTF8.OUTCHARFN 4221 . 7019) (UTF8.INCCODEFN 7021 . 12633) (UTF8.PEEKCCODEFN
|
||||
12635 . 17375) (\UTF8.BACKCCODEFN 17377 . 18355)) (18358 22612 (UTF16BE.OUTCHARFN 18368 . 19278) (
|
||||
UTF16BE.INCCODEFN 19280 . 20296) (UTF16BE.PEEKCCODEFN 20298 . 21529) (\UTF16BE.BACKCCODEFN 21531 .
|
||||
22610)) (22613 26900 (UTF16LE.OUTCHARFN 22623 . 23630) (UTF16LE.INCCODEFN 23632 . 24648) (
|
||||
UTF16LE.PEEKCCODEFN 24650 . 25817) (\UTF16LE.BACKCCODEFN 25819 . 26898)) (26901 29830 (READBOM 26911
|
||||
. 28915) (WRITEBOM 28917 . 29828)) (29860 33050 (MAKE-UNICODE-FORMATS 29870 . 33048)) (33147 41529 (
|
||||
UNICODE.UNMAPPED 33157 . 35231) (UNICODE-EXTEND-TRANSLATION? 35233 . 37152) (UTF8.BINCODE 37154 .
|
||||
39733) (\UTF8.FETCHCODE 39735 . 41527)) (41530 47051 (UTF8.VALIDATE 41540 . 44137) (
|
||||
UTF8-SIZE-FROM-BYTE1 44139 . 44571) (NUTF8-BYTE1-BYTES 44573 . 45310) (NUTF8-CODE-BYTES 45312 . 46369)
|
||||
(NUTF8-STRING-BYTES 46371 . 47049)) (48482 48831 (XTOUCODE 48492 . 48660) (UTOXCODE 48662 . 48829)) (
|
||||
49774 55820 (READ-UNICODE-MAPPING-FILENAMES 49784 . 52731) (READ-UNICODE-MAPPING 52733 . 55818)) (
|
||||
55887 69217 (MAKE-UNICODE-TRANSLATION-TABLES 55897 . 64969) (MERGE-UNICODE-TRANSLATION-TABLES 64971 .
|
||||
66105) (MERGE-UNICODE-TRANSLATION-TABLES1 66107 . 69215)) (69218 76326 (INVERT-ALL-UNICODE-MAPPINGS
|
||||
69228 . 72849) (ALL-UNICODE-MAPPINGS 72851 . 76324)) (77294 89725 (WRITE-UNICODE-MAPPING 77304 . 81054
|
||||
) (WRITE-UNICODE-INCLUDED 81056 . 85778) (WRITE-UNICODE-MAPPING-HEADER 85780 . 87028) (
|
||||
WRITE-UNICODE-MAPPING-FILENAME 87030 . 88560) (HEXSTRING 88562 . 89723)) (89726 90402 (
|
||||
XCCS-UTF8-AFTER-OPEN 89736 . 90400)) (92927 98429 (UTF8HEXSTRING 92937 . 95142) (XTOUSTRING 95144 .
|
||||
98064) (XCCSSTRING 98066 . 98427)) (98430 99318 (UNHEXSTRING 98440 . 99316)) (99319 100829 (SHOWCHARS
|
||||
99329 . 100827)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Mar-2024 00:38:51" {WMEDLEY}<library>tedit>TEDIT-FILE.;502 152349
|
||||
(FILECREATED "31-Mar-2024 23:50:57" {MEDLEY}<library>tedit>TEDIT-FILE.;2 152351
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDIT.PUT.STREAM \TEDIT.PUT.PCTB \TEDIT.PUT.TRAILER \TEDIT.PUT.CHARLOOKS
|
||||
\TEDIT.PUT.CHARLOOKS1)
|
||||
:CHANGES-TO (FNS TEDIT.PUT)
|
||||
|
||||
:PREVIOUS-DATE " 4-Mar-2024 22:50:23" {WMEDLEY}<library>tedit>TEDIT-FILE.;501)
|
||||
:PREVIOUS-DATE "11-Mar-2024 00:38:51" {MEDLEY}<library>tedit>TEDIT-FILE.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -399,7 +398,8 @@
|
||||
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
|
||||
|
||||
(TEDIT.PUT
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 7-Feb-2024 13:31 by rmk")
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 31-Mar-2024 23:50 by rmk")
|
||||
(* ; "Edited 7-Feb-2024 13:31 by rmk")
|
||||
(* ; "Edited 4-Feb-2024 00:10 by rmk")
|
||||
(* ; "Edited 22-Dec-2023 10:41 by rmk")
|
||||
(* ; "Edited 19-Dec-2023 10:18 by rmk")
|
||||
@@ -423,7 +423,7 @@
|
||||
|
||||
(* ;; "PUTFN BEFORE says it can't be saved, even though asked. Let him know")
|
||||
|
||||
(TEDIT.PROMPTPRINT "This document cannot be saved" T T)
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "This document cannot be saved" T T)
|
||||
(RETURN NIL))
|
||||
(CL:UNLESS (OR (IGREATERP (TEXTLEN TEXTOBJ)
|
||||
0)
|
||||
@@ -2435,26 +2435,26 @@
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4977 31356 (TEDIT.GET 4987 . 9663) (TEDIT.FORMATTEDFILEP 9665 . 10588) (TEDIT.FILEDATE
|
||||
10590 . 12174) (\TEDIT.GET.IDATE3 12176 . 13571) (TEDIT.INCLUDE 13573 . 20426) (TEDIT.RAW.INCLUDE
|
||||
20428 . 21236) (TEDIT.PUT 21238 . 28064) (TEDIT.PUT.STREAM 28066 . 31354)) (31418 49820 (
|
||||
\TEDIT.GET.FOREIGN.FILE 31428 . 34492) (\TEDIT.GET.UNFORMATTED.FILE 34494 . 38253) (
|
||||
\TEDIT.GET.FORMATTED.FILE 38255 . 40921) (\TEDIT.FORMATTEDSTREAMP 40923 . 43610) (\ARBIN 43612 . 44332
|
||||
) (\ATMIN 44334 . 44871) (\DWIN 44873 . 45252) (\STRINGIN 45254 . 45962) (\TEDIT.GET.TRAILER 45964 .
|
||||
48289) (\TEDIT.CACHEFILE 48291 . 49818)) (49986 61364 (\TEDIT.GET.PIECES3 49996 . 59523) (
|
||||
\TEDIT.MAKE.STRINGPIECE 59525 . 61362)) (61365 73308 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 61375 . 67491)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 67493 . 73306)) (73330 79151 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 73340 .
|
||||
79149)) (79174 87310 (\TEDIT.GET.CHARLOOKS.LIST 79184 . 79798) (\TEDIT.GET.SINGLE.CHARLOOKS 79800 .
|
||||
84122) (\TEDIT.GET.CHARLOOKS 84124 . 85454) (\TEDIT.GET.PARALOOKS.INDEX 85456 . 86000) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 86002 . 87308)) (87311 95549 (\TEDIT.GET.PARALOOKS.LIST 87321 . 87943) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 87945 . 94957) (\TEDIT.GET.PARALOOKS 94959 . 95547)) (95550 98948 (
|
||||
TEDIT.GET.OBJECT 95560 . 98946)) (99010 130965 (\TEDIT.PUT.PCTB 99020 . 112763) (\TEDIT.PUT.TRAILER
|
||||
112765 . 113532) (\TEDIT.PUT.PCTB.MERGEABLE 113534 . 117052) (\TEDIT.PUT.UTF8.SPLITPIECES 117054 .
|
||||
122008) (\TEDIT.PUT.PCTB.NEXTNEW 122010 . 125785) (\TEDIT.INSERT.NEWPIECES 125787 . 128563) (
|
||||
\TEDIT.PUTRESET 128565 . 128807) (\ARBOUT 128809 . 129533) (\ATMOUT 129535 . 130140) (\DWOUT 130142 .
|
||||
130421) (\STRINGOUT 130423 . 130963)) (130966 140095 (\TEDIT.PUT.CHARLOOKS.LIST 130976 . 132648) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 132650 . 137894) (\TEDIT.PUT.CHARLOOKS 137896 . 139040) (
|
||||
\TEDIT.PUT.CHARLOOKS1 139042 . 140093)) (140096 148134 (\TEDIT.PUT.PARALOOKS.LIST 140106 . 141008) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 141010 . 147059) (\TEDIT.PUT.PARALOOKS 147061 . 148132)) (148135 150408 (
|
||||
TEDIT.PUT.OBJECT 148145 . 150406)) (150503 152185 (TEDITFROMLISPSOURCE 150513 . 152183)))))
|
||||
(FILEMAP (NIL (4862 31358 (TEDIT.GET 4872 . 9548) (TEDIT.FORMATTEDFILEP 9550 . 10473) (TEDIT.FILEDATE
|
||||
10475 . 12059) (\TEDIT.GET.IDATE3 12061 . 13456) (TEDIT.INCLUDE 13458 . 20311) (TEDIT.RAW.INCLUDE
|
||||
20313 . 21121) (TEDIT.PUT 21123 . 28066) (TEDIT.PUT.STREAM 28068 . 31356)) (31420 49822 (
|
||||
\TEDIT.GET.FOREIGN.FILE 31430 . 34494) (\TEDIT.GET.UNFORMATTED.FILE 34496 . 38255) (
|
||||
\TEDIT.GET.FORMATTED.FILE 38257 . 40923) (\TEDIT.FORMATTEDSTREAMP 40925 . 43612) (\ARBIN 43614 . 44334
|
||||
) (\ATMIN 44336 . 44873) (\DWIN 44875 . 45254) (\STRINGIN 45256 . 45964) (\TEDIT.GET.TRAILER 45966 .
|
||||
48291) (\TEDIT.CACHEFILE 48293 . 49820)) (49988 61366 (\TEDIT.GET.PIECES3 49998 . 59525) (
|
||||
\TEDIT.MAKE.STRINGPIECE 59527 . 61364)) (61367 73310 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 61377 . 67493)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 67495 . 73308)) (73332 79153 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 73342 .
|
||||
79151)) (79176 87312 (\TEDIT.GET.CHARLOOKS.LIST 79186 . 79800) (\TEDIT.GET.SINGLE.CHARLOOKS 79802 .
|
||||
84124) (\TEDIT.GET.CHARLOOKS 84126 . 85456) (\TEDIT.GET.PARALOOKS.INDEX 85458 . 86002) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 86004 . 87310)) (87313 95551 (\TEDIT.GET.PARALOOKS.LIST 87323 . 87945) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 87947 . 94959) (\TEDIT.GET.PARALOOKS 94961 . 95549)) (95552 98950 (
|
||||
TEDIT.GET.OBJECT 95562 . 98948)) (99012 130967 (\TEDIT.PUT.PCTB 99022 . 112765) (\TEDIT.PUT.TRAILER
|
||||
112767 . 113534) (\TEDIT.PUT.PCTB.MERGEABLE 113536 . 117054) (\TEDIT.PUT.UTF8.SPLITPIECES 117056 .
|
||||
122010) (\TEDIT.PUT.PCTB.NEXTNEW 122012 . 125787) (\TEDIT.INSERT.NEWPIECES 125789 . 128565) (
|
||||
\TEDIT.PUTRESET 128567 . 128809) (\ARBOUT 128811 . 129535) (\ATMOUT 129537 . 130142) (\DWOUT 130144 .
|
||||
130423) (\STRINGOUT 130425 . 130965)) (130968 140097 (\TEDIT.PUT.CHARLOOKS.LIST 130978 . 132650) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 132652 . 137896) (\TEDIT.PUT.CHARLOOKS 137898 . 139042) (
|
||||
\TEDIT.PUT.CHARLOOKS1 139044 . 140095)) (140098 148136 (\TEDIT.PUT.PARALOOKS.LIST 140108 . 141010) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 141012 . 147061) (\TEDIT.PUT.PARALOOKS 147063 . 148134)) (148137 150410 (
|
||||
TEDIT.PUT.OBJECT 148147 . 150408)) (150505 152187 (TEDITFROMLISPSOURCE 150515 . 152185)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Sep-2023 17:25:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;257 130870
|
||||
(FILECREATED "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259 131082
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS)
|
||||
:CHANGES-TO (FNS FIX-DIRECTORY-DATES)
|
||||
|
||||
:PREVIOUS-DATE "28-Sep-2023 23:20:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;256)
|
||||
:PREVIOUS-DATE "29-Sep-2023 17:25:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;257)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||
|
||||
(RPAQQ COMPAREDIRECTORIESCOMS
|
||||
@@ -1514,7 +1510,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(FIX-DIRECTORY-DATES
|
||||
[LAMBDA (FILES MARGIN) (* ; "Edited 29-Nov-2021 20:30 by rmk:")
|
||||
[LAMBDA (FILES MARGIN) (* ; "Edited 26-Mar-2024 21:42 by rmk")
|
||||
(* ; "Edited 29-Nov-2021 20:30 by rmk:")
|
||||
(* ; "Edited 23-Nov-2021 12:16 by rmk:")
|
||||
(* ; "Edited 30-Oct-2020 22:01 by rmk:")
|
||||
|
||||
@@ -1536,13 +1533,23 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
|
||||
(* ;; "Stop if directory date is more than 2 minutes earlier than the filecreated date. Earlier could be because the dates are asserted at different points in the filing process. But 2 minutes is worth thinking about. Returning from HELP will get them aligned.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Doesn't descend into subdirectories.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Also fixes dates of Tedit files, if they carry an internal creation date.")
|
||||
|
||||
(SETQ MARGIN (ITIMES (OR MARGIN 2)
|
||||
60 ONESECOND))
|
||||
(FOR F DIDATE FCDATE IN (OR (LISTP FILES)
|
||||
(FILDIR FILES)) WHEN (SETQ FCDATE (OR (FILEDATE F T)
|
||||
(FILEDATE F)))
|
||||
UNLESS (IEQP (SETQ DIDATE (GETFILEINFO F 'ICREATIONDATE))
|
||||
(SETQ FCDATE (IDATE FCDATE)))
|
||||
(FILDIR FILES)) UNLESS (DIRECTORYNAMEP F)
|
||||
WHEN (SETQ FCDATE (OR (FILEDATE F T)
|
||||
(FILEDATE F)
|
||||
(TEDIT.FILEDATE F))) UNLESS (IEQP (SETQ DIDATE (GETFILEINFO F
|
||||
'ICREATIONDATE))
|
||||
(SETQ FCDATE (IDATE FCDATE)))
|
||||
COLLECT (CL:WHEN (IGREATERP (IDIFFERENCE FCDATE DIDATE)
|
||||
MARGIN)
|
||||
|
||||
@@ -2189,28 +2196,26 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
COMPARESOURCES COMPARETEXT)
|
||||
|
||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
|
||||
2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2651 22769 (COMPAREDIRECTORIES 2661 . 7751) (COMPAREDIRECTORIES.INFOS 7753 . 10711) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10713 . 14098) (CDENTRIES.SELECT 14100 . 18875) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18877 . 20003) (MATCHNAME 20005 . 20685) (CD.INSURECDVALUE 20687 . 22301
|
||||
) (CD.UPDATEWIDTHS 22303 . 22767)) (22770 33392 (CDFILES 22780 . 28794) (CDFILES.MATCH 28796 . 30421)
|
||||
(CDFILES.PATS 30423 . 33390)) (33393 51214 (CDPRINT 33403 . 35920) (CDPRINT.HEADER 35922 . 36819) (
|
||||
CDPRINT.LINE 36821 . 40053) (CDPRINT.MAXWIDTHS 40055 . 44170) (CDPRINT.COLHEADERS 44172 . 45457) (
|
||||
CDPRINT.COLUMNS 45459 . 50579) (CDTEDIT 50581 . 51212)) (51215 60336 (CDMAP 51225 . 52657) (CDENTRY
|
||||
52659 . 52968) (CDSUBSET 52970 . 54409) (CDMERGE 54411 . 58395) (CDMERGE.COMMON 58397 . 59712) (
|
||||
CD.SORT 59714 . 60334)) (60337 67875 (BINCOMP 60347 . 64636) (EOLTYPE 64638 . 67200) (EOLTYPE.SHOW
|
||||
67202 . 67873)) (68403 80930 (FIND-UNCOMPILED-FILES 68413 . 72056) (FIND-UNSOURCED-FILES 72058 . 74442
|
||||
) (FIND-SOURCE-FILES 74444 . 76182) (FIND-COMPILED-FILES 76184 . 78061) (FIND-UNLOADED-FILES 78063 .
|
||||
78916) (FIND-LOADED-FILES 78918 . 79346) (FIND-MULTICOMPILED-FILES 79348 . 80928)) (80931 89362 (
|
||||
CREATED-AS 80941 . 85738) (SOURCE-FOR-COMPILED-P 85740 . 88667) (COMPILE-SOURCE-DATE-DIFF 88669 .
|
||||
89360)) (89363 99669 (FIX-DIRECTORY-DATES 89373 . 92366) (FIX-EQUIV-DATES 92368 . 93893) (
|
||||
COPY-COMPARED-FILES 93895 . 95716) (COPY-MISSING-FILES 95718 . 97875) (COMPILED-ON-SAME-SOURCE 97877
|
||||
. 99667)) (99863 107701 (CDBROWSER 99873 . 103800) (CDBROWSER.STRINGS 103802 . 107699)) (107863
|
||||
109599 (CD.TABLEITEM 107873 . 108093) (CD.TABLEITEM.PRINTFN 108095 . 108294) (CD.TABLEITEM.COPYFN
|
||||
108296 . 109354) (CDTABLEBROWSER.HEADING.REPAINTFN 109356 . 109597)) (109600 130255 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 109610 . 110078) (CD.COMMANDSELECTEDFN 110080 . 115181) (CD-MENUFN
|
||||
115183 . 119494) (CD-COMPARE-FILES 119496 . 122848) (CDBROWSER-COPY 122850 . 126519) (
|
||||
CDBROWSER-DELETE-FILE 126521 . 129734) (CD-SWAPDIRS 129736 . 130253)))))
|
||||
(FILEMAP (NIL (2527 22645 (COMPAREDIRECTORIES 2537 . 7627) (COMPAREDIRECTORIES.INFOS 7629 . 10587) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10589 . 13974) (CDENTRIES.SELECT 13976 . 18751) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18753 . 19879) (MATCHNAME 19881 . 20561) (CD.INSURECDVALUE 20563 . 22177
|
||||
) (CD.UPDATEWIDTHS 22179 . 22643)) (22646 33268 (CDFILES 22656 . 28670) (CDFILES.MATCH 28672 . 30297)
|
||||
(CDFILES.PATS 30299 . 33266)) (33269 51090 (CDPRINT 33279 . 35796) (CDPRINT.HEADER 35798 . 36695) (
|
||||
CDPRINT.LINE 36697 . 39929) (CDPRINT.MAXWIDTHS 39931 . 44046) (CDPRINT.COLHEADERS 44048 . 45333) (
|
||||
CDPRINT.COLUMNS 45335 . 50455) (CDTEDIT 50457 . 51088)) (51091 60212 (CDMAP 51101 . 52533) (CDENTRY
|
||||
52535 . 52844) (CDSUBSET 52846 . 54285) (CDMERGE 54287 . 58271) (CDMERGE.COMMON 58273 . 59588) (
|
||||
CD.SORT 59590 . 60210)) (60213 67751 (BINCOMP 60223 . 64512) (EOLTYPE 64514 . 67076) (EOLTYPE.SHOW
|
||||
67078 . 67749)) (68279 80806 (FIND-UNCOMPILED-FILES 68289 . 71932) (FIND-UNSOURCED-FILES 71934 . 74318
|
||||
) (FIND-SOURCE-FILES 74320 . 76058) (FIND-COMPILED-FILES 76060 . 77937) (FIND-UNLOADED-FILES 77939 .
|
||||
78792) (FIND-LOADED-FILES 78794 . 79222) (FIND-MULTICOMPILED-FILES 79224 . 80804)) (80807 89238 (
|
||||
CREATED-AS 80817 . 85614) (SOURCE-FOR-COMPILED-P 85616 . 88543) (COMPILE-SOURCE-DATE-DIFF 88545 .
|
||||
89236)) (89239 100002 (FIX-DIRECTORY-DATES 89249 . 92699) (FIX-EQUIV-DATES 92701 . 94226) (
|
||||
COPY-COMPARED-FILES 94228 . 96049) (COPY-MISSING-FILES 96051 . 98208) (COMPILED-ON-SAME-SOURCE 98210
|
||||
. 100000)) (100196 108034 (CDBROWSER 100206 . 104133) (CDBROWSER.STRINGS 104135 . 108032)) (108196
|
||||
109932 (CD.TABLEITEM 108206 . 108426) (CD.TABLEITEM.PRINTFN 108428 . 108627) (CD.TABLEITEM.COPYFN
|
||||
108629 . 109687) (CDTABLEBROWSER.HEADING.REPAINTFN 109689 . 109930)) (109933 130588 (
|
||||
CDTABLEBROWSER.WHENSELECTEDFN 109943 . 110411) (CD.COMMANDSELECTEDFN 110413 . 115514) (CD-MENUFN
|
||||
115516 . 119827) (CD-COMPARE-FILES 119829 . 123181) (CDBROWSER-COPY 123183 . 126852) (
|
||||
CDBROWSER-DELETE-FILE 126854 . 130067) (CD-SWAPDIRS 130069 . 130586)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12 65343
|
||||
(FILECREATED "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13 65523
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
|
||||
|
||||
:PREVIOUS-DATE " 9-Mar-2024 22:21:42" {WMEDLEY}<lispusers>DINFO.;10)
|
||||
:PREVIOUS-DATE "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DINFOCOMS)
|
||||
@@ -1036,18 +1036,20 @@
|
||||
(PROMPTPRINT "DInfo is busy"])
|
||||
|
||||
(DINFO.OPENTEXTSTREAM
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Mar-2024 15:37 by rmk")
|
||||
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Apr-2024 23:46 by rmk")
|
||||
(* ; "Edited 10-Mar-2024 15:37 by rmk")
|
||||
(* drc%: "25-Jan-86 18:24")
|
||||
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
|
||||
(LET ((TEXTSTREAM (WINDOWPROP WINDOW 'TEXTSTREAM))
|
||||
(THIS.TEXT (LIST FILE FROM TO)))
|
||||
(if (AND (EQUAL THIS.TEXT (fetch (DINFOGRAPH LAST.TEXT) of (DINFOGRAPH WINDOW)))
|
||||
(if (AND TEXTSTREAM (EQUAL THIS.TEXT (fetch (DINFOGRAPH LAST.TEXT)
|
||||
of (DINFOGRAPH WINDOW)))
|
||||
(\GETSTREAM TEXTSTREAM 'INPUT T))
|
||||
then
|
||||
(* ;; "Same text, and it's still there and open, so do nothing.")
|
||||
|
||||
TEXTSTREAM
|
||||
else (AND TEXTSTREAM (TEDIT.KILL TEXTSTREAM))
|
||||
else (CL:WHEN TEXTSTREAM (TEDIT.KILL TEXTSTREAM))
|
||||
(CLEARW T)
|
||||
(CLEARW WINDOW)
|
||||
[RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
|
||||
@@ -1122,7 +1124,7 @@ DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINF
|
||||
47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
|
||||
. 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
|
||||
DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
|
||||
58867 64756 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
|
||||
DINFO.OPENTEXTSTREAM 61954 . 63116) (DINFO.SHOWSEL 63118 . 63851) (DINFO.GET.FILENAME 63853 . 64754)))
|
||||
58867 64936 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
|
||||
DINFO.OPENTEXTSTREAM 61954 . 63296) (DINFO.SHOWSEL 63298 . 64031) (DINFO.GET.FILENAME 64033 . 64934)))
|
||||
))
|
||||
STOP
|
||||
|
||||
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 "26-Dec-2023 21:17:15" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;3 8449
|
||||
(FILECREATED " 8-Apr-2024 11:48:01" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;4 8919
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS NSDISPLAYSIZE)
|
||||
|
||||
:PREVIOUS-DATE "24-Dec-2023 13:50:41" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;2)
|
||||
:PREVIOUS-DATE "26-Dec-2023 21:17:15" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT NSDISPLAYSIZESCOMS)
|
||||
@@ -30,13 +30,16 @@
|
||||
(DEFINEQ
|
||||
|
||||
(NSDISPLAYSIZE
|
||||
[LAMBDA (FAMILY SIZE FACE EXTENSION) (* ; "Edited 26-Dec-2023 21:15 by rmk")
|
||||
[LAMBDA (FAMILY SIZE FACE EXTENSION) (* ; "Edited 8-Apr-2024 11:47 by rmk")
|
||||
(* ; "Edited 26-Dec-2023 21:15 by rmk")
|
||||
(* ; "Edited 24-Dec-2023 13:49 by rmk")
|
||||
(* ; "Edited 14-Sep-96 09:32 by rmk:")
|
||||
(* ; "Edited 16-Nov-95 10:08 by ")
|
||||
(* ; "Edited 5-Mar-93 18:12 by kaplan")
|
||||
(* ; "Edited 15-Jan-87 15:22 by bvm:")
|
||||
|
||||
(* ;; "What we really want for small NS font sizes (12 or below) is the next larger existing font, not a built-in knowledge here of what exists.")
|
||||
|
||||
(* ;; "Returns size that we would prefer to see the font of requested family, size, face, extension. Used to make bigger ns display fonts than you would get by default. Don't do it for small screens, as on DOS and laptops.")
|
||||
|
||||
(DECLARE (GLOBALVARS DISPLAYFONTEXTENSIONS NSFONTFAMILIES))
|
||||
@@ -52,17 +55,21 @@
|
||||
NIL)))
|
||||
((CL:MEMBER FAMILY NSFONTFAMILIES :TEST 'STRING-EQUAL)
|
||||
(* ; "Large screen, enlarge NS fonts")
|
||||
(AND (SELECTQ SIZE
|
||||
(12 (COND
|
||||
((CL:MEMBER FAMILY '(TERMINAL TITAN)
|
||||
:TEST
|
||||
'STRING-EQUAL) (* ; "Until these exist in size 14")
|
||||
12)
|
||||
(T 14)))
|
||||
(10 12)
|
||||
(8 10)
|
||||
(6 8)
|
||||
NIL)))
|
||||
(SELECTQ (U-CASE (MKATOM FAMILY))
|
||||
(TERMINAL (* ; "14 doesn't exist, oh well.")
|
||||
(CL:IF (ILEQ SIZE 10)
|
||||
(IPLUS SIZE 2)
|
||||
SIZE))
|
||||
(TITAN (SELECTQ SIZE
|
||||
(6 9)
|
||||
(9 10)
|
||||
(10 12)
|
||||
(CL:IF (ILESSP SIZE 6)
|
||||
6
|
||||
SIZE)))
|
||||
(CL:IF (ILEQ SIZE 12)
|
||||
(IPLUS SIZE 2)
|
||||
SIZE)))
|
||||
((AND NIL (CL:MEMBER EXTENSION INTERPRESSFONTEXTENSIONS :TEST 'STRING-EQUAL)
|
||||
(STRING-EQUAL FAMILY 'SYMBOL)) (* ;
|
||||
"Fake NS size on Interpress printing, even tho display fonts don't exist")
|
||||
@@ -160,7 +167,7 @@
|
||||
(VKBD.FIX.FONT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1522 6781 (NSDISPLAYSIZE 1532 . 4079) (NS\FONTFILENAME 4081 . 4322) (
|
||||
NS\FONTFILENAME.OLD 4324 . 4573) (PURGENSFONTS 4575 . 6779)) (6993 8031 (VKBD.FIX.FONT 7003 . 8029))))
|
||||
(FILEMAP (NIL (1522 7251 (NSDISPLAYSIZE 1532 . 4549) (NS\FONTFILENAME 4551 . 4792) (
|
||||
NS\FONTFILENAME.OLD 4794 . 5043) (PURGENSFONTS 5045 . 7249)) (7463 8501 (VKBD.FIX.FONT 7473 . 8499))))
|
||||
)
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
53
lispusers/PLOTANDNC-PATCH
Normal file
53
lispusers/PLOTANDNC-PATCH
Normal file
@@ -0,0 +1,53 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 4-Apr-2024 18:50:50" |{DSK}<home>frank>il>ncmedley>lispusers>PLOTANDNC-PATCH.;2| 1814
|
||||
|
||||
:PREVIOUS-DATE "22-Jan-88 15:45:26" |{DSK}<home>frank>il>ncmedley>lispusers>PLOTANDNC-PATCH.;1|
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT PLOTANDNC-PATCHCOMS)
|
||||
|
||||
(RPAQQ PLOTANDNC-PATCHCOMS (
|
||||
(* |;;|
|
||||
"define font read fns used by plot and notecards so system can read either kind")
|
||||
|
||||
(FNS READFONT READ.FONTINTODESCRIPTOR)
|
||||
(P
|
||||
(* |;;|
|
||||
"make sure these read fns are registered to avoid messages when reading")
|
||||
|
||||
(PUSHNEW HPRINTREADFNS 'READFONT)
|
||||
(PUSHNEW HPRINTREADFNS 'READ.FONTINTODESCRIPTOR))))
|
||||
|
||||
|
||||
|
||||
(* |;;| "define font read fns used by plot and notecards so system can read either kind")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(readfont
|
||||
(lambda (stream) (* |jop:| "27-Aug-85 13:34")
|
||||
(prog ((proplist (read stream)))
|
||||
(return (fontcreate (listget proplist 'family)
|
||||
(listget proplist 'size)
|
||||
(listget proplist 'face)
|
||||
(listget proplist 'rotation)
|
||||
(listget proplist 'device))))))
|
||||
|
||||
(read.fontintodescriptor
|
||||
(lambda (stream) (* \; "Edited 22-Jan-88 15:36 by thh:")
|
||||
|
||||
(apply 'fontcreate (read stream))))
|
||||
)
|
||||
|
||||
|
||||
(* |;;| "make sure these read fns are registered to avoid messages when reading")
|
||||
|
||||
|
||||
(PUSHNEW HPRINTREADFNS 'READFONT)
|
||||
|
||||
(PUSHNEW HPRINTREADFNS 'READ.FONTINTODESCRIPTOR)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1001 1609 (READFONT 1011 . 1427) (READ.FONTINTODESCRIPTOR 1429 . 1607)))))
|
||||
STOP
|
||||
BIN
lispusers/PLOTANDNC-PATCH.LCOM
Normal file
BIN
lispusers/PLOTANDNC-PATCH.LCOM
Normal file
Binary file not shown.
Binary file not shown.
65
lispusers/SEDIT-MAN
Normal file
65
lispusers/SEDIT-MAN
Normal file
@@ -0,0 +1,65 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Mar-2024 23:56:13" {WMEDLEY}<lispusers>SEDIT-MAN.;1 2085
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS SEDIT-MAN)
|
||||
(VARS SEDIT-MANCOMS)
|
||||
|
||||
:PREVIOUS-DATE "28-Mar-2024 23:41:09" {LI}SEDIT-MAN.;6)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT SEDIT-MANCOMS)
|
||||
|
||||
(RPAQQ SEDIT-MANCOMS
|
||||
((FNS SEDIT-MAN)
|
||||
(P
|
||||
(* ;; "THE SCROLL? ARGUMENT IS UNDOCUMENTED.")
|
||||
|
||||
|
||||
(* ;; "ONE CALL SHOULD ADD BOTH UPPER AND LOWER CASE, LIKE OTHER COMMANDS. TWO CALLS ADDS 2 EQUIVALENT LINES TO THE MENU.")
|
||||
|
||||
(SEDIT:ADD-COMMAND "Meta,D" (FUNCTION SEDIT-MAN)
|
||||
NIL "Info" "M-D" "Show man information")
|
||||
(SEDIT:ADD-COMMAND "Meta,d" (FUNCTION SEDIT-MAN)
|
||||
NIL "Info" "M-D" "Show man information")
|
||||
(SEDIT:RESET-COMMANDS))))
|
||||
(DEFINEQ
|
||||
|
||||
(SEDIT-MAN
|
||||
[LAMBDA (CONTEXT CHARCODE) (* ; "Edited 28-Mar-2024 23:52 by rmk")
|
||||
|
||||
(* ;; "IF NOTHING IS SELECTED, SEDIT:GET-SELECTION CAUSES AN ERROR RATHER THAN RETURNING SELTYPE NIL, CONTRARY TO DOCUMENTATION. SO NLSETQ.")
|
||||
|
||||
(* ;; "CLIPBOARD HAS THE SAME PROBLEM")
|
||||
|
||||
[NLSETQ (CL:MULTIPLE-VALUE-BIND (SEL SELTYPE)
|
||||
(SEDIT:GET-SELECTION CONTEXT)
|
||||
(CL:WHEN (AND (EQ T SELTYPE)
|
||||
[OR (LITATOM SEL)
|
||||
(AND (LISTP SEL)
|
||||
(LITATOM (SETQ SEL (CAR SEL]
|
||||
SEL)
|
||||
(GENERIC.MAN.LOOKUP SEL]
|
||||
T])
|
||||
)
|
||||
|
||||
|
||||
(* ;; "THE SCROLL? ARGUMENT IS UNDOCUMENTED.")
|
||||
|
||||
|
||||
|
||||
(* ;; "ONE CALL SHOULD ADD BOTH UPPER AND LOWER CASE, LIKE OTHER COMMANDS. TWO CALLS ADDS 2 EQUIVALENT LINES TO THE MENU.")
|
||||
|
||||
|
||||
(SEDIT:ADD-COMMAND "Meta,D" (FUNCTION SEDIT-MAN)
|
||||
NIL "Info" "M-D" "Show man information")
|
||||
|
||||
(SEDIT:ADD-COMMAND "Meta,d" (FUNCTION SEDIT-MAN)
|
||||
NIL "Info" "M-D" "Show man information")
|
||||
|
||||
(SEDIT:RESET-COMMANDS)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (899 1656 (SEDIT-MAN 909 . 1654)))))
|
||||
STOP
|
||||
BIN
lispusers/SEDIT-MAN.LCOM
Normal file
BIN
lispusers/SEDIT-MAN.LCOM
Normal file
Binary file not shown.
@@ -1,20 +1,19 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Oct-2023 10:15:55" {WMEDLEY}<lispusers>WHEELSCROLL.;24 10480
|
||||
(FILECREATED "31-Mar-2024 06:57:25" {DSK}<home>larry>il>medley>lispusers>WHEELSCROLL.;2 9911
|
||||
|
||||
:EDIT-BY rmk
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS WHEELSCROLLCOMS)
|
||||
(FNS ENABLEWHEELSCROLL)
|
||||
|
||||
:PREVIOUS-DATE " 6-Apr-2023 18:34:48" {WMEDLEY}<lispusers>WHEELSCROLL.;22)
|
||||
:PREVIOUS-DATE " 2-Oct-2023 10:15:55" {DSK}<home>larry>il>medley>lispusers>WHEELSCROLL.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT WHEELSCROLLCOMS)
|
||||
|
||||
(RPAQQ WHEELSCROLLCOMS
|
||||
[(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL
|
||||
LISPINTERRUPTS.WHEELSCROLL)
|
||||
[(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL)
|
||||
|
||||
(* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")
|
||||
|
||||
@@ -35,7 +34,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(ENABLEWHEELSCROLL
|
||||
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 2-Oct-2023 10:05 by rmk")
|
||||
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 31-Mar-2024 06:30 by lmm")
|
||||
(* ; "Edited 2-Oct-2023 10:05 by rmk")
|
||||
(* ; "Edited 23-Oct-2021 16:31 by larry")
|
||||
(* ; "Edited 11-Jun-2021 12:50 by rmk:")
|
||||
(* ; "Edited 28-May-2021 11:46 by rmk:")
|
||||
@@ -43,11 +43,7 @@
|
||||
(* ;; "So we can toggle this scrolling.")
|
||||
|
||||
(if ON
|
||||
then (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
|
||||
(GETD 'LISPINTERRUPTS.WHEELSCROLL))
|
||||
(CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL) (* ; "In case of LOADFROM?")
|
||||
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
|
||||
(MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS)))
|
||||
then (/PUTASSOC 'WHEELSCROLL WHEELSCROLLINTERRUPTS LISPINTERRUPTS)
|
||||
|
||||
(* ;; "In some situations these other keyactions seem to be installed, hit them all.")
|
||||
|
||||
@@ -73,9 +69,7 @@
|
||||
(CADR I)
|
||||
(CADDR I)))
|
||||
(SETQ WHEELSCROLLENABLED T)
|
||||
else (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
(GETD 'LISPINTERRUPTS))
|
||||
(MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS))
|
||||
else (/PUTASSOC 'WHEELSCROLL NIL LISPINTERRUPTS)
|
||||
(for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I)
|
||||
NIL))
|
||||
(for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
@@ -159,13 +153,6 @@
|
||||
(,\WSRIGHT (WHEELSCROLL 'HORIZONTAL (OR HWHEELSCROLLDELTA
|
||||
WHEELSCROLLDELTA)
|
||||
WHEELSCROLLDELTA T])
|
||||
|
||||
(LISPINTERRUPTS.WHEELSCROLL
|
||||
[LAMBDA NIL (* ; "Edited 17-Feb-2021 11:09 by rmk:")
|
||||
|
||||
(* ;; "So wheelscroll interrupts will be installed in every process")
|
||||
|
||||
(APPEND WHEELSCROLLINTERRUPTS (LISPINTERRUPTS.WSORIG])
|
||||
)
|
||||
|
||||
|
||||
@@ -227,6 +214,6 @@
|
||||
(ENABLEWHEELSCROLL T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1459 9251 (ENABLEWHEELSCROLL 1469 . 4512) (WHEELSCROLL 4514 . 7115) (WHEELSCROLL.DOIT
|
||||
7117 . 7753) (INSTALL-WHEELSCROLL 7755 . 8972) (LISPINTERRUPTS.WHEELSCROLL 8974 . 9249)))))
|
||||
(FILEMAP (NIL (1452 8682 (ENABLEWHEELSCROLL 1462 . 4220) (WHEELSCROLL 4222 . 6823) (WHEELSCROLL.DOIT
|
||||
6825 . 7461) (INSTALL-WHEELSCROLL 7463 . 8680)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,52 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(filecreated "22-Jan-88 15:45:26" {indigo}<gslws>lyric>library>plotandnc-patch.\;1 1853
|
||||
|
||||
|changes| |to:| (vars plotandnc-patchcoms)
|
||||
(fns read.fontintodescriptor))
|
||||
|
||||
|
||||
; Copyright (c) 1988 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(prettycomprint plotandnc-patchcoms)
|
||||
|
||||
(rpaqq plotandnc-patchcoms (
|
||||
|
||||
(* |;;| "define font read fns used by plot and notecards so system can read either kind")
|
||||
|
||||
(fns readfont read.fontintodescriptor)
|
||||
(p
|
||||
|
||||
(* |;;| "make sure these read fns are registered to avoid messages when reading")
|
||||
|
||||
(pushnew hprintreadfns 'readfont)
|
||||
(pushnew hprintreadfns 'read.fontintodescriptor))))
|
||||
|
||||
|
||||
|
||||
(* |;;| "define font read fns used by plot and notecards so system can read either kind")
|
||||
|
||||
(defineq
|
||||
|
||||
(readfont
|
||||
(lambda (stream) (* |jop:| "27-Aug-85 13:34")
|
||||
(prog ((proplist (read stream)))
|
||||
(return (fontcreate (listget proplist 'family)
|
||||
(listget proplist 'size)
|
||||
(listget proplist 'face)
|
||||
(listget proplist 'rotation)
|
||||
(listget proplist 'device))))))
|
||||
|
||||
(read.fontintodescriptor
|
||||
(lambda (stream) (* \; "Edited 22-Jan-88 15:36 by thh:")
|
||||
|
||||
(apply 'fontcreate (read stream))))
|
||||
)
|
||||
|
||||
(* |;;| "make sure these read fns are registered to avoid messages when reading")
|
||||
|
||||
(pushnew hprintreadfns 'readfont)
|
||||
(pushnew hprintreadfns 'read.fontintodescriptor)
|
||||
(putprops plotandnc-patch copyright ("Xerox Corporation" 1988))
|
||||
(declare\: dontcopy
|
||||
(filemap (nil (967 1575 (readfont 977 . 1393) (read.fontintodescriptor 1395 . 1573)))))
|
||||
stop
|
||||
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "17-Sep-92 10:42:38" "{Pele:mv:envos}<LispCore>Sources>AINTERRUPT.;4" 41128
|
||||
|
||||
|changes| |to:| (FNS INTCHAR GETINTERRUPT)
|
||||
(FILECREATED "31-Mar-2024 09:38:10" |{DSK}<home>larry>il>medley>sources>AINTERRUPT.;7| 41133
|
||||
|
||||
|previous| |date:| "28-Jun-90 18:45:07" "{Pele:mv:envos}<LispCore>Sources>AINTERRUPT.;3")
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS AINTERRUPTCOMS)
|
||||
|
||||
:PREVIOUS-DATE "31-Mar-2024 09:27:57" |{DSK}<home>larry>il>medley>sources>AINTERRUPT.;5|)
|
||||
|
||||
; Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1989, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT AINTERRUPTCOMS)
|
||||
|
||||
@@ -16,7 +17,14 @@
|
||||
\\DOHELPINTERRUPT1 \\DOINTERRUPTHERE \\PROC.FINDREALFRAME \\SETPRINTLEVEL
|
||||
\\SETRECLAIMMIN GETINTERRUPT CURRENTINTERRUPTS SETINTERRUPT RESET.INTERRUPTS
|
||||
INTERRUPTABLE))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (P (INTCHAR T)))
|
||||
(INITVARS (LISPINTERRUPTS '((LISPINTERRUPTS (2 BREAK MOUSE)
|
||||
(4 RESET MOUSE)
|
||||
(5 ERROR MOUSE)
|
||||
(7 HELP T)
|
||||
(16 PRINTLEVEL)
|
||||
(20 (CONTROL-T))
|
||||
(127 RUBOUT T)))))
|
||||
(GLOBALVARS LISPINTERRUPTS)
|
||||
(COMS
|
||||
(* |;;| "^T this is actually not very useful any more, and the percentages are wrong")
|
||||
|
||||
@@ -46,7 +54,8 @@
|
||||
DONTCOPY
|
||||
(EXPORT (RECORDS INTERRUPTSTATE)
|
||||
(PROP DMACRO \\TAKEINTERRUPT))
|
||||
(MACROS \\SYSTEMINTERRUPTP))))
|
||||
(MACROS \\SYSTEMINTERRUPTP))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY (P (INTCHAR T)))))
|
||||
|
||||
|
||||
|
||||
@@ -55,43 +64,44 @@
|
||||
(DEFINEQ
|
||||
|
||||
(INTCHAR
|
||||
(LAMBDA (CHAR TYP/FORM HARDFLG TABLE) (* \; "Edited 17-Sep-92 10:41 by jds")
|
||||
(LAMBDA (CHAR TYP/FORM HARDFLG TABLE) (* \; "Edited 31-Mar-2024 09:16 by lmm")
|
||||
(* \; "Edited 17-Sep-92 10:41 by jds")
|
||||
|
||||
(* |;;| "this function is the non-undoable version of INTERRUPTCHAR; INTERRUPTCHAR calls it")
|
||||
|
||||
(PROG (VAL SYSDEF OLDINT)
|
||||
(SELECTQ CHAR
|
||||
(NIL (* \;
|
||||
"this is illegal, so don't do anything about it")
|
||||
"this is illegal, so don't do anything about it")
|
||||
(RETURN))
|
||||
(T (* \;
|
||||
"(INTCHAR T) means restore interrupts to the 'standard' setting")
|
||||
(UNINTERRUPTABLY
|
||||
(|for| CHAR |in| (GETINTERRUPT NIL TABLE)
|
||||
|do| (SETQ VAL (NCONC (INTCHAR CHAR NIL NIL TABLE)
|
||||
VAL))) (* \;
|
||||
"turn off all user interrupts --- (GETINTERRUPT) returns list of user interrupts")
|
||||
(MAPC (LISPINTERRUPTS)
|
||||
(FUNCTION (LAMBDA (LST)
|
||||
(SETQ VAL (NCONC (INTCHAR (CAR LST)
|
||||
(CADR LST)
|
||||
(CADDR LST)
|
||||
TABLE)
|
||||
VAL)))))
|
||||
(T
|
||||
(* |;;| "(INTCHAR T) means restore interrupts to the 'standard' setting")
|
||||
|
||||
(* |;;| "and reset all SYSTEM interrupts to default --- (LISPINTERRUPTS) returns a list of argument lists for INTCHAR")
|
||||
(|for| CHAR |in| (GETINTERRUPT NIL TABLE)
|
||||
|do| (SETQ VAL (NCONC (INTCHAR CHAR NIL NIL TABLE)
|
||||
VAL))) (* \;
|
||||
"turn off all user interrupts --- (GETINTERRUPT) returns list of user interrupts")
|
||||
(MAPC (LISPINTERRUPTS)
|
||||
(FUNCTION (LAMBDA (LST)
|
||||
(SETQ VAL (NCONC (INTCHAR (CAR LST)
|
||||
(CADR LST)
|
||||
(CADDR LST)
|
||||
TABLE)
|
||||
VAL)))))
|
||||
|
||||
(* |;;| "and reset all SYSTEM interrupts to default --- (LISPINTERRUPTS) returns a list of argument lists for INTCHAR")
|
||||
(* \;
|
||||
"and VAL has been set to a valid arg list for INTCHAR")
|
||||
(RETURN VAL)))
|
||||
"and VAL has been set to a valid arg list for INTCHAR")
|
||||
(RETURN VAL))
|
||||
NIL)
|
||||
(COND
|
||||
((LISTP CHAR) (* \;
|
||||
"Call from undoing or resetform. CHAR is a list of characters followed by typ/form arguments.")
|
||||
"Call from undoing or resetform. CHAR is a list of characters followed by typ/form arguments.")
|
||||
(|while| CHAR |do| (SETQ VAL (NCONC (INTCHAR (|pop| CHAR)
|
||||
(|pop| CHAR)
|
||||
(|pop| CHAR)
|
||||
TABLE)
|
||||
VAL)))
|
||||
(|pop| CHAR)
|
||||
(|pop| CHAR)
|
||||
TABLE)
|
||||
VAL)))
|
||||
(RETURN VAL)))
|
||||
(COND
|
||||
((NOT (FIXP CHAR))
|
||||
@@ -103,26 +113,26 @@
|
||||
(SETQ CHAR (OR (GETINTERRUPT CHAR TABLE)
|
||||
(ERRORX (LIST 27 CHAR)))))
|
||||
(T (* \;
|
||||
"turn single character into character code")
|
||||
"turn single character into character code")
|
||||
(SETQ CHAR (APPLY* 'CHARCODE CHAR))))))
|
||||
(SETQ VAL (AND (SETQ OLDINT (GETINTERRUPT CHAR TABLE))
|
||||
(LIST CHAR (CAR OLDINT)
|
||||
(CADR OLDINT))))
|
||||
(COND
|
||||
((EQ TYP/FORM T) (* \;
|
||||
"just return value indicating what it was.")
|
||||
"just return value indicating what it was.")
|
||||
(RETURN VAL))
|
||||
((AND TYP/FORM (LITATOM TYP/FORM)
|
||||
(SETQ SYSDEF (ASSOC TYP/FORM \\SYSTEMINTERRUPTS)))
|
||||
(* \;
|
||||
"System interrupt -- get its default HARDFLG")
|
||||
"System interrupt -- get its default HARDFLG")
|
||||
(OR HARDFLG (SETQ HARDFLG (CADR SYSDEF)))))
|
||||
(COND
|
||||
((AND (EQ (CAR OLDINT)
|
||||
TYP/FORM)
|
||||
(EQ (CADR OLDINT)
|
||||
HARDFLG)) (* \;
|
||||
"if the character is already set up, just return")
|
||||
"if the character is already set up, just return")
|
||||
(RETURN)))
|
||||
(COND
|
||||
(OLDINT (SETINTERRUPT CHAR NIL TABLE)))
|
||||
@@ -251,20 +261,15 @@
|
||||
"Couldn't build frame, so leave interrupt pending")
|
||||
(SETQ \\PENDINGINTERRUPT T)))))))))))))
|
||||
|
||||
(lispinterrupts
|
||||
(lambda nil (* |jds| "30-Sep-85 12:35")
|
||||
|
||||
(* * |Returns| \a |list| |of| |the| "standard" |interrupt-character|
|
||||
|settings| |for| |Interlisp-D.| |These| |are| |used,| |e.g.,| |in| intchar
|
||||
|to| |reset| |things| |to| |the| |default| |state.|)
|
||||
(LISPINTERRUPTS
|
||||
(LAMBDA NIL (* \; "Edited 31-Mar-2024 06:25 by lmm")
|
||||
(* |jds| "30-Sep-85 12:35")
|
||||
|
||||
'((2 break mouse)
|
||||
(4 reset mouse)
|
||||
(5 error mouse)
|
||||
(7 help t)
|
||||
(16 printlevel)
|
||||
(20 (control-t))
|
||||
(127 rubout t))))
|
||||
(* * |Returns| \a |list| |of| |the| "standard" |interrupt-character| |settings|
|
||||
|for| |Interlisp-D.| |These| |are| |used,| |e.g.,| |in| INTCHAR |to| |reset|
|
||||
|things| |to| |the| |default| |state.|)
|
||||
|
||||
(FOR R IN LISPINTERRUPTS JOIN (APPEND (CDR R)))))
|
||||
|
||||
(\\dohelpinterrupt
|
||||
(lambda nil (* |bvm:| "27-JUL-83 18:37")
|
||||
@@ -427,7 +432,8 @@
|
||||
(setq \\linbuf olb))))
|
||||
|
||||
(GETINTERRUPT
|
||||
(LAMBDA (CHAR TABLE) (* \; "Edited 17-Sep-92 10:41 by jds")
|
||||
(LAMBDA (CHAR TABLE) (* \; "Edited 31-Mar-2024 09:20 by lmm")
|
||||
(* \; "Edited 17-Sep-92 10:41 by jds")
|
||||
|
||||
(* |;;| "Return the interrupt, if any, defined for CHAR in keyaction table TABLE.")
|
||||
|
||||
@@ -438,20 +444,16 @@
|
||||
(OR TABLE (SETQ TABLE \\CURRENTKEYACTION))
|
||||
(SELECTQ CHAR
|
||||
(NIL (* \; "Non-system interrupts")
|
||||
(|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST)
|
||||
TABLE) |unless| (\\SYSTEMINTERRUPTP (CADR X))
|
||||
|collect| (CAR X)))
|
||||
(|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE)
|
||||
|unless| (\\SYSTEMINTERRUPTP (CADR X)) |collect| (CAR X)))
|
||||
(T (* \; "All system interrupts")
|
||||
(|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST)
|
||||
TABLE) |collect| (CAR X)))
|
||||
(|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE) |collect| (CAR X)))
|
||||
(COND
|
||||
((NUMBERP CHAR)
|
||||
(CDR (FASSOC CHAR (|fetch| (KEYACTION INTERRUPTLIST)
|
||||
TABLE))))
|
||||
(T (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST)
|
||||
TABLE) |when| (EQ CHAR (CADR X))
|
||||
|do| (* \; "Find CHAR in system class.")
|
||||
(RETURN (CAR X))))))))
|
||||
(CDR (FASSOC CHAR (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE))))
|
||||
(T (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE)
|
||||
|when| (EQ CHAR (CADR X)) |do| (* \; "Find CHAR in system class.")
|
||||
(RETURN (CAR X))))))))
|
||||
|
||||
(currentinterrupts
|
||||
(lambda (table) (* |bvm:| "18-Jul-85 12:37")
|
||||
@@ -535,9 +537,18 @@
|
||||
(lambda (flag) (* |lmm| "18-APR-82 13:52")
|
||||
(prog1 \\interruptable (setq \\interruptable flag))))
|
||||
)
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INTCHAR T)
|
||||
(RPAQ? LISPINTERRUPTS
|
||||
'((LISPINTERRUPTS (2 BREAK MOUSE)
|
||||
(4 RESET MOUSE)
|
||||
(5 ERROR MOUSE)
|
||||
(7 HELP T)
|
||||
(16 PRINTLEVEL)
|
||||
(20 (CONTROL-T))
|
||||
(127 RUBOUT T))))
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS LISPINTERRUPTS)
|
||||
)
|
||||
|
||||
|
||||
@@ -679,16 +690,16 @@
|
||||
(ADDTOVAR FONTVARS (INTERUPTMENUFONT DEFAULTFONT T))
|
||||
|
||||
(RPAQQ \\SYSTEMINTERRUPTS ((BREAK MOUSE)
|
||||
(CONTROL-T)
|
||||
(ERROR MOUSE)
|
||||
(ERRORX)
|
||||
(HELP T)
|
||||
(OUTPUTBUFFER T)
|
||||
(PRINTLEVEL)
|
||||
(RAID T)
|
||||
(RESET MOUSE)
|
||||
(RUBOUT T)
|
||||
(STORAGE)))
|
||||
(CONTROL-T)
|
||||
(ERROR MOUSE)
|
||||
(ERRORX)
|
||||
(HELP T)
|
||||
(OUTPUTBUFFER T)
|
||||
(PRINTLEVEL)
|
||||
(RAID T)
|
||||
(RESET MOUSE)
|
||||
(RUBOUT T)
|
||||
(STORAGE)))
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(ADDTOVAR NOFIXFNSLST CONTROL-T)
|
||||
@@ -710,9 +721,9 @@
|
||||
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
|
||||
|
||||
(PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y)
|
||||
((LAMBDA (\\INTERRUPTABLE)
|
||||
(PROGN X . Y))
|
||||
NIL)))
|
||||
((LAMBDA (\\INTERRUPTABLE)
|
||||
(PROGN X . Y))
|
||||
NIL)))
|
||||
|
||||
(ADDTOVAR PRETTYPRINTMACROS
|
||||
(UNINTERRUPTABLY
|
||||
@@ -731,57 +742,52 @@ DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD INTERRUPTSTATE (
|
||||
(* |;;| "This is the structure used to communicate between the emulator and Lisp re interrupts. There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt.")
|
||||
(* |;;| "This is the structure used to communicate between the emulator and Lisp re interrupts. There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt.")
|
||||
|
||||
(* |;;| "This must match the INTSTAT definition in lispemul.h")
|
||||
(* |;;| "This must match the INTSTAT definition in lispemul.h")
|
||||
|
||||
(* |;;| "PENDING-INTERRUPT FLAGS:")
|
||||
(* |;;| "PENDING-INTERRUPT FLAGS:")
|
||||
|
||||
(LOGMSGSPENDING FLAG) (* \;
|
||||
" Log/Console msgs need printing.")
|
||||
(ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.")
|
||||
(IOINTERRUPT FLAG)
|
||||
(GCDISABLED FLAG) (* \; "No mroe room in GC tables.")
|
||||
(VMEMFULL FLAG) (* \; "VMEM is full!!")
|
||||
(STACKOVERFLOW FLAG) (* \; "Stack overflowed.")
|
||||
(STORAGEFULL FLAG) (* \;
|
||||
"Ran out of storage, atoms, etc.")
|
||||
(WAITINGINTERRUPT FLAG)
|
||||
(LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.")
|
||||
(ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.")
|
||||
(IOINTERRUPT FLAG)
|
||||
(GCDISABLED FLAG) (* \; "No mroe room in GC tables.")
|
||||
(VMEMFULL FLAG) (* \; "VMEM is full!!")
|
||||
(STACKOVERFLOW FLAG) (* \; "Stack overflowed.")
|
||||
(STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.")
|
||||
(WAITINGINTERRUPT FLAG)
|
||||
|
||||
(* |;;| "INTERRUPTS-IN-PROCESS MASK:")
|
||||
(* |;;| "INTERRUPTS-IN-PROCESS MASK:")
|
||||
|
||||
(P-LOGMSGSPENDING FLAG) (* \;
|
||||
" Log/Console msgs need printing.")
|
||||
(P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.")
|
||||
(P-IOINTERRUPT FLAG)
|
||||
(P-GCDISABLED FLAG) (* \; "No mroe room in GC tables.")
|
||||
(P-VMEMFULL FLAG) (* \; "VMEM is full!!")
|
||||
(P-STACKOVERFLOW FLAG) (* \; "Stack overflowed.")
|
||||
(P-STORAGEFULL FLAG) (* \;
|
||||
"Ran out of storage, atoms, etc.")
|
||||
(P-WAITINGINTERRUPT FLAG)
|
||||
(INTCHARCODE WORD))
|
||||
(BLOCKRECORD INTERRUPTSTATE (
|
||||
(* |;;|
|
||||
"Alternative view of the structure:")
|
||||
(P-LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.")
|
||||
(P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.")
|
||||
(P-IOINTERRUPT FLAG)
|
||||
(P-GCDISABLED FLAG) (* \; "No mroe room in GC tables.")
|
||||
(P-VMEMFULL FLAG) (* \; "VMEM is full!!")
|
||||
(P-STACKOVERFLOW FLAG) (* \; "Stack overflowed.")
|
||||
(P-STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.")
|
||||
(P-WAITINGINTERRUPT FLAG)
|
||||
(INTCHARCODE WORD))
|
||||
(BLOCKRECORD INTERRUPTSTATE (
|
||||
(* |;;| "Alternative view of the structure:")
|
||||
|
||||
(PENDING BITS 8)
|
||||
(PENDING BITS 8)
|
||||
(* \; "Pending-interrupt flags")
|
||||
(IN-PROGRESS BITS 8)
|
||||
(IN-PROGRESS BITS 8)
|
||||
(* \;
|
||||
"Mask to prevent re-interrupt for an interrupt in progress")
|
||||
(NIL WORD))))
|
||||
"Mask to prevent re-interrupt for an interrupt in progress")
|
||||
(NIL WORD))))
|
||||
)
|
||||
|
||||
(PUTPROPS \\TAKEINTERRUPT DMACRO ((PREFORM POSTFORM)
|
||||
(DECLARE (GLOBALVARS \\PENDINGINTERRUPT))
|
||||
(COND
|
||||
((AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK))
|
||||
PREFORM
|
||||
((LAMBDA (\\INTERRUPTABLE)
|
||||
(\\CALLINTERRUPTED))
|
||||
T)
|
||||
POSTFORM))))
|
||||
(DECLARE (GLOBALVARS \\PENDINGINTERRUPT))
|
||||
(COND
|
||||
((AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK))
|
||||
PREFORM
|
||||
((LAMBDA (\\INTERRUPTABLE)
|
||||
(\\CALLINTERRUPTED))
|
||||
T)
|
||||
POSTFORM))))
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@@ -789,16 +795,18 @@ DONTCOPY
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \\SYSTEMINTERRUPTP MACRO ((KEY)
|
||||
(ASSOC KEY \\SYSTEMINTERRUPTS)))
|
||||
(ASSOC KEY \\SYSTEMINTERRUPTS)))
|
||||
)
|
||||
)
|
||||
(PUTPROPS AINTERRUPT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1989 1990
|
||||
1992))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INTCHAR T)
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (2572 28843 (INTCHAR 2582 . 7650) (INTERRUPTCHAR 7652 . 7926) (INTERRUPTED 7928 . 15507)
|
||||
(LISPINTERRUPTS 15509 . 16026) (\\DOHELPINTERRUPT 16028 . 16926) (\\DOHELPINTERRUPT1 16928 . 18326) (
|
||||
\\DOINTERRUPTHERE 18328 . 19508) (\\PROC.FINDREALFRAME 19510 . 20314) (\\SETPRINTLEVEL 20316 . 22268)
|
||||
(\\SETRECLAIMMIN 22270 . 23143) (GETINTERRUPT 23145 . 24519) (CURRENTINTERRUPTS 24521 . 24731) (
|
||||
SETINTERRUPT 24733 . 26711) (RESET.INTERRUPTS 26713 . 28670) (INTERRUPTABLE 28672 . 28841)) (28991
|
||||
34975 (CONTROL-T 29001 . 34442) (\\CONTROL-T.PRINTRATIO 34444 . 34973)))))
|
||||
(FILEMAP (NIL (2924 29142 (INTCHAR 2934 . 7957) (INTERRUPTCHAR 7959 . 8233) (INTERRUPTED 8235 . 15814)
|
||||
(LISPINTERRUPTS 15816 . 16343) (\\DOHELPINTERRUPT 16345 . 17243) (\\DOHELPINTERRUPT1 17245 . 18643) (
|
||||
\\DOINTERRUPTHERE 18645 . 19825) (\\PROC.FINDREALFRAME 19827 . 20631) (\\SETPRINTLEVEL 20633 . 22585)
|
||||
(\\SETRECLAIMMIN 22587 . 23460) (GETINTERRUPT 23462 . 24818) (CURRENTINTERRUPTS 24820 . 25030) (
|
||||
SETINTERRUPT 25032 . 27010) (RESET.INTERRUPTS 27012 . 28969) (INTERRUPTABLE 28971 . 29140)) (29562
|
||||
35546 (CONTROL-T 29572 . 35013) (\\CONTROL-T.PRINTRATIO 35015 . 35544)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-May-2023 07:12:28" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;5 30540
|
||||
(FILECREATED " 9-Apr-2024 12:59:40" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;2 32347
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS PATHNAME)
|
||||
|
||||
:PREVIOUS-DATE "30-Apr-2023 14:00:37" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;4)
|
||||
:PREVIOUS-DATE "23-Mar-2024 22:31:11" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CMLPATHNAMECOMS)
|
||||
@@ -40,8 +38,8 @@
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES
|
||||
PATHNAME %%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME])
|
||||
(LAMA CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME %%PRINT-PATHNAME
|
||||
])
|
||||
|
||||
|
||||
|
||||
@@ -84,8 +82,10 @@
|
||||
(DEFINEQ
|
||||
|
||||
(%%PRINT-PATHNAME
|
||||
(CL:LAMBDA (S STREAM D) (* hdj "19-Sep-86 15:49") (DECLARE (IGNORE D)) (CL:FORMAT STREAM "#.(~S ~S)" (QUOTE PATHNAME) (CL:NAMESTRING S)))
|
||||
)
|
||||
(CL:LAMBDA (S STREAM D) (* ; "Edited 23-Mar-2024 22:25 by lmm")
|
||||
(* hdj "19-Sep-86 15:49")
|
||||
(DECLARE (IGNORE D))
|
||||
(CL:FORMAT STREAM "#P~S" (CL:NAMESTRING S))))
|
||||
|
||||
(CL:MAKE-PATHNAME
|
||||
(CL:LAMBDA (&KEY DEFAULTS (HOST NIL HOSTP)
|
||||
@@ -500,21 +500,62 @@
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME %%PRINT-PATHNAME)
|
||||
)
|
||||
(PRETTYCOMPRINT CMLPATHNAMECOMS)
|
||||
|
||||
(RPAQQ CMLPATHNAMECOMS
|
||||
[
|
||||
(* ;; "Common Lisp pathname functions")
|
||||
|
||||
(PROP FILETYPE CMLPATHNAME)
|
||||
(COMS
|
||||
(* ;; "useful macros")
|
||||
|
||||
(FUNCTIONS %%WILD-NAME %%COMPONENT-STRING))
|
||||
(STRUCTURES PATHNAME DIRECTORY-COMPONENT)
|
||||
(FNS %%PRINT-PATHNAME CL:MAKE-PATHNAME %%PRINT-DIRECTORY-COMPONENT)
|
||||
(FUNCTIONS CL:PATHNAME-HOST CL:PATHNAME-DEVICE CL:PATHNAME-DIRECTORY CL:PATHNAME-NAME
|
||||
CL:PATHNAME-TYPE CL:PATHNAME-VERSION)
|
||||
(FNS PATHNAME CL:MERGE-PATHNAMES FILE-NAME CL:HOST-NAMESTRING CL:ENOUGH-NAMESTRING
|
||||
%%NUMERIC-STRING-P)
|
||||
(FUNCTIONS CL:NAMESTRING CL:PARSE-NAMESTRING CL:TRUENAME)
|
||||
(FUNCTIONS %%MAKE-PATHNAME)
|
||||
(FUNCTIONS %%PATHNAME-EQUAL %%DIRECTORY-COMPONENT-EQUAL)
|
||||
(FUNCTIONS %%INITIALIZE-DEFAULT-PATHNAME)
|
||||
(VARIABLES *DEFAULT-PATHNAME-DEFAULTS*)
|
||||
(COMS
|
||||
(* ;; "Interlisp-D compatibility")
|
||||
|
||||
(FUNCTIONS INTERLISP-NAMESTRING UNPACKPATHNAME.STRING))
|
||||
(FUNCTIONS CL:FILE-NAMESTRING CL:DIRECTORY-NAMESTRING)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (%%INITIALIZE-DEFAULT-PATHNAME)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES
|
||||
PATHNAME %%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES PATHNAME
|
||||
%%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2012 2143 (%%WILD-NAME 2012 . 2143)) (2145 2224 (%%COMPONENT-STRING 2145 . 2224)) (2829
|
||||
8600 (%%PRINT-PATHNAME 2839 . 3000) (CL:MAKE-PATHNAME 3002 . 7752) (%%PRINT-DIRECTORY-COMPONENT 7754
|
||||
. 8598)) (8602 8795 (CL:PATHNAME-HOST 8602 . 8795)) (8797 8996 (CL:PATHNAME-DEVICE 8797 . 8996)) (
|
||||
8998 9206 (CL:PATHNAME-DIRECTORY 8998 . 9206)) (9208 9401 (CL:PATHNAME-NAME 9208 . 9401)) (9403 9596 (
|
||||
CL:PATHNAME-TYPE 9403 . 9596)) (9598 9800 (CL:PATHNAME-VERSION 9598 . 9800)) (9801 15390 (PATHNAME
|
||||
9811 . 10268) (CL:MERGE-PATHNAMES 10270 . 12356) (FILE-NAME 12358 . 12499) (CL:HOST-NAMESTRING 12501
|
||||
. 12690) (CL:ENOUGH-NAMESTRING 12692 . 15157) (%%NUMERIC-STRING-P 15159 . 15388)) (15392 19145 (
|
||||
CL:NAMESTRING 15392 . 19145)) (19147 22618 (CL:PARSE-NAMESTRING 19147 . 22618)) (22620 23623 (
|
||||
CL:TRUENAME 22620 . 23623)) (23625 23817 (%%MAKE-PATHNAME 23625 . 23817)) (23819 24456 (
|
||||
%%PATHNAME-EQUAL 23819 . 24456)) (24458 24915 (%%DIRECTORY-COMPONENT-EQUAL 24458 . 24915)) (24917
|
||||
25540 (%%INITIALIZE-DEFAULT-PATHNAME 24917 . 25540)) (25630 25797 (INTERLISP-NAMESTRING 25630 . 25797)
|
||||
) (25799 28692 (UNPACKPATHNAME.STRING 25799 . 28692)) (28694 29951 (CL:FILE-NAMESTRING 28694 . 29951))
|
||||
(29953 30151 (CL:DIRECTORY-NAMESTRING 29953 . 30151)))))
|
||||
(FILEMAP (NIL (1912 2043 (%%WILD-NAME 1912 . 2043)) (2045 2124 (%%COMPONENT-STRING 2045 . 2124)) (2729
|
||||
8653 (%%PRINT-PATHNAME 2739 . 3053) (CL:MAKE-PATHNAME 3055 . 7805) (%%PRINT-DIRECTORY-COMPONENT 7807
|
||||
. 8651)) (8655 8848 (CL:PATHNAME-HOST 8655 . 8848)) (8850 9049 (CL:PATHNAME-DEVICE 8850 . 9049)) (
|
||||
9051 9259 (CL:PATHNAME-DIRECTORY 9051 . 9259)) (9261 9454 (CL:PATHNAME-NAME 9261 . 9454)) (9456 9649 (
|
||||
CL:PATHNAME-TYPE 9456 . 9649)) (9651 9853 (CL:PATHNAME-VERSION 9651 . 9853)) (9854 15443 (PATHNAME
|
||||
9864 . 10321) (CL:MERGE-PATHNAMES 10323 . 12409) (FILE-NAME 12411 . 12552) (CL:HOST-NAMESTRING 12554
|
||||
. 12743) (CL:ENOUGH-NAMESTRING 12745 . 15210) (%%NUMERIC-STRING-P 15212 . 15441)) (15445 19198 (
|
||||
CL:NAMESTRING 15445 . 19198)) (19200 22671 (CL:PARSE-NAMESTRING 19200 . 22671)) (22673 23676 (
|
||||
CL:TRUENAME 22673 . 23676)) (23678 23870 (%%MAKE-PATHNAME 23678 . 23870)) (23872 24509 (
|
||||
%%PATHNAME-EQUAL 23872 . 24509)) (24511 24968 (%%DIRECTORY-COMPONENT-EQUAL 24511 . 24968)) (24970
|
||||
25593 (%%INITIALIZE-DEFAULT-PATHNAME 24970 . 25593)) (25683 25850 (INTERLISP-NAMESTRING 25683 . 25850)
|
||||
) (25852 28745 (UNPACKPATHNAME.STRING 25852 . 28745)) (28747 30004 (CL:FILE-NAMESTRING 28747 . 30004))
|
||||
(30006 30204 (CL:DIRECTORY-NAMESTRING 30006 . 30204)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,20 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Mar-95 12:41:10" {DSK}<lispcore>sources>CMLREADTABLE.;4 27688
|
||||
|
||||
changes to%: (FNS CMLREADSEMI)
|
||||
(FILECREATED "23-Mar-2024 22:05:12" {DSK}<home>larry>il>medley>sources>CMLREADTABLE.;2 27563
|
||||
|
||||
previous date%: "16-May-90 14:24:30" {DSK}<lispcore>sources>CMLREADTABLE.;1)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS CMLREADTABLECOMS)
|
||||
(FUNCTIONS HASH-P)
|
||||
(FNS SET-DEFAULT-HASHMACRO-SETTINGS)
|
||||
|
||||
:PREVIOUS-DATE "13-Mar-95 12:41:10" {DSK}<home>larry>il>medley>sources>CMLREADTABLE.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CMLREADTABLECOMS)
|
||||
|
||||
(RPAQQ CMLREADTABLECOMS
|
||||
((COMS (* ;
|
||||
"Common Lisp readtable interface functions ")
|
||||
"Common Lisp readtable interface functions ")
|
||||
(FUNCTIONS HASH-LEFT-PAD-INITIAL-CONTENTS CL:SET-SYNTAX-FROM-CHAR
|
||||
CL:GET-DISPATCH-MACRO-CHARACTER CL:GET-MACRO-CHARACTER
|
||||
CL:MAKE-DISPATCH-MACRO-CHARACTER CL:SET-DISPATCH-MACRO-CHARACTER
|
||||
@@ -24,8 +25,8 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(COMS (* ; "hash macro sub functions")
|
||||
(FUNCTIONS HASH-LEFTPAREN HASH-A HASH-B HASH-BACKSLASH HASH-C HASH-COLON HASH-COMMA
|
||||
HASH-DOT HASH-DOUBLEQUOTE HASH-ILLEGAL-HASH-CHAR HASH-LEFTANGLE HASH-MINUS
|
||||
HASH-NO-PARAMETER-ERROR HASH-O HASH-PLUS HASH-QUOTE HASH-R HASH-S HASH-STAR
|
||||
HASH-VBAR HASH-X HASH-EQUAL HASH-NUMBER-SIGN HASH-STRUCTURE-SMASH
|
||||
HASH-NO-PARAMETER-ERROR HASH-O HASH-P HASH-PLUS HASH-QUOTE HASH-R HASH-S
|
||||
HASH-STAR HASH-VBAR HASH-X HASH-EQUAL HASH-NUMBER-SIGN HASH-STRUCTURE-SMASH
|
||||
HASH-STRUCTURE-LOOKUP)
|
||||
(* ; "Temporary")
|
||||
(VARIABLES *READ-SUPPRESS*))
|
||||
@@ -47,16 +48,14 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(T (CL:ERROR "Values list too long for #~D()" SIZE])
|
||||
|
||||
(CL:DEFUN CL:SET-SYNTAX-FROM-CHAR (TO-CHAR FROM-CHAR &OPTIONAL (TO-READTABLE *READTABLE*)
|
||||
(FROM-READTABLE CMLRDTBL))
|
||||
(FROM-READTABLE CMLRDTBL))
|
||||
(SETSYNTAX (CL:CHAR-CODE TO-CHAR)
|
||||
(GETSYNTAX (CL:CHAR-CODE FROM-CHAR)
|
||||
FROM-READTABLE)
|
||||
TO-READTABLE))
|
||||
|
||||
(CL:DEFUN CL:GET-DISPATCH-MACRO-CHARACTER (DISP-CHAR SUB-CHAR &OPTIONAL (READTABLE *READTABLE*))
|
||||
[CDR (ASSOC SUB-CHAR (CDR (ASSOC DISP-CHAR (fetch (READTABLEP DISPATCHMACRODEFS) of
|
||||
READTABLE
|
||||
])
|
||||
[CDR (ASSOC SUB-CHAR (CDR (ASSOC DISP-CHAR (fetch (READTABLEP DISPATCHMACRODEFS) of READTABLE])
|
||||
|
||||
(CL:DEFUN CL:GET-MACRO-CHARACTER (CHAR &OPTIONAL (READTABLE *READTABLE*))
|
||||
|
||||
@@ -77,8 +76,7 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(CL:VALUES (FIND-MACRO-FUNCTION (CAR TABENTRY))
|
||||
(NEQ NON-TERMINATING-P 'ALWAYS])
|
||||
|
||||
(CL:DEFUN CL:MAKE-DISPATCH-MACRO-CHARACTER (CHAR &OPTIONAL NON-TERMINATING (READTABLE *READTABLE*
|
||||
))
|
||||
(CL:DEFUN CL:MAKE-DISPATCH-MACRO-CHARACTER (CHAR &OPTIONAL NON-TERMINATING (READTABLE *READTABLE*))
|
||||
(SETSYNTAX (CL:CHAR-CODE CHAR)
|
||||
`[MACRO ,(CL:IF NON-TERMINATING
|
||||
'FIRST
|
||||
@@ -88,27 +86,25 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
READTABLE)
|
||||
T)
|
||||
|
||||
(CL:DEFUN CL:SET-DISPATCH-MACRO-CHARACTER (DISP-CHAR SUB-CHAR FUNCTION &OPTIONAL (READTABLE
|
||||
*READTABLE*))
|
||||
(CL:DEFUN CL:SET-DISPATCH-MACRO-CHARACTER (DISP-CHAR SUB-CHAR FUNCTION &OPTIONAL (READTABLE
|
||||
*READTABLE*))
|
||||
(CL:IF (CL:DIGIT-CHAR-P SUB-CHAR)
|
||||
(CL:ERROR "Digit ~S illegal as a sub-character for a dispatching macro" SUB-CHAR))
|
||||
(SETQ SUB-CHAR (CL:CHAR-UPCASE SUB-CHAR))
|
||||
(LET ((DISP-TABLE (OR (ASSOC DISP-CHAR (fetch (READTABLEP DISPATCHMACRODEFS) of READTABLE)
|
||||
)
|
||||
(LET ((DISP-TABLE (OR (ASSOC DISP-CHAR (fetch (READTABLEP DISPATCHMACRODEFS) of READTABLE))
|
||||
(LET ((NEWTABLE (LIST DISP-CHAR)))
|
||||
(push (fetch (READTABLEP DISPATCHMACRODEFS) of READTABLE)
|
||||
NEWTABLE)
|
||||
NEWTABLE)
|
||||
NEWTABLE)))
|
||||
DISP-CONS)
|
||||
(if (SETQ DISP-CONS (ASSOC SUB-CHAR (CDR DISP-TABLE)))
|
||||
then (CL:SETF (CDR DISP-CONS)
|
||||
FUNCTION)
|
||||
FUNCTION)
|
||||
else (push (CDR DISP-TABLE)
|
||||
(CONS SUB-CHAR FUNCTION)))
|
||||
(CONS SUB-CHAR FUNCTION)))
|
||||
T))
|
||||
|
||||
(CL:DEFUN CL:SET-MACRO-CHARACTER (CHAR FUNCTION &OPTIONAL NON-TERMINATING (READTABLE *READTABLE*)
|
||||
)
|
||||
(CL:DEFUN CL:SET-MACRO-CHARACTER (CHAR FUNCTION &OPTIONAL NON-TERMINATING (READTABLE *READTABLE*))
|
||||
(SETSYNTAX (CL:CHAR-CODE CHAR)
|
||||
`[MACRO ,(CL:IF NON-TERMINATING
|
||||
'FIRST
|
||||
@@ -128,23 +124,23 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
((NOT DISP-TABLE)
|
||||
(CL:ERROR "~S is not a dispatch macro character" CHAR))
|
||||
(T (* ;
|
||||
"DISPATCHMACRODEFS is a list of A-lists")
|
||||
"DISPATCHMACRODEFS is a list of A-lists")
|
||||
[while (DIGITCHARP (SETQ NEXTCHAR (READCCODE STREAM RDTBL)))
|
||||
do (* ; "read the optional numeric arg")
|
||||
(SETQ INDEX (+ (TIMES (OR INDEX 0)
|
||||
10)
|
||||
(- NEXTCHAR (CHARCODE 0]
|
||||
do (* ; "read the optional numeric arg")
|
||||
(SETQ INDEX (+ (TIMES (OR INDEX 0)
|
||||
10)
|
||||
(- NEXTCHAR (CHARCODE 0]
|
||||
(LET* [(DISP-CHARACTER (CL:CHAR-UPCASE (CL:CODE-CHAR NEXTCHAR)))
|
||||
(DISP-FUNCTION (CDR (ASSOC DISP-CHARACTER DISP-TABLE]
|
||||
(if DISP-FUNCTION
|
||||
then (CL:FUNCALL DISP-FUNCTION STREAM DISP-CHARACTER INDEX)
|
||||
else (CL:IF *READ-SUPPRESS*
|
||||
(PROGN (* ; "Attempt to ignore it")
|
||||
(READ-EXTENDED-TOKEN STREAM *READTABLE* T)
|
||||
NIL)
|
||||
(CL:ERROR
|
||||
(PROGN (* ; "Attempt to ignore it")
|
||||
(READ-EXTENDED-TOKEN STREAM *READTABLE* T)
|
||||
NIL)
|
||||
(CL:ERROR
|
||||
"Undefined dispatch character ~S for dispatch macro character ~S"
|
||||
DISP-CHARACTER CHAR))])
|
||||
DISP-CHARACTER CHAR))])
|
||||
|
||||
(CL:DEFUN FIND-MACRO-FUNCTION (FORM)
|
||||
(COND
|
||||
@@ -229,19 +225,19 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(LIST '\, `(COERCE ,(LIST 'BQUOTE CONTENTS)
|
||||
'CL:VECTOR]
|
||||
(INDEX (IF (<= (LENGTH CONTENTS)
|
||||
INDEX)
|
||||
INDEX)
|
||||
THEN (LET [(VEC (CL:MAKE-ARRAY INDEX :INITIAL-ELEMENT (CAR (LAST CONTENTS]
|
||||
[LET ((XCL-USER::T0 (LENGTH CONTENTS))
|
||||
(I 0))
|
||||
(CL:BLOCK NIL
|
||||
(LET NIL (CL:TAGBODY LOOPTAG0015 (COND
|
||||
((>= I XCL-USER::T0)
|
||||
(RETURN NIL)))
|
||||
(CL:SETF (CL:AREF VEC I)
|
||||
(POP CONTENTS))
|
||||
(CL:INCF I)
|
||||
(GO LOOPTAG0015))))]
|
||||
VEC)
|
||||
[LET ((XCL-USER::T0 (LENGTH CONTENTS))
|
||||
(I 0))
|
||||
(CL:BLOCK NIL
|
||||
(LET NIL (CL:TAGBODY LOOPTAG0015 (COND
|
||||
((>= I XCL-USER::T0)
|
||||
(RETURN NIL)))
|
||||
(CL:SETF (CL:AREF VEC I)
|
||||
(POP CONTENTS))
|
||||
(CL:INCF I)
|
||||
(GO LOOPTAG0015))))]
|
||||
VEC)
|
||||
ELSE (CL:ERROR "Values list too long for #~D()" INDEX)))
|
||||
(T (CL:MAKE-ARRAY (LENGTH CONTENTS)
|
||||
:INITIAL-CONTENTS CONTENTS])
|
||||
@@ -280,7 +276,7 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(CL:READ STREAM T NIL T)
|
||||
(COMPLEX NUM DEN])
|
||||
|
||||
(CL:DEFUN HASH-COLON (STREAM CHAR PARAM) (* ; "Uninterned symbol.")
|
||||
(CL:DEFUN HASH-COLON (STREAM CHAR PARAM) (* ; "Uninterned symbol.")
|
||||
[COND
|
||||
(*READ-SUPPRESS* (READ-EXTENDED-TOKEN STREAM *READTABLE* T)
|
||||
NIL)
|
||||
@@ -354,6 +350,9 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(T (HASH-NO-PARAMETER-ERROR CHAR PARAM)
|
||||
(READNUMBERINBASE STREAM 8))))
|
||||
|
||||
(CL:DEFUN HASH-P (STREAM CHAR PARAM) (* ; "Edited 23-Mar-2024 22:01 by lmm")
|
||||
(PATHNAME (CL:READ STREAM T NIL T)))
|
||||
|
||||
(CL:DEFUN HASH-PLUS (STREAM CHAR PARAM)
|
||||
|
||||
(* ;; "When *READ-SUPPRESS* is true, we want to simply skip over the two forms (the feature expression and the controlled expression). Otherwise, we read the feature expression and, unless it applies to us, skip over the controlled expression. In any case, we never return a value.")
|
||||
@@ -393,45 +392,45 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
(CL:DEFUN HASH-STAR (STREAM CHAR PARAM)
|
||||
(DECLARE (IGNORE CHAR))
|
||||
[IF (EQ (PEEKC STREAM)
|
||||
'%()
|
||||
THEN (* ; "It's a bitmap.")
|
||||
(IF *READ-SUPPRESS*
|
||||
THEN (CL:READ STREAM NIL NIL T)
|
||||
(CL:READ STREAM NIL NIL T)
|
||||
ELSEIF PARAM
|
||||
THEN (CL:ERROR "Unexpected parameter ~S given in #* bitmap syntax." PARAM)
|
||||
ELSE (FINISH-READING-BITMAP STREAM))
|
||||
ELSE (* ; "It's a bit-vector.")
|
||||
(LET* ((CONTENTS (READ-EXTENDED-TOKEN STREAM))
|
||||
(LEN (NCHARS CONTENTS)))
|
||||
(IF *READ-SUPPRESS*
|
||||
THEN NIL
|
||||
ELSEIF (AND (EQ LEN 0)
|
||||
PARAM
|
||||
(NEQ PARAM 0))
|
||||
THEN (CL:ERROR "No contents specified for bit vector #~A*" PARAM)
|
||||
ELSEIF (AND PARAM (> LEN PARAM))
|
||||
THEN (CL:ERROR "Bit vector contents longer than specified length in #~A*~A"
|
||||
PARAM CONTENTS)
|
||||
ELSE (LET [(BITARRAY (CL:MAKE-ARRAY (OR PARAM LEN)
|
||||
:ELEMENT-TYPE
|
||||
'BIT :INITIAL-ELEMENT
|
||||
(IF (AND PARAM (> PARAM LEN 0))
|
||||
THEN (SELCHARQ (NTHCHARCODE CONTENTS -1)
|
||||
(0 0)
|
||||
(1 1)
|
||||
(CL:ERROR
|
||||
'%()
|
||||
THEN (* ; "It's a bitmap.")
|
||||
(IF *READ-SUPPRESS*
|
||||
THEN (CL:READ STREAM NIL NIL T)
|
||||
(CL:READ STREAM NIL NIL T)
|
||||
ELSEIF PARAM
|
||||
THEN (CL:ERROR "Unexpected parameter ~S given in #* bitmap syntax." PARAM)
|
||||
ELSE (FINISH-READING-BITMAP STREAM))
|
||||
ELSE (* ; "It's a bit-vector.")
|
||||
(LET* ((CONTENTS (READ-EXTENDED-TOKEN STREAM))
|
||||
(LEN (NCHARS CONTENTS)))
|
||||
(IF *READ-SUPPRESS*
|
||||
THEN NIL
|
||||
ELSEIF (AND (EQ LEN 0)
|
||||
PARAM
|
||||
(NEQ PARAM 0))
|
||||
THEN (CL:ERROR "No contents specified for bit vector #~A*" PARAM)
|
||||
ELSEIF (AND PARAM (> LEN PARAM))
|
||||
THEN (CL:ERROR "Bit vector contents longer than specified length in #~A*~A" PARAM
|
||||
CONTENTS)
|
||||
ELSE (LET [(BITARRAY (CL:MAKE-ARRAY (OR PARAM LEN)
|
||||
:ELEMENT-TYPE
|
||||
'BIT :INITIAL-ELEMENT
|
||||
(IF (AND PARAM (> PARAM LEN 0))
|
||||
THEN (SELCHARQ (NTHCHARCODE CONTENTS -1)
|
||||
(0 0)
|
||||
(1 1)
|
||||
(CL:ERROR
|
||||
"Illegal bit vector element in #~A*~A"
|
||||
PARAM CONTENTS))
|
||||
ELSE 0]
|
||||
(CL:DOTIMES (I LEN)
|
||||
(CL:SETF (CL:AREF BITARRAY I)
|
||||
(SELCHARQ (NTHCHARCODE CONTENTS (CL:1+ I))
|
||||
(0 0)
|
||||
(1 1)
|
||||
(CL:ERROR "Illegal bit vector element in #~A*~A"
|
||||
PARAM CONTENTS))))
|
||||
BITARRAY])
|
||||
PARAM CONTENTS))
|
||||
ELSE 0]
|
||||
(CL:DOTIMES (I LEN)
|
||||
(CL:SETF (CL:AREF BITARRAY I)
|
||||
(SELCHARQ (NTHCHARCODE CONTENTS (CL:1+ I))
|
||||
(0 0)
|
||||
(1 1)
|
||||
(CL:ERROR "Illegal bit vector element in #~A*~A" PARAM
|
||||
CONTENTS))))
|
||||
BITARRAY])
|
||||
|
||||
(CL:DEFUN HASH-VBAR (STREAM CHAR PARAM)
|
||||
(OR *READ-SUPPRESS* (HASH-NO-PARAMETER-ERROR CHAR PARAM))
|
||||
@@ -575,30 +574,32 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
NIL READ-LINE-RDTBL])
|
||||
|
||||
(SET-DEFAULT-HASHMACRO-SETTINGS
|
||||
[LAMBDA (RDTBL) (* jrb%: "10-Nov-86 15:46")
|
||||
[LAMBDA (RDTBL) (* ; "Edited 23-Mar-2024 21:57 by lmm")
|
||||
(* jrb%: "10-Nov-86 15:46")
|
||||
(READTABLEPROP RDTBL 'HASHMACROCHAR (CHARCODE "#"))
|
||||
(CL:MAKE-DISPATCH-MACRO-CHARACTER #\# T RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\( 'HASH-LEFTPAREN RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\' 'HASH-QUOTE RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\. 'HASH-DOT RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\, 'HASH-COMMA RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\\ 'HASH-BACKSLASH RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\* 'HASH-STAR RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\: 'HASH-COLON RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\O 'HASH-O RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\B 'HASH-B RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\X 'HASH-X RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\R 'HASH-R RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\A 'HASH-A RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\S 'HASH-S RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\C 'HASH-C RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\+ 'HASH-PLUS RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\- 'HASH-MINUS RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\| 'HASH-VBAR RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\< 'HASH-LEFTANGLE RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\" 'HASH-DOUBLEQUOTE RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\= 'HASH-EQUAL RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\# 'HASH-NUMBER-SIGN RDTBL)
|
||||
(CL:MAKE-DISPATCH-MACRO-CHARACTER #\# T RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\( 'HASH-LEFTPAREN RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\' 'HASH-QUOTE RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\. 'HASH-DOT RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\, 'HASH-COMMA RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\\ 'HASH-BACKSLASH RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\* 'HASH-STAR RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\: 'HASH-COLON RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\O 'HASH-O RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\B 'HASH-B RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\X 'HASH-X RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\R 'HASH-R RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\A 'HASH-A RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\S 'HASH-S RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\C 'HASH-C RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\P 'HASH-P RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\+ 'HASH-PLUS RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\- 'HASH-MINUS RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\| 'HASH-VBAR RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\< 'HASH-LEFTANGLE RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\" 'HASH-DOUBLEQUOTE RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\= 'HASH-EQUAL RDTBL)
|
||||
(CL:SET-DISPATCH-MACRO-CHARACTER #\# #\# 'HASH-NUMBER-SIGN RDTBL)
|
||||
RDTBL])
|
||||
|
||||
(CMLREADSEMI
|
||||
@@ -617,8 +618,26 @@ Copyright (c) 1986, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r
|
||||
)
|
||||
|
||||
(PUTPROPS CMLREADTABLE FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS CMLREADTABLE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1995))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22724 27461 (CMLRDTBL 22734 . 24394) (INIT-CML-READTABLES 24396 . 25532) (
|
||||
SET-DEFAULT-HASHMACRO-SETTINGS 25534 . 27112) (CMLREADSEMI 27114 . 27459)))))
|
||||
(FILEMAP (NIL (2167 2474 (HASH-LEFT-PAD-INITIAL-CONTENTS 2167 . 2474)) (2476 2778 (
|
||||
CL:SET-SYNTAX-FROM-CHAR 2476 . 2778)) (2780 2987 (CL:GET-DISPATCH-MACRO-CHARACTER 2780 . 2987)) (2989
|
||||
3795 (CL:GET-MACRO-CHARACTER 2989 . 3795)) (3797 4179 (CL:MAKE-DISPATCH-MACRO-CHARACTER 3797 . 4179))
|
||||
(4181 5178 (CL:SET-DISPATCH-MACRO-CHARACTER 4181 . 5178)) (5180 5643 (CL:SET-MACRO-CHARACTER 5180 .
|
||||
5643)) (5645 7242 (DO-DISPATCH-MACRO 5645 . 7242)) (7244 7427 (FIND-MACRO-FUNCTION 7244 . 7427)) (7429
|
||||
7852 (CL-MACRO-WRAPPED-P 7429 . 7852)) (7854 7986 (CL-UNWRAP-MACRO 7854 . 7986)) (7988 8197 (
|
||||
CL-WRAP-MACRO 7988 . 8197)) (8199 8675 (IL-MACRO-WRAPPED-P 8199 . 8675)) (8677 8744 (IL-UNWRAP-MACRO
|
||||
8677 . 8744)) (8746 8941 (IL-WRAP-MACRO 8746 . 8941)) (8984 10755 (HASH-LEFTPAREN 8984 . 10755)) (
|
||||
10757 11010 (HASH-A 10757 . 11010)) (11012 11235 (HASH-B 11012 . 11235)) (11237 11641 (HASH-BACKSLASH
|
||||
11237 . 11641)) (11643 11923 (HASH-C 11643 . 11923)) (11925 12232 (HASH-COLON 11925 . 12232)) (12234
|
||||
12911 (HASH-COMMA 12234 . 12911)) (12913 13259 (HASH-DOT 12913 . 13259)) (13261 13618 (
|
||||
HASH-DOUBLEQUOTE 13261 . 13618)) (13620 13730 (HASH-ILLEGAL-HASH-CHAR 13620 . 13730)) (13732 13890 (
|
||||
HASH-LEFTANGLE 13732 . 13890)) (13892 14709 (HASH-MINUS 13892 . 14709)) (14711 14849 (
|
||||
HASH-NO-PARAMETER-ERROR 14711 . 14849)) (14851 15074 (HASH-O 14851 . 15074)) (15076 15228 (HASH-P
|
||||
15076 . 15228)) (15230 16052 (HASH-PLUS 15230 . 16052)) (16054 16277 (HASH-QUOTE 16054 . 16277)) (
|
||||
16279 16507 (HASH-R 16279 . 16507)) (16509 16727 (HASH-S 16509 . 16727)) (16729 19267 (HASH-STAR 16729
|
||||
. 19267)) (19269 19476 (HASH-VBAR 19269 . 19476)) (19478 19702 (HASH-X 19478 . 19702)) (19704 20200 (
|
||||
HASH-EQUAL 19704 . 20200)) (20202 20474 (HASH-NUMBER-SIGN 20202 . 20474)) (20476 22174 (
|
||||
HASH-STRUCTURE-SMASH 20476 . 22174)) (22176 22307 (HASH-STRUCTURE-LOOKUP 22176 . 22307)) (22418 27420
|
||||
(CMLRDTBL 22428 . 24088) (INIT-CML-READTABLES 24090 . 25226) (SET-DEFAULT-HASHMACRO-SETTINGS 25228 .
|
||||
27071) (CMLREADSEMI 27073 . 27418)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Jan-2024 10:59:18" {DSK}<home>larry>il>medley>sources>EXTERNALFORMAT.;3 38380
|
||||
(FILECREATED "19-Mar-2024 18:24:39" {WMEDLEY}<sources>EXTERNALFORMAT.;88 38921
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \BACKCCODE)
|
||||
:CHANGES-TO (FNS \FORMATBYTESTRING \FORMATBYTESTREAM)
|
||||
|
||||
:PREVIOUS-DATE " 8-Dec-2023 22:02:21" {DSK}<home>larry>il>medley>sources>EXTERNALFORMAT.;1)
|
||||
:PREVIOUS-DATE "12-Jan-2024 10:59:18" {WMEDLEY}<sources>EXTERNALFORMAT.;86)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
@@ -472,6 +472,10 @@
|
||||
(\FORMATBYTESTREAM
|
||||
[LAMBDA (STREAM BYTESTREAM)
|
||||
|
||||
(* ;; "Edited 19-Mar-2024 15:57 by rmk: Remove installation of STREAM's EXTERNALFORMAT into BYTESTREAM. That should be done by the formats FORMATBYTESTREAMFN. In particular,")
|
||||
|
||||
(* ;; "Edited 19-Mar-2024 14:31 by rmk")
|
||||
|
||||
(* ;; "Edited 24-Jul-2022 08:30 by rmk: STREAM can be the external format to be used for BYTESTREAM, not just a carrier of that format")
|
||||
|
||||
(* ;; "Edited 22-Jun-2022 11:09 by rmk")
|
||||
@@ -495,27 +499,33 @@
|
||||
ELSEIF (TYPE? EXTERNALFORMAT STREAM)
|
||||
THEN (SETQ FORMAT STREAM)
|
||||
(SETQ EOLC (FFETCH (EXTERNALFORMAT EOL) OF FORMAT)))
|
||||
(\EXTERNALFORMAT BYTESTREAM FORMAT)
|
||||
(REPLACE (STREAM EOLCONVENTION) OF BYTESTREAM WITH EOLC)
|
||||
(\SETFILEPTR BYTESTREAM 0)
|
||||
(freplace (STREAM ENDOFSTREAMOP) of BYTESTREAM with (FUNCTION NILL))
|
||||
|
||||
(* ;; "Presumably any format-specific cleanup function will know what to do if it receives a format instead of a stream.")
|
||||
|
||||
(CL:WHEN (FFETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
(APPLY* (FFETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
STREAM BYTESTREAM))
|
||||
(SETQ BYTESTREAM (APPLY* (FFETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
STREAM BYTESTREAM)))
|
||||
|
||||
(* ;; "Maybe the function said no?")
|
||||
|
||||
(CL:WHEN BYTESTREAM
|
||||
(freplace (STREAM ENDOFSTREAMOP) of BYTESTREAM with (FUNCTION NILL)))
|
||||
BYTESTREAM])
|
||||
|
||||
(\FORMATBYTESTRING
|
||||
[LAMBDA (STREAM STRING) (* ; "Edited 10-Jul-2022 16:39 by rmk")
|
||||
[LAMBDA (STREAM STRING) (* ; "Edited 19-Mar-2024 18:24 by rmk")
|
||||
(* ; "Edited 10-Jul-2022 16:39 by rmk")
|
||||
(* ; "Edited 22-Jun-2022 11:07 by rmk")
|
||||
(* ; "Edited 18-Jun-2022 22:04 by rmk")
|
||||
(WITH-RESOURCE \FORMATBYTESTRING.STREAM (\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(LET [FSTRING NBYTES (BYTESTRINGFN (FETCH (EXTERNALFORMAT FORMATBYTESTRINGFN)
|
||||
OF (FETCH (STREAM EXTERNALFORMAT) OF STREAM]
|
||||
(IF BYTESTRINGFN
|
||||
THEN (APPLY* BYTESTRINGFN STREAM STRING \FORMATBYTESTRING.STREAM)
|
||||
THEN (CL:WHEN (SETQ FSTRING (APPLY* BYTESTRINGFN STREAM STRING
|
||||
\FORMATBYTESTRING.STREAM))
|
||||
(MKSTRING FSTRING))
|
||||
ELSE (\FORMATBYTESTREAM STREAM \FORMATBYTESTRING.STREAM)
|
||||
(FOR C INPNAME STRING DO (\OUTCHAR \FORMATBYTESTRING.STREAM C))
|
||||
(SETQ NBYTES (\GETFILEPTR \FORMATBYTESTRING.STREAM))
|
||||
@@ -727,13 +737,13 @@
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6735 13568 (\EXTERNALFORMAT 6745 . 10523) (MAKE-EXTERNALFORMAT 10525 . 13095) (
|
||||
\EXTERNALFORMAT.DEFPRINT 13097 . 13566)) (13569 16610 (\INSTALL.EXTERNALFORMAT 13579 . 15028) (
|
||||
\REMOVE.EXTERNALFORMAT 15030 . 15861) (FIND-FORMAT 15863 . 16608)) (16611 17023 (SYSTEM-EXTERNALFORMAT
|
||||
16621 . 17021)) (17372 32799 (\OUTCHAR 17382 . 18599) (\INCCODE 18601 . 19754) (\BACKCCODE 19756 .
|
||||
21435) (\BACKCCODE.EOLC 21437 . 23627) (\PEEKCCODE 23629 . 23954) (\PEEKCCODE.EOLC 23956 . 24335) (
|
||||
\INCCODE.EOLC 24337 . 26136) (\FORMATBYTESTREAM 26138 . 28273) (\FORMATBYTESTRING 28275 . 29734) (
|
||||
\CHECKEOLC.CRLF 29736 . 32797)) (34081 36317 (\NULLDEVICE 34091 . 35993) (\NULL.OPENFILE 35995 . 36315
|
||||
)) (36457 38284 (\CREATE.THROUGH.EXTERNALFORMAT 36467 . 37253) (\THROUGHIN 37255 . 37675) (
|
||||
\THROUGHBACKCCODE 37677 . 37944) (\THROUGHOUTCHARFN 37946 . 38282)))))
|
||||
(FILEMAP (NIL (6726 13559 (\EXTERNALFORMAT 6736 . 10514) (MAKE-EXTERNALFORMAT 10516 . 13086) (
|
||||
\EXTERNALFORMAT.DEFPRINT 13088 . 13557)) (13560 16601 (\INSTALL.EXTERNALFORMAT 13570 . 15019) (
|
||||
\REMOVE.EXTERNALFORMAT 15021 . 15852) (FIND-FORMAT 15854 . 16599)) (16602 17014 (SYSTEM-EXTERNALFORMAT
|
||||
16612 . 17012)) (17363 33340 (\OUTCHAR 17373 . 18590) (\INCCODE 18592 . 19745) (\BACKCCODE 19747 .
|
||||
21426) (\BACKCCODE.EOLC 21428 . 23618) (\PEEKCCODE 23620 . 23945) (\PEEKCCODE.EOLC 23947 . 24326) (
|
||||
\INCCODE.EOLC 24328 . 26127) (\FORMATBYTESTREAM 26129 . 28573) (\FORMATBYTESTRING 28575 . 30275) (
|
||||
\CHECKEOLC.CRLF 30277 . 33338)) (34622 36858 (\NULLDEVICE 34632 . 36534) (\NULL.OPENFILE 36536 . 36856
|
||||
)) (36998 38825 (\CREATE.THROUGH.EXTERNALFORMAT 37008 . 37794) (\THROUGHIN 37796 . 38216) (
|
||||
\THROUGHBACKCCODE 38218 . 38485) (\THROUGHOUTCHARFN 38487 . 38823)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
29
sources/XCCS
29
sources/XCCS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Dec-2023 11:42:55" {WMEDLEY}<sources>XCCS.;66 14365
|
||||
(FILECREATED "26-Mar-2024 11:00:37" {WMEDLEY}<sources>XCCS.;70 14862
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \XCCSCHARSETFN)
|
||||
:CHANGES-TO (FNS \XCCSFORMATBYTESTREAM)
|
||||
|
||||
:PREVIOUS-DATE " 8-Dec-2023 15:34:50" {WMEDLEY}<sources>XCCS.;65)
|
||||
:PREVIOUS-DATE "19-Mar-2024 16:02:36" {WMEDLEY}<sources>XCCS.;68)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT XCCSCOMS)
|
||||
@@ -19,6 +19,7 @@
|
||||
(INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
(ALISTS (CHARACTERNAMES \NORUNCODE NSCHARSETSHIFT))
|
||||
(MACROS \RUNCODED)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.XCCS.EXTERNALFORMAT])
|
||||
(DEFINEQ
|
||||
@@ -200,9 +201,14 @@
|
||||
BYTE)))])
|
||||
|
||||
(\XCCSFORMATBYTESTREAM
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 16:47 by rmk:")
|
||||
(REPLACE (STREAM CHARSET) OF BYTESTREAM WITH (FETCH (STREAM CHARSET) OF
|
||||
STREAM])
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 26-Mar-2024 11:00 by rmk")
|
||||
(* ; "Edited 19-Mar-2024 16:02 by rmk")
|
||||
(\EXTERNALFORMAT BYTESTREAM (\EXTERNALFORMAT STREAM))
|
||||
|
||||
(* ;; "This stream may be read as a continuation of STREAM (TTYIN, LAFITE?), and we want to make sure that the bytes are encoded properly. So let's assert (and possibly mark) that that's its current situation.")
|
||||
|
||||
(\XCCSCHARSETFN BYTESTREAM (fetch (STREAM CHARSET) of STREAM))
|
||||
BYTESTREAM])
|
||||
|
||||
(\XCCSCHARSETFN
|
||||
[LAMBDA (STREAM CHARSET DONTMARKSTREAM) (* ; "Edited 9-Dec-2023 11:18 by rmk")
|
||||
@@ -270,6 +276,9 @@
|
||||
(CONSTANTS (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
)
|
||||
|
||||
(ADDTOVAR CHARACTERNAMES (\NORUNCODE 255)
|
||||
(NSCHARSETSHIFT 255))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \RUNCODED MACRO (OPENLAMBDA (STREAM)
|
||||
@@ -289,8 +298,8 @@
|
||||
(\CREATE.XCCS.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (886 11846 (\XCCSINCCODE 896 . 3875) (\XCCSPEEKCCODE 3877 . 6546) (\XCCSOUTCHAR 6548 .
|
||||
8768) (\XCCSBACKCCODE 8770 . 10314) (\XCCSFORMATBYTESTREAM 10316 . 10641) (\XCCSCHARSETFN 10643 .
|
||||
11844)) (11847 12620 (\CREATE.XCCS.EXTERNALFORMAT 11857 . 12618)) (12621 13452 (
|
||||
\NSIN.24BITENCODING.ERROR 12631 . 13450)))))
|
||||
(FILEMAP (NIL (993 12249 (\XCCSINCCODE 1003 . 3982) (\XCCSPEEKCCODE 3984 . 6653) (\XCCSOUTCHAR 6655 .
|
||||
8875) (\XCCSBACKCCODE 8877 . 10421) (\XCCSFORMATBYTESTREAM 10423 . 11044) (\XCCSCHARSETFN 11046 .
|
||||
12247)) (12250 13023 (\CREATE.XCCS.EXTERNALFORMAT 12260 . 13021)) (13024 13855 (
|
||||
\NSIN.24BITENCODING.ERROR 13034 . 13853)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1420
unicode/xerox/INVERTED-UNICODE-MAPPINGS.TXT
Normal file
1420
unicode/xerox/INVERTED-UNICODE-MAPPINGS.TXT
Normal file
File diff suppressed because it is too large
Load Diff
1412
unicode/xerox/UNICODE-MAPPINGS.TXT
Normal file
1412
unicode/xerox/UNICODE-MAPPINGS.TXT
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user