From 582b927ea5750b1604e4ae7c0b7d5a808afd482c Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 22 Feb 2021 15:12:52 -0800 Subject: [PATCH] CLIPBOARD: Delete old versions --- library/CLIPBOARD.~21~ | 1 - library/CLIPBOARD.~22~ | 1 - library/CLIPBOARD.~33~ | 1 - library/CLIPBOARD.~37~ | 1 - library/CLIPBOARD.~40~ | 1 - library/CLIPBOARD.~41~ | 1 - library/CLIPBOARD.~44~ | 1 - 7 files changed, 7 deletions(-) delete mode 100644 library/CLIPBOARD.~21~ delete mode 100644 library/CLIPBOARD.~22~ delete mode 100644 library/CLIPBOARD.~33~ delete mode 100644 library/CLIPBOARD.~37~ delete mode 100644 library/CLIPBOARD.~40~ delete mode 100644 library/CLIPBOARD.~41~ delete mode 100644 library/CLIPBOARD.~44~ diff --git a/library/CLIPBOARD.~21~ b/library/CLIPBOARD.~21~ deleted file mode 100644 index e6a179c9..00000000 --- a/library/CLIPBOARD.~21~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "28-Apr-2018 16:07:41"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;21 12278 changes to%: (FNS FILETOCODETABLE FILETOARRAYBLOCK CODECONVERT) (VARS CLIPBOARDCOMS) previous date%: "25-Apr-2018 17:56:28" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;18) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD TEDIT.COPYTOCLIPBOARD SEDIT.COPYTOCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 23:00 by rmk:") (CL:WHEN (GETD 'LISPINTERRUPTS.PASTE) (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG) (MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION UTF8.READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (UTF8.READCCODE s)) COLLECT C]) (PUTCLIPBOARD [CL:LAMBDA (STRING) (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (FOR I FROM 1 TO (NCHARS STRING) DO (UTF8.PRINTCCODE (NTHCHARCODE STRING I) s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) THEN (COPYINSERT STR) ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C]) (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 24-Apr-2018 20:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (LISTP SEL)) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) (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]) ) (DEFINEQ (UTF8.PRINTCCODE [LAMBDA (CHARCODE FILE) (* ; "Edited 25-Apr-2018 17:56 by rmk:") (* ;; "PRINT UTF8 sequence for CHARACODE. Doesn't do XNS to Unicode character conversion, just does the transport encoding.") (LET [(STRM (\GETSTREAM FILE 'OUTPUT] (* ; "Output raw bytes") (IF (ILESSP CHARCODE 128) THEN (\BOUT STRM CHARCODE) ELSEIF (ILESSP CHARCODE 2048) THEN (* ; "x800") (\BOUT STRM (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) THEN (* ; "x10000") (\BOUT STRM (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) THEN (* ; "x200000") (\BOUT STRM (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 12 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (UTF8.READCCODE [LAMBDA (FILE) (* ; "Edited 25-Apr-2018 17:23 by rmk:") (LET ((STRM (\GETSTREAM FILE 'INPUT)) BYTE1 BYTE2 BYTE3 BYTE4) (SETQ BYTE1 (\BIN STRM)) (* ;; "Distinguish on header byte, extract number of bytes so we don't read too far") (IF (ILESSP BYTE1 128) THEN (* ;; "Test first: Ascii is the common case") BYTE1 ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STRM)) (CL:WHEN (ILESSP BYTE4 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) ) (* ;; "To read/access code translation tables") (DEFINEQ (FILETOCODETABLE [LAMBDA (FILE) (* ; "Edited 28-Apr-2018 16:07 by rmk:") (* rmk%: "20-Dec-87 10:08") (* ;; "Returns a (system-internal) arrayblock holding the contents of FILE.") (RESETLST (LET (LENGTH BLOCK STREAM) (CL:UNLESS (AND (STREAMP FILE) (SETQ STREAM (GETSTREAM FILE 'INPUT T))) [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT 'OLD '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE]) (* ;; "Blocks are allocated in 4-byte units") (SETQ BLOCK (\ALLOCBLOCK (LRSH LENGTH 2))) (\BINS STREAM BLOCK 0 LENGTH) BLOCK))]) (CODECONVERT [LAMBDA (TABLE CODE) (* ; "Edited 28-Apr-2018 16:01 by rmk:") (* ;;  "Get the CODEth value from the arrayblock TABLE. CODE is a 16-bit index, 16 bits are returned.") (\GETBASE TABLE CODE]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1323 6343 (INSTALL-CLIPBOARD 1333 . 2706) (GETCLIPBOARD 2708 . 3192) (PUTCLIPBOARD 3194 . 3706) (PASTEFROMCLIPBOARD 3708 . 4325) (TEDIT.COPYTOCLIPBOARD 4327 . 4608) (SEDIT.COPYTOCLIPBOARD 4610 . 5918) (LISPINTERRUPTS.PASTE 5920 . 6341)) (6344 10759 (UTF8.PRINTCCODE 6354 . 8236) ( UTF8.READCCODE 8238 . 10757)) (10816 11984 (FILETOCODETABLE 10826 . 11711) (CODECONVERT 11713 . 11982) )))) STOP \ No newline at end of file diff --git a/library/CLIPBOARD.~22~ b/library/CLIPBOARD.~22~ deleted file mode 100644 index 04ed7e7f..00000000 --- a/library/CLIPBOARD.~22~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 5-May-2018 09:46:37"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;22 12280 changes to%: (FNS SEDIT.COPYTOCLIPBOARD) previous date%: "28-Apr-2018 16:07:41" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;21) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD TEDIT.COPYTOCLIPBOARD SEDIT.COPYTOCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 23:00 by rmk:") (CL:WHEN (GETD 'LISPINTERRUPTS.PASTE) (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG) (MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION UTF8.READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (UTF8.READCCODE s)) COLLECT C]) (PUTCLIPBOARD [CL:LAMBDA (STRING) (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (FOR I FROM 1 TO (NCHARS STRING) DO (UTF8.PRINTCCODE (NTHCHARCODE STRING I) s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) THEN (COPYINSERT STR) ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C]) (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 5-May-2018 09:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (AND (EQ SELTYPE :SUB-LIST) (LISTP SEL))) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) (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]) ) (DEFINEQ (UTF8.PRINTCCODE [LAMBDA (CHARCODE FILE) (* ; "Edited 25-Apr-2018 17:56 by rmk:") (* ;; "PRINT UTF8 sequence for CHARACODE. Doesn't do XNS to Unicode character conversion, just does the transport encoding.") (LET [(STRM (\GETSTREAM FILE 'OUTPUT] (* ; "Output raw bytes") (IF (ILESSP CHARCODE 128) THEN (\BOUT STRM CHARCODE) ELSEIF (ILESSP CHARCODE 2048) THEN (* ; "x800") (\BOUT STRM (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) THEN (* ; "x10000") (\BOUT STRM (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) THEN (* ; "x200000") (\BOUT STRM (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 12 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (UTF8.READCCODE [LAMBDA (FILE) (* ; "Edited 25-Apr-2018 17:23 by rmk:") (LET ((STRM (\GETSTREAM FILE 'INPUT)) BYTE1 BYTE2 BYTE3 BYTE4) (SETQ BYTE1 (\BIN STRM)) (* ;; "Distinguish on header byte, extract number of bytes so we don't read too far") (IF (ILESSP BYTE1 128) THEN (* ;; "Test first: Ascii is the common case") BYTE1 ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STRM)) (CL:WHEN (ILESSP BYTE4 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) ) (* ;; "To read/access code translation tables") (DEFINEQ (FILETOCODETABLE [LAMBDA (FILE) (* ; "Edited 28-Apr-2018 16:07 by rmk:") (* rmk%: "20-Dec-87 10:08") (* ;; "Returns a (system-internal) arrayblock holding the contents of FILE.") (RESETLST (LET (LENGTH BLOCK STREAM) (CL:UNLESS (AND (STREAMP FILE) (SETQ STREAM (GETSTREAM FILE 'INPUT T))) [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT 'OLD '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE]) (* ;; "Blocks are allocated in 4-byte units") (SETQ BLOCK (\ALLOCBLOCK (LRSH LENGTH 2))) (\BINS STREAM BLOCK 0 LENGTH) BLOCK))]) (CODECONVERT [LAMBDA (TABLE CODE) (* ; "Edited 28-Apr-2018 16:01 by rmk:") (* ;;  "Get the CODEth value from the arrayblock TABLE. CODE is a 16-bit index, 16 bits are returned.") (\GETBASE TABLE CODE]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1259 6345 (INSTALL-CLIPBOARD 1269 . 2642) (GETCLIPBOARD 2644 . 3128) (PUTCLIPBOARD 3130 . 3642) (PASTEFROMCLIPBOARD 3644 . 4261) (TEDIT.COPYTOCLIPBOARD 4263 . 4544) (SEDIT.COPYTOCLIPBOARD 4546 . 5920) (LISPINTERRUPTS.PASTE 5922 . 6343)) (6346 10761 (UTF8.PRINTCCODE 6356 . 8238) ( UTF8.READCCODE 8240 . 10759)) (10818 11986 (FILETOCODETABLE 10828 . 11713) (CODECONVERT 11715 . 11984) )))) STOP \ No newline at end of file diff --git a/library/CLIPBOARD.~33~ b/library/CLIPBOARD.~33~ deleted file mode 100644 index 2ada3b0d..00000000 --- a/library/CLIPBOARD.~33~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 3-Feb-2020 10:08:32"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;33 21122 changes to%: (FNS PUTCLIPBOARD UTF8.PRINTCCODE MAKECHARCODEMAPS GETCLIPBOARD UTF8.READCCODE) (VARS CLIPBOARDCOMS) previous date%: " 1-Feb-2020 18:01:03" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;32) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD TEDIT.COPYTOCLIPBOARD SEDIT.COPYTOCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (COMS (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (FNS MAKECHARCODEMAPS CBMAPCCODE) (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) (VARS CBUNICODETOXEROXRENDERING) (P (MAKECHARCODEMAPS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 23:00 by rmk:") (CL:WHEN (GETD 'LISPINTERRUPTS.PASTE) (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG) (MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 3-Feb-2020 10:07 by rmk:") (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION UTF8.READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (UTF8.READCCODE s)) COLLECT (CBMAPCCODE UNICODE2XEROXRENDERINGMAP C]) (PUTCLIPBOARD [CL:LAMBDA (STRING) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UNICODE and UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (FOR I FROM 1 TO (NCHARS STRING) DO (UTF8.PRINTCCODE (CBMAPCCODE XEROXRENDERING2UNICODEMAP (NTHCHARCODE STRING I)) s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) THEN (COPYINSERT STR) ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C]) (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 5-May-2018 09:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (AND (EQ SELTYPE :SUB-LIST) (LISTP SEL))) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) (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]) ) (DEFINEQ (UTF8.PRINTCCODE [LAMBDA (CHARCODE FILE) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ;; "PRINT UTF8 sequence for CHARCODE. .") (LET [(STRM (\GETSTREAM FILE 'OUTPUT] (* ; "Output raw bytes") (IF (ILESSP CHARCODE 128) THEN (\BOUT STRM CHARCODE) ELSEIF (ILESSP CHARCODE 2048) THEN (* ; "x800") (\BOUT STRM (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) THEN (* ; "x10000") (\BOUT STRM (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) THEN (* ; "x200000") (\BOUT STRM (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 12 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (UTF8.READCCODE [LAMBDA (FILE) (* ; "Edited 3-Feb-2020 10:08 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (LET ((STRM (\GETSTREAM FILE 'INPUT)) BYTE1 BYTE2 BYTE3 BYTE4) (SETQ BYTE1 (\BIN STRM)) (* ;; "Distinguish on header byte, extract number of bytes so we don't read too far") (IF (ILESSP BYTE1 128) THEN (* ;; "Test first: Ascii is the common case") BYTE1 ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STRM)) (CL:WHEN (ILESSP BYTE4 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) ) (* ;; "To read/access code translation tables") (DEFINEQ (FILETOCODETABLE [LAMBDA (FILE) (* ; "Edited 28-Apr-2018 16:07 by rmk:") (* rmk%: "20-Dec-87 10:08") (* ;; "Returns a (system-internal) arrayblock holding the contents of FILE.") (RESETLST (LET (LENGTH BLOCK STREAM) (CL:UNLESS (AND (STREAMP FILE) (SETQ STREAM (GETSTREAM FILE 'INPUT T))) [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT 'OLD '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE]) (* ;; "Blocks are allocated in 4-byte units") (SETQ BLOCK (\ALLOCBLOCK (LRSH LENGTH 2))) (\BINS STREAM BLOCK 0 LENGTH) BLOCK))]) (CODECONVERT [LAMBDA (TABLE CODE) (* ; "Edited 28-Apr-2018 16:01 by rmk:") (* ;;  "Get the CODEth value from the arrayblock TABLE. CODE is a 16-bit index, 16 bits are returned.") (\GETBASE TABLE CODE]) ) (DEFINEQ (MAKECHARCODEMAPS [LAMBDA NIL (* ; "Edited 3-Feb-2020 10:03 by rmk:") (* ; "Edited 1-Feb-2020 17:45 by rmk:") (* ; "Edited 30-Jan-2020 23:03 by rmk:") (* ;; "Clipboard is UNICODE. Uses an array for character set 0 and for any other highly populated segment, ALIST for relatively unpopulated ones.") (* ;; "Charset 0 is special also because it contains most input characters in both directions.") (* ;; "It sets TOCLIPBOARDMAP and FROMCLIPBOARDMAP each to a pair (array . list)") (LET ((TOCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FROMCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (TOCLIPBOARDLIST NIL) (FROMCLIPBOARDLIST NIL)) [FOR C CSETLIST IN CBUNICODETOXEROXRENDERING DO (IF (ILESSP (CADR C) 256) THEN (CL:SETF (CL:SVREF TOCLIPBOARDARRAY (CADR C)) (CAR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH (CADR C) 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH (CADR C) 8] C)) FINALLY (SETQ TOCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CADR PAIR) 255)) (CAR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CADR PAIR) (CAR PAIR] [FOR C CSETLIST IN CBUNICODETOXEROXRENDERING DO (IF (ILESSP (CAR C) 256) THEN (CL:SETF (CL:SVREF FROMCLIPBOARDARRAY (CAR C)) (CADR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH (CAR C) 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH (CAR C) 8] C)) FINALLY (SETQ FROMCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR PAIR) 255)) (CADR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CAR PAIR) (CADR PAIR] (SETQ XEROXRENDERING2UNICODEMAP (CONS TOCLIPBOARDARRAY TOCLIPBOARDLIST)) (SETQ UNICODE2XEROXRENDERINGMAP (CONS FROMCLIPBOARDARRAY FROMCLIPBOARDLIST]) (CBMAPCCODE [LAMBDA (CHARMAP CODE) (* ; "Edited 1-Feb-2020 17:49 by rmk:") (* ; "Edited 30-Jan-2020 22:47 by rmk:") (OR [IF (ILESSP CODE 256) THEN (CL:SVREF (CAR CHARMAP) CODE) ELSE (LET [(CS (CDR (ASSOC (LRSH CODE 8) (CDR CHARMAP] (CL:WHEN CS (IF (LISTP CS) THEN (CDR (ASSOC CODE CS)) ELSE (CL:SVREF CS (LOGAND CODE 255))))] CODE]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) ) (RPAQQ CBUNICODETOXEROXRENDERING ((146 39) (160 61217) (166 61291) (168 8994) (169 211) (170 227) (172 61290) (173 61219) (174 210) (175 9086) (180 39) (184 203) (185 209) (186 235) (192 61729) (193 61730) (194 61731) (195 61732) (196 61735) (197 61736) (198 225) (199 61741) (200 61744) (201 61745) (202 61746) (203 61749) (204 61758) (205 61759) (206 61760) (207 61764) (208 226) (209 61772) (210 61775) (211 61776) (212 61777) (213 61778) (214 61780) (215 180) (216 233) (217 61791) (218 61792) (219 61793) (220 61797) (221 61803) (222 236) (223 251) (224 61857) (225 61858) (226 61859) (227 61860) (228 61863) (229 61864) (230 241) (231 61869) (232 61872) (233 61873) (234 61874) (235 61877) (236 61886) (237 61887) (238 61888) (239 61892) (240 243) (241 61900) (242 61903) (243 61904) (244 61905) (245 61906) (246 61908) (247 184) (248 249) (249 61919) (250 61920) (251 61921) (252 61925) (253 61931) (254 252) (255 61933) (376 61805) (8594 174) (8592 172) (8593 173) (8595 175) (8712 61258) (8713 61259) (10 13))) (MAKECHARCODEMAPS) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD TEDIT.COPYTOCLIPBOARD SEDIT.COPYTOCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (COMS (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (FNS MAKECHARCODEMAPS CBMAPCCODE) (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) (VARS CBUNICODETOXEROXRENDERING) (P (MAKECHARCODEMAPS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA PUTCLIPBOARD]) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA PUTCLIPBOARD) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1582 6951 (INSTALL-CLIPBOARD 1592 . 2965) (GETCLIPBOARD 2967 . 3629) (PUTCLIPBOARD 3631 . 4248) (PASTEFROMCLIPBOARD 4250 . 4867) (TEDIT.COPYTOCLIPBOARD 4869 . 5150) (SEDIT.COPYTOCLIPBOARD 5152 . 6526) (LISPINTERRUPTS.PASTE 6528 . 6949)) (6952 11504 (UTF8.PRINTCCODE 6962 . 8872) ( UTF8.READCCODE 8874 . 11502)) (11561 12729 (FILETOCODETABLE 11571 . 12456) (CODECONVERT 12458 . 12727) ) (12730 17725 (MAKECHARCODEMAPS 12740 . 17034) (CBMAPCCODE 17036 . 17723))))) STOP \ No newline at end of file diff --git a/library/CLIPBOARD.~37~ b/library/CLIPBOARD.~37~ deleted file mode 100644 index 7b0728d0..00000000 --- a/library/CLIPBOARD.~37~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "19-Apr-2020 12:18:20"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;37 21262 changes to%: (VARS CLIPBOARDCOMS CBUNICODETOXEROXRENDERING) (FNS INSTALL-CLIPBOARD TEDIT.EXTRACTTOCLIPBOARD MAKECHARCODEMAPS) previous date%: " 3-Feb-2020 10:08:32" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;33) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD SEDIT.COPYTOCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (COMS (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (FNS MAKECHARCODEMAPS CBMAPCCODE) (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) (VARS CBUNICODETOXEROXRENDERING) (ALISTS (CHARACTERNAMES RSQ LSQ LDQ RDQ NEQ)) (P (MAKECHARCODEMAPS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "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)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,X") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,x") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 3-Feb-2020 10:07 by rmk:") (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION UTF8.READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (UTF8.READCCODE s)) COLLECT (CBMAPCCODE UNICODE2XEROXRENDERINGMAP C]) (PUTCLIPBOARD [CL:LAMBDA (STRING) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UNICODE and UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (FOR I FROM 1 TO (NCHARS STRING) DO (UTF8.PRINTCCODE (CBMAPCCODE XEROXRENDERING2UNICODEMAP (NTHCHARCODE STRING I)) s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) THEN (COPYINSERT STR) ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C]) (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (TEDIT.EXTRACTTOCLIPBOARD [LAMBDA NIL (* ; "Edited 19-Apr-2020 12:17 by rmk:") (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM)) (TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM]) (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 5-May-2018 09:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (AND (EQ SELTYPE :SUB-LIST) (LISTP SEL))) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) (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]) ) (DEFINEQ (UTF8.PRINTCCODE [LAMBDA (CHARCODE FILE) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ;; "PRINT UTF8 sequence for CHARCODE. .") (LET [(STRM (\GETSTREAM FILE 'OUTPUT] (* ; "Output raw bytes") (IF (ILESSP CHARCODE 128) THEN (\BOUT STRM CHARCODE) ELSEIF (ILESSP CHARCODE 2048) THEN (* ; "x800") (\BOUT STRM (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) THEN (* ; "x10000") (\BOUT STRM (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) THEN (* ; "x200000") (\BOUT STRM (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 12 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (UTF8.READCCODE [LAMBDA (FILE) (* ; "Edited 3-Feb-2020 10:08 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (LET ((STRM (\GETSTREAM FILE 'INPUT)) BYTE1 BYTE2 BYTE3 BYTE4) (SETQ BYTE1 (\BIN STRM)) (* ;; "Distinguish on header byte, extract number of bytes so we don't read too far") (IF (ILESSP BYTE1 128) THEN (* ;; "Test first: Ascii is the common case") BYTE1 ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STRM)) (CL:WHEN (ILESSP BYTE4 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) ) (* ;; "To read/access code translation tables") (DEFINEQ (FILETOCODETABLE [LAMBDA (FILE) (* ; "Edited 28-Apr-2018 16:07 by rmk:") (* rmk%: "20-Dec-87 10:08") (* ;; "Returns a (system-internal) arrayblock holding the contents of FILE.") (RESETLST (LET (LENGTH BLOCK STREAM) (CL:UNLESS (AND (STREAMP FILE) (SETQ STREAM (GETSTREAM FILE 'INPUT T))) [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT 'OLD '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE]) (* ;; "Blocks are allocated in 4-byte units") (SETQ BLOCK (\ALLOCBLOCK (LRSH LENGTH 2))) (\BINS STREAM BLOCK 0 LENGTH) BLOCK))]) (CODECONVERT [LAMBDA (TABLE CODE) (* ; "Edited 28-Apr-2018 16:01 by rmk:") (* ;;  "Get the CODEth value from the arrayblock TABLE. CODE is a 16-bit index, 16 bits are returned.") (\GETBASE TABLE CODE]) ) (DEFINEQ (MAKECHARCODEMAPS [LAMBDA NIL (* ; "Edited 19-Apr-2020 11:43 by rmk:") (* ; "Edited 3-Feb-2020 10:03 by rmk:") (* ; "Edited 1-Feb-2020 17:45 by rmk:") (* ; "Edited 30-Jan-2020 23:03 by rmk:") (* ;; "Clipboard is UNICODE. Uses an array for character set 0 and for any other highly populated segment, ALIST for relatively unpopulated ones.") (* ;; "Charset 0 is special also because it contains most input characters in both directions.") (* ;; "It sets TOCLIPBOARDMAP and FROMCLIPBOARDMAP each to a pair (array . list)") (LET ((TOCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FROMCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (TOCLIPBOARDLIST NIL) (FROMCLIPBOARDLIST NIL)) [FOR C XC CSETLIST IN CBUNICODETOXEROXRENDERING DO (SETQ XC (CADR C)) (CL:UNLESS (FIXP XC) (SETQ XC (CHARCODE.DECODE XC))) (IF (ILESSP XC 256) THEN (CL:SETF (CL:SVREF TOCLIPBOARDARRAY XC) (CAR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH XC 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH XC 8] C)) FINALLY (SETQ TOCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CADR PAIR) 255)) (CAR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CADR PAIR) (CAR PAIR] [FOR C CSETLIST IN CBUNICODETOXEROXRENDERING DO (CL:UNLESS (FIXP (CADR C)) [SETQ C (LIST (CAR C) (CHARCODE.DECODE (CADR C]) (IF (ILESSP (CAR C) 256) THEN (CL:SETF (CL:SVREF FROMCLIPBOARDARRAY (CAR C)) (CADR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH (CAR C) 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH (CAR C) 8] C)) FINALLY (SETQ FROMCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR PAIR) 255)) (CADR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CAR PAIR) (CADR PAIR] (SETQ XEROXRENDERING2UNICODEMAP (CONS TOCLIPBOARDARRAY TOCLIPBOARDLIST)) (SETQ UNICODE2XEROXRENDERINGMAP (CONS FROMCLIPBOARDARRAY FROMCLIPBOARDLIST]) (CBMAPCCODE [LAMBDA (CHARMAP CODE) (* ; "Edited 1-Feb-2020 17:49 by rmk:") (* ; "Edited 30-Jan-2020 22:47 by rmk:") (OR [IF (ILESSP CODE 256) THEN (CL:SVREF (CAR CHARMAP) CODE) ELSE (LET [(CS (CDR (ASSOC (LRSH CODE 8) (CDR CHARMAP] (CL:WHEN CS (IF (LISTP CS) THEN (CDR (ASSOC CODE CS)) ELSE (CL:SVREF CS (LOGAND CODE 255))))] CODE]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) ) (RPAQQ CBUNICODETOXEROXRENDERING ((8217 RSQ) (8216 LSQ) (8221 RDQ) (8220 LDQ) (8800 NEQ) (146 39) (160 61217) (166 61291) (168 8994) (169 211) (170 227) (172 61290) (173 61219) (174 210) (175 9086) (180 39) (184 203) (185 209) (186 235) (192 61729) (193 61730) (194 61731) (195 61732) (196 61735) (197 61736) (198 225) (199 61741) (200 61744) (201 61745) (202 61746) (203 61749) (204 61758) (205 61759) (206 61760) (207 61764) (208 226) (209 61772) (210 61775) (211 61776) (212 61777) (213 61778) (214 61780) (215 180) (216 233) (217 61791) (218 61792) (219 61793) (220 61797) (221 61803) (222 236) (223 251) (224 61857) (225 61858) (226 61859) (227 61860) (228 61863) (229 61864) (230 241) (231 61869) (232 61872) (233 61873) (234 61874) (235 61877) (236 61886) (237 61887) (238 61888) (239 61892) (240 243) (241 61900) (242 61903) (243 61904) (244 61905) (245 61906) (246 61908) (247 184) (248 249) (249 61919) (250 61920) (251 61921) (252 61925) (253 61931) (254 252) (255 61933) (376 61805) (8594 174) (8592 172) (8593 173) (8595 175) (8712 61258) (8713 61259) (10 13))) (ADDTOVAR CHARACTERNAMES (RSQ "0,271") (LSQ "0,251") (LDQ "0,252") (RDQ "0,272") (NEQ "041,142")) (MAKECHARCODEMAPS) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1679 7877 (INSTALL-CLIPBOARD 1689 . 3425) (GETCLIPBOARD 3427 . 4089) (PUTCLIPBOARD 4091 . 4708) (PASTEFROMCLIPBOARD 4710 . 5327) (TEDIT.COPYTOCLIPBOARD 5329 . 5610) ( TEDIT.EXTRACTTOCLIPBOARD 5612 . 6076) (SEDIT.COPYTOCLIPBOARD 6078 . 7452) (LISPINTERRUPTS.PASTE 7454 . 7875)) (7878 12430 (UTF8.PRINTCCODE 7888 . 9798) (UTF8.READCCODE 9800 . 12428)) (12487 13655 ( FILETOCODETABLE 12497 . 13382) (CODECONVERT 13384 . 13653)) (13656 18815 (MAKECHARCODEMAPS 13666 . 18124) (CBMAPCCODE 18126 . 18813))))) STOP \ No newline at end of file diff --git a/library/CLIPBOARD.~40~ b/library/CLIPBOARD.~40~ deleted file mode 100644 index b6c8b3d1..00000000 --- a/library/CLIPBOARD.~40~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 3-May-2020 17:34:19"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;40 21963 changes to%: (FNS INSTALL-CLIPBOARD TEDIT.SELECTALL) (VARS CLIPBOARDCOMS) previous date%: " 3-May-2020 17:33:15" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;39) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD TEDIT.SELECTALL) (FNS SEDIT.COPYTOCLIPBOARD) (COMS (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (FNS MAKECHARCODEMAPS CBMAPCCODE) (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) (VARS CBUNICODETOXEROXRENDERING) (ALISTS (CHARACTERNAMES RSQ LSQ LDQ RDQ NEQ)) (P (MAKECHARCODEMAPS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "Edited 3-May-2020 17:33 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)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,X") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,x") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (* ;; "All") (TEDIT.SETFUNCTION (CHARCODE "1,a") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,A") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 3-Feb-2020 10:07 by rmk:") (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION UTF8.READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (UTF8.READCCODE s)) COLLECT (CBMAPCCODE UNICODE2XEROXRENDERINGMAP C]) (PUTCLIPBOARD [CL:LAMBDA (STRING) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UNICODE and UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (FOR I FROM 1 TO (NCHARS STRING) DO (UTF8.PRINTCCODE (CBMAPCCODE XEROXRENDERING2UNICODEMAP (NTHCHARCODE STRING I)) s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) 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]) ) (DEFINEQ (UTF8.PRINTCCODE [LAMBDA (CHARCODE FILE) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ;; "PRINT UTF8 sequence for CHARCODE. .") (LET [(STRM (\GETSTREAM FILE 'OUTPUT] (* ; "Output raw bytes") (IF (ILESSP CHARCODE 128) THEN (\BOUT STRM CHARCODE) ELSEIF (ILESSP CHARCODE 2048) THEN (* ; "x800") (\BOUT STRM (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) THEN (* ; "x10000") (\BOUT STRM (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) THEN (* ; "x200000") (\BOUT STRM (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 12 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (UTF8.READCCODE [LAMBDA (FILE) (* ; "Edited 3-Feb-2020 10:08 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (LET ((STRM (\GETSTREAM FILE 'INPUT)) BYTE1 BYTE2 BYTE3 BYTE4) (SETQ BYTE1 (\BIN STRM)) (* ;; "Distinguish on header byte, extract number of bytes so we don't read too far") (IF (ILESSP BYTE1 128) THEN (* ;; "Test first: Ascii is the common case") BYTE1 ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STRM)) (CL:WHEN (ILESSP BYTE4 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) ) (DEFINEQ (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (TEDIT.EXTRACTTOCLIPBOARD [LAMBDA NIL (* ; "Edited 19-Apr-2020 12:17 by rmk:") (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM)) (TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM]) (TEDIT.SELECTALL [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (CL:WHEN TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM))) 'LEFT))]) ) (DEFINEQ (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 5-May-2018 09:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (AND (EQ SELTYPE :SUB-LIST) (LISTP SEL))) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) ) (* ;; "To read/access code translation tables") (DEFINEQ (FILETOCODETABLE [LAMBDA (FILE) (* ; "Edited 28-Apr-2018 16:07 by rmk:") (* rmk%: "20-Dec-87 10:08") (* ;; "Returns a (system-internal) arrayblock holding the contents of FILE.") (RESETLST (LET (LENGTH BLOCK STREAM) (CL:UNLESS (AND (STREAMP FILE) (SETQ STREAM (GETSTREAM FILE 'INPUT T))) [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT 'OLD '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE]) (* ;; "Blocks are allocated in 4-byte units") (SETQ BLOCK (\ALLOCBLOCK (LRSH LENGTH 2))) (\BINS STREAM BLOCK 0 LENGTH) BLOCK))]) (CODECONVERT [LAMBDA (TABLE CODE) (* ; "Edited 28-Apr-2018 16:01 by rmk:") (* ;;  "Get the CODEth value from the arrayblock TABLE. CODE is a 16-bit index, 16 bits are returned.") (\GETBASE TABLE CODE]) ) (DEFINEQ (MAKECHARCODEMAPS [LAMBDA NIL (* ; "Edited 19-Apr-2020 11:43 by rmk:") (* ; "Edited 3-Feb-2020 10:03 by rmk:") (* ; "Edited 1-Feb-2020 17:45 by rmk:") (* ; "Edited 30-Jan-2020 23:03 by rmk:") (* ;; "Clipboard is UNICODE. Uses an array for character set 0 and for any other highly populated segment, ALIST for relatively unpopulated ones.") (* ;; "Charset 0 is special also because it contains most input characters in both directions.") (* ;; "It sets TOCLIPBOARDMAP and FROMCLIPBOARDMAP each to a pair (array . list)") (LET ((TOCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FROMCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (TOCLIPBOARDLIST NIL) (FROMCLIPBOARDLIST NIL)) [FOR C XC CSETLIST IN CBUNICODETOXEROXRENDERING DO (SETQ XC (CADR C)) (CL:UNLESS (FIXP XC) (SETQ XC (CHARCODE.DECODE XC))) (IF (ILESSP XC 256) THEN (CL:SETF (CL:SVREF TOCLIPBOARDARRAY XC) (CAR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH XC 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH XC 8] C)) FINALLY (SETQ TOCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CADR PAIR) 255)) (CAR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CADR PAIR) (CAR PAIR] [FOR C CSETLIST IN CBUNICODETOXEROXRENDERING DO (CL:UNLESS (FIXP (CADR C)) [SETQ C (LIST (CAR C) (CHARCODE.DECODE (CADR C]) (IF (ILESSP (CAR C) 256) THEN (CL:SETF (CL:SVREF FROMCLIPBOARDARRAY (CAR C)) (CADR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH (CAR C) 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH (CAR C) 8] C)) FINALLY (SETQ FROMCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR PAIR) 255)) (CADR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CAR PAIR) (CADR PAIR] (SETQ XEROXRENDERING2UNICODEMAP (CONS TOCLIPBOARDARRAY TOCLIPBOARDLIST)) (SETQ UNICODE2XEROXRENDERINGMAP (CONS FROMCLIPBOARDARRAY FROMCLIPBOARDLIST]) (CBMAPCCODE [LAMBDA (CHARMAP CODE) (* ; "Edited 1-Feb-2020 17:49 by rmk:") (* ; "Edited 30-Jan-2020 22:47 by rmk:") (OR [IF (ILESSP CODE 256) THEN (CL:SVREF (CAR CHARMAP) CODE) ELSE (LET [(CS (CDR (ASSOC (LRSH CODE 8) (CDR CHARMAP] (CL:WHEN CS (IF (LISTP CS) THEN (CDR (ASSOC CODE CS)) ELSE (CL:SVREF CS (LOGAND CODE 255))))] CODE]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) ) (RPAQQ CBUNICODETOXEROXRENDERING ((8217 RSQ) (8216 LSQ) (8221 RDQ) (8220 LDQ) (8800 NEQ) (146 39) (160 61217) (166 61291) (168 8994) (169 211) (170 227) (172 61290) (173 61219) (174 210) (175 9086) (180 39) (184 203) (185 209) (186 235) (192 61729) (193 61730) (194 61731) (195 61732) (196 61735) (197 61736) (198 225) (199 61741) (200 61744) (201 61745) (202 61746) (203 61749) (204 61758) (205 61759) (206 61760) (207 61764) (208 226) (209 61772) (210 61775) (211 61776) (212 61777) (213 61778) (214 61780) (215 180) (216 233) (217 61791) (218 61792) (219 61793) (220 61797) (221 61803) (222 236) (223 251) (224 61857) (225 61858) (226 61859) (227 61860) (228 61863) (229 61864) (230 241) (231 61869) (232 61872) (233 61873) (234 61874) (235 61877) (236 61886) (237 61887) (238 61888) (239 61892) (240 243) (241 61900) (242 61903) (243 61904) (244 61905) (245 61906) (246 61908) (247 184) (248 249) (249 61919) (250 61920) (251 61921) (252 61925) (253 61931) (254 252) (255 61933) (376 61805) (8594 174) (8592 172) (8593 173) (8595 175) (8712 61258) (8713 61259) (10 13))) (ADDTOVAR CHARACTERNAMES (RSQ "0,271") (LSQ "0,251") (LDQ "0,252") (RDQ "0,272") (NEQ "041,142")) (MAKECHARCODEMAPS) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1657 6102 (INSTALL-CLIPBOARD 1667 . 3775) (GETCLIPBOARD 3777 . 4439) (PUTCLIPBOARD 4441 . 5058) (PASTEFROMCLIPBOARD 5060 . 5677) (LISPINTERRUPTS.PASTE 5679 . 6100)) (6103 10655 ( UTF8.PRINTCCODE 6113 . 8023) (UTF8.READCCODE 8025 . 10653)) (10656 11744 (TEDIT.COPYTOCLIPBOARD 10666 . 10947) (TEDIT.EXTRACTTOCLIPBOARD 10949 . 11413) (TEDIT.SELECTALL 11415 . 11742)) (11745 13131 ( SEDIT.COPYTOCLIPBOARD 11755 . 13129)) (13188 14356 (FILETOCODETABLE 13198 . 14083) (CODECONVERT 14085 . 14354)) (14357 19516 (MAKECHARCODEMAPS 14367 . 18825) (CBMAPCCODE 18827 . 19514))))) STOP \ No newline at end of file diff --git a/library/CLIPBOARD.~41~ b/library/CLIPBOARD.~41~ deleted file mode 100644 index e2ba3c5a..00000000 --- a/library/CLIPBOARD.~41~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "24-Jun-2020 20:17:42"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;41 22191 changes to%: (FNS INSTALL-CLIPBOARD) previous date%: " 3-May-2020 17:34:19" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;40) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE) (FNS UTF8.PRINTCCODE UTF8.READCCODE) (FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD TEDIT.SELECTALL) (FNS SEDIT.COPYTOCLIPBOARD) (COMS (* ;; "To read/access code translation tables") (FNS FILETOCODETABLE CODECONVERT) (FNS MAKECHARCODEMAPS CBMAPCCODE) (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) (VARS CBUNICODETOXEROXRENDERING) (ALISTS (CHARACTERNAMES RSQ LSQ LDQ RDQ NEQ)) (P (MAKECHARCODEMAPS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCOMM) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "Edited 24-Jun-2020 20: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)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (* ;; "Extract") (TEDIT.SETFUNCTION (CHARCODE "1,X") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,x") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (* ;; "All") (TEDIT.SETFUNCTION (CHARCODE "1,a") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,A") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (* ;; "Quit") (TEDIT.SETFUNCTION (CHARCODE "1,q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,Q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 3-Feb-2020 10:07 by rmk:") (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION UTF8.READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (UTF8.READCCODE s)) COLLECT (CBMAPCCODE UNICODE2XEROXRENDERINGMAP C]) (PUTCLIPBOARD [CL:LAMBDA (STRING) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UNICODE and UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (FOR I FROM 1 TO (NCHARS STRING) DO (UTF8.PRINTCCODE (CBMAPCCODE XEROXRENDERING2UNICODEMAP (NTHCHARCODE STRING I)) s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) 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]) ) (DEFINEQ (UTF8.PRINTCCODE [LAMBDA (CHARCODE FILE) (* ; "Edited 3-Feb-2020 10:01 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ;; "PRINT UTF8 sequence for CHARCODE. .") (LET [(STRM (\GETSTREAM FILE 'OUTPUT] (* ; "Output raw bytes") (IF (ILESSP CHARCODE 128) THEN (\BOUT STRM CHARCODE) ELSEIF (ILESSP CHARCODE 2048) THEN (* ; "x800") (\BOUT STRM (LOGOR (LLSH 3 6) (LRSH CHARCODE 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 65536) THEN (* ; "x10000") (\BOUT STRM (LOGOR (LLSH 7 5) (LRSH CHARCODE 12))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSEIF (ILESSP CHARCODE 2097152) THEN (* ; "x200000") (\BOUT STRM (LOGOR (LLSH 15 4) (LRSH CHARCODE 18))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 12 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 6 6))) (\BOUT STRM (LOGOR (LLSH 2 6) (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) (UTF8.READCCODE [LAMBDA (FILE) (* ; "Edited 3-Feb-2020 10:08 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (LET ((STRM (\GETSTREAM FILE 'INPUT)) BYTE1 BYTE2 BYTE3 BYTE4) (SETQ BYTE1 (\BIN STRM)) (* ;; "Distinguish on header byte, extract number of bytes so we don't read too far") (IF (ILESSP BYTE1 128) THEN (* ;; "Test first: Ascii is the common case") BYTE1 ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STRM)) (CL:WHEN (ILESSP BYTE4 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STRM)) (CL:WHEN (ILESSP BYTE3 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ BYTE2 (\BIN STRM)) (CL:WHEN (ILESSP BYTE2 128) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) ) (DEFINEQ (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (TEDIT.EXTRACTTOCLIPBOARD [LAMBDA NIL (* ; "Edited 19-Apr-2020 12:17 by rmk:") (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM)) (TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM]) (TEDIT.SELECTALL [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (CL:WHEN TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM))) 'LEFT))]) ) (DEFINEQ (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 5-May-2018 09:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (AND (EQ SELTYPE :SUB-LIST) (LISTP SEL))) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) ) (* ;; "To read/access code translation tables") (DEFINEQ (FILETOCODETABLE [LAMBDA (FILE) (* ; "Edited 28-Apr-2018 16:07 by rmk:") (* rmk%: "20-Dec-87 10:08") (* ;; "Returns a (system-internal) arrayblock holding the contents of FILE.") (RESETLST (LET (LENGTH BLOCK STREAM) (CL:UNLESS (AND (STREAMP FILE) (SETQ STREAM (GETSTREAM FILE 'INPUT T))) [RESETSAVE [SETQ STREAM (OPENSTREAM FILE 'INPUT 'OLD '((SEQUENTIAL T) (TYPE BINARY] '(PROGN (CLOSEF? OLDVALUE]) (* ;; "Blocks are allocated in 4-byte units") (SETQ BLOCK (\ALLOCBLOCK (LRSH LENGTH 2))) (\BINS STREAM BLOCK 0 LENGTH) BLOCK))]) (CODECONVERT [LAMBDA (TABLE CODE) (* ; "Edited 28-Apr-2018 16:01 by rmk:") (* ;;  "Get the CODEth value from the arrayblock TABLE. CODE is a 16-bit index, 16 bits are returned.") (\GETBASE TABLE CODE]) ) (DEFINEQ (MAKECHARCODEMAPS [LAMBDA NIL (* ; "Edited 19-Apr-2020 11:43 by rmk:") (* ; "Edited 3-Feb-2020 10:03 by rmk:") (* ; "Edited 1-Feb-2020 17:45 by rmk:") (* ; "Edited 30-Jan-2020 23:03 by rmk:") (* ;; "Clipboard is UNICODE. Uses an array for character set 0 and for any other highly populated segment, ALIST for relatively unpopulated ones.") (* ;; "Charset 0 is special also because it contains most input characters in both directions.") (* ;; "It sets TOCLIPBOARDMAP and FROMCLIPBOARDMAP each to a pair (array . list)") (LET ((TOCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FROMCLIPBOARDARRAY (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (TOCLIPBOARDLIST NIL) (FROMCLIPBOARDLIST NIL)) [FOR C XC CSETLIST IN CBUNICODETOXEROXRENDERING DO (SETQ XC (CADR C)) (CL:UNLESS (FIXP XC) (SETQ XC (CHARCODE.DECODE XC))) (IF (ILESSP XC 256) THEN (CL:SETF (CL:SVREF TOCLIPBOARDARRAY XC) (CAR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH XC 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH XC 8] C)) FINALLY (SETQ TOCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CADR PAIR) 255)) (CAR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CADR PAIR) (CAR PAIR] [FOR C CSETLIST IN CBUNICODETOXEROXRENDERING DO (CL:UNLESS (FIXP (CADR C)) [SETQ C (LIST (CAR C) (CHARCODE.DECODE (CADR C]) (IF (ILESSP (CAR C) 256) THEN (CL:SETF (CL:SVREF FROMCLIPBOARDARRAY (CAR C)) (CADR C)) ELSE (PUSH [CDR (OR (ASSOC (LRSH (CAR C) 8) CSETLIST) (CAR (PUSH CSETLIST (CONS (LRSH (CAR C) 8] C)) FINALLY (SETQ FROMCLIPBOARDLIST (FOR CS CSA IN CSETLIST COLLECT (CONS (CAR CS) (IF (IGREATERP (LENGTH (CDR CS)) 20) THEN (SETQ CSA (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL)) (FOR PAIR IN (CDR CS) DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR PAIR) 255)) (CADR PAIR))) CSA ELSE (FOR PAIR IN (CDR CS) COLLECT (CONS (CAR PAIR) (CADR PAIR] (SETQ XEROXRENDERING2UNICODEMAP (CONS TOCLIPBOARDARRAY TOCLIPBOARDLIST)) (SETQ UNICODE2XEROXRENDERINGMAP (CONS FROMCLIPBOARDARRAY FROMCLIPBOARDLIST]) (CBMAPCCODE [LAMBDA (CHARMAP CODE) (* ; "Edited 1-Feb-2020 17:49 by rmk:") (* ; "Edited 30-Jan-2020 22:47 by rmk:") (OR [IF (ILESSP CODE 256) THEN (CL:SVREF (CAR CHARMAP) CODE) ELSE (LET [(CS (CDR (ASSOC (LRSH CODE 8) (CDR CHARMAP] (CL:WHEN CS (IF (LISTP CS) THEN (CDR (ASSOC CODE CS)) ELSE (CL:SVREF CS (LOGAND CODE 255))))] CODE]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS XEROXRENDERING2UNICODEMAP UNICODE2XEROXRENDERINGMAP) ) (RPAQQ CBUNICODETOXEROXRENDERING ((8217 RSQ) (8216 LSQ) (8221 RDQ) (8220 LDQ) (8800 NEQ) (146 39) (160 61217) (166 61291) (168 8994) (169 211) (170 227) (172 61290) (173 61219) (174 210) (175 9086) (180 39) (184 203) (185 209) (186 235) (192 61729) (193 61730) (194 61731) (195 61732) (196 61735) (197 61736) (198 225) (199 61741) (200 61744) (201 61745) (202 61746) (203 61749) (204 61758) (205 61759) (206 61760) (207 61764) (208 226) (209 61772) (210 61775) (211 61776) (212 61777) (213 61778) (214 61780) (215 180) (216 233) (217 61791) (218 61792) (219 61793) (220 61797) (221 61803) (222 236) (223 251) (224 61857) (225 61858) (226 61859) (227 61860) (228 61863) (229 61864) (230 241) (231 61869) (232 61872) (233 61873) (234 61874) (235 61877) (236 61886) (237 61887) (238 61888) (239 61892) (240 243) (241 61900) (242 61903) (243 61904) (244 61905) (245 61906) (246 61908) (247 184) (248 249) (249 61919) (250 61920) (251 61921) (252 61925) (253 61931) (254 252) (255 61933) (376 61805) (8594 174) (8592 172) (8593 173) (8595 175) (8712 61258) (8713 61259) (10 13))) (ADDTOVAR CHARACTERNAMES (RSQ "0,271") (LSQ "0,251") (LDQ "0,252") (RDQ "0,272") (NEQ "041,142")) (MAKECHARCODEMAPS) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1600 6330 (INSTALL-CLIPBOARD 1610 . 4003) (GETCLIPBOARD 4005 . 4667) (PUTCLIPBOARD 4669 . 5286) (PASTEFROMCLIPBOARD 5288 . 5905) (LISPINTERRUPTS.PASTE 5907 . 6328)) (6331 10883 ( UTF8.PRINTCCODE 6341 . 8251) (UTF8.READCCODE 8253 . 10881)) (10884 11972 (TEDIT.COPYTOCLIPBOARD 10894 . 11175) (TEDIT.EXTRACTTOCLIPBOARD 11177 . 11641) (TEDIT.SELECTALL 11643 . 11970)) (11973 13359 ( SEDIT.COPYTOCLIPBOARD 11983 . 13357)) (13416 14584 (FILETOCODETABLE 13426 . 14311) (CODECONVERT 14313 . 14582)) (14585 19744 (MAKECHARCODEMAPS 14595 . 19053) (CBMAPCCODE 19055 . 19742))))) STOP \ No newline at end of file diff --git a/library/CLIPBOARD.~44~ b/library/CLIPBOARD.~44~ deleted file mode 100644 index a9f7e62d..00000000 --- a/library/CLIPBOARD.~44~ +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "30-Jul-2020 21:33:30"  {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;44 8581 changes to%: (VARS CLIPBOARDCOMS CBUNICODETOXEROXRENDERING) (FNS GETCLIPBOARD PUTCLIPBOARD) previous date%: "24-Jun-2020 20:17:42" {DSK}kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.;41) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE) (FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD TEDIT.SELECTALL) (FNS SEDIT.COPYTOCLIPBOARD) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD) UNIXCOMM UNICODE) (P (INSTALL-CLIPBOARD))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA PUTCLIPBOARD]) (* ; "Enable copy and paste") (DEFINEQ (INSTALL-CLIPBOARD [LAMBDA NIL (* ; "Edited 24-Jun-2020 20: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)) (INTERRUPTCHAR (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "1,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "1,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "1,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (* ;; "Extract") (TEDIT.SETFUNCTION (CHARCODE "1,X") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,x") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (* ;; "All") (TEDIT.SETFUNCTION (CHARCODE "1,a") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,A") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (* ;; "Quit") (TEDIT.SETFUNCTION (CHARCODE "1,q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,Q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE)) (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;  "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 30-Jul-2020 21:23 by rmk:") (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbpaste")) (\EXTERNALFORMAT s :UTF8) [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION READCCODE) NIL] (CONCATCODES (BIND C WHILE (SETQ C (READCCODE s)) COLLECT C]) (PUTCLIPBOARD (CL:LAMBDA (STRING) (* ; "Edited 30-Jul-2020 21:26 by rmk:") (* ; "Edited 25-Apr-2018 16:49 by rmk:") (* ;; "Clipboard is UNICODE and UTF8") (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM "pbcopy")) (\EXTERNALFORMAT s :UTF8) (PRIN3 STRING s)))) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;;  "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string qujotes ") (LET ((STR (GETCLIPBOARD))) (IF (WINDOWPROP (PROCESS.WINDOW (TTY.PROCESS)) 'COPYINSERTFN) 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]) ) (DEFINEQ (TEDIT.COPYTOCLIPBOARD [LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (TEDIT.EXTRACTTOCLIPBOARD [LAMBDA NIL (* ; "Edited 19-Apr-2020 12:17 by rmk:") (* ; "Edited 18-Apr-2018 00:02 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (IF TEXTSTREAM THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM)) (TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM]) (TEDIT.SELECTALL [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (CL:WHEN TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM))) 'LEFT))]) ) (DEFINEQ (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 5-May-2018 09:43 by rmk:") (* ; "Edited 24-Apr-2018 20:39 by rmk:") (* ; "Edited 24-Apr-2018 20:33 by rmk:") (* ; "Edited 23-Apr-2018 18:19 by rmk:") (LET (SEL SELTYPE STRING) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (CL:MULTIPLE-VALUE-SETQ (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT)) (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (IF SELTYPE THEN (SETQ STRING (MKSTRING SEL T)) (* ; " Readtable of caller?") (CL:WHEN (OR (EQ SELTYPE :CHARACTERS) (AND (EQ SELTYPE :SUB-LIST) (LISTP SEL))) (GNC STRING) (* ;  "Peel off outer parens for structures or quotes for atom/string characters") (GLC STRING)) (PUTCLIPBOARD STRING))) T]) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILESLOAD (SYSLOAD) UNIXCOMM UNICODE) (INSTALL-CLIPBOARD) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA PUTCLIPBOARD) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1279 5776 (INSTALL-CLIPBOARD 1289 . 3682) (GETCLIPBOARD 3684 . 4300) (PUTCLIPBOARD 4302 . 4732) (PASTEFROMCLIPBOARD 4734 . 5351) (LISPINTERRUPTS.PASTE 5353 . 5774)) (5777 6865 ( TEDIT.COPYTOCLIPBOARD 5787 . 6068) (TEDIT.EXTRACTTOCLIPBOARD 6070 . 6534) (TEDIT.SELECTALL 6536 . 6863 )) (6866 8252 (SEDIT.COPYTOCLIPBOARD 6876 . 8250))))) STOP \ No newline at end of file