(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 7-Jul-2022 23:53:01"  {DSK}kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;7 9243 :CHANGES-TO (VARS CLIPBOARDCOMS) (FNS CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM) :PREVIOUS-DATE " 3-Jul-2021 13:16:26" {DSK}kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;6) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM) (FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD) (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]) (* ; "Enable copy and paste") (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)) (INTERRUPTCHAR (CHARCODE "Meta,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "Meta,V") '(PASTEFROMCLIPBOARD)) (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "Meta,v") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "Meta,V") (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "Meta,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "Meta,C") (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) (* ;; "Extract") (TEDIT.SETFUNCTION (CHARCODE "Meta,X") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "Meta,x") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE)) (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))]) (GETCLIPBOARD [LAMBDA NIL (* ; "Edited 23-Feb-2021 11:32 by rmk:") (* ; "Edited 25-Apr-2018 16:56 by rmk:") (CL:WITH-OPEN-STREAM (s (CLIPBOARD-PASTE-STREAM)) (CONCATCODES (BIND C WHILE (SETQ C (READCCODE s)) COLLECT C]) (PUTCLIPBOARD [LAMBDA (OBJECT PRINTFN) (* ; "Edited 23-Feb-2021 11:32 by rmk:") (* ; "Edited 25-Apr-2018 16:49 by rmk:") (CL:WITH-OPEN-STREAM (s (CLIPBOARD-COPY-STREAM)) (IF PRINTFN THEN (APPLY* PRINTFN OBJECT s) ELSE (PRIN3 OBJECT s]) (PASTEFROMCLIPBOARD [LAMBDA NIL (* ; "Edited 15-Feb-2021 23:43 by rmk:") (* ; "Edited 18-Apr-2018 13:56 by rmk:") (* ; "Edited 17-Apr-2018 23:11 by rmk:") (* ;; "If for some reason TTY process doesn't have a window (e.g. TEXEC), we can only do the character printing. Presumably the right thing to do--no image objects in an exec.") (* ;; "Should be able to just call COPYINSERT, but the default BKSYSBUF puts in string quotes.") (LET [(STR (GETCLIPBOARD)) (WINDOW (PROCESS.WINDOW (TTY.PROCESS] (IF (AND WINDOW (WINDOWPROP WINDOW '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]) (CLIPBOARD-COPY-STREAM [LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk") (* ; "Edited 23-Feb-2021 22:11 by rmk:") (LET (STRM (OST (UNIX-GETENV "OSTYPE"))) (SETQ STRM (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" OST) "pbcopy" "xclip -i -selection clipboard"))) STRM]) (CLIPBOARD-PASTE-STREAM [LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk") (* ; "Edited 23-Feb-2021 17:29 by rmk:") (LET (STRM (OST (UNIX-GETENV "OSTYPE"))) (SETQ STRM (CREATE-PROCESS-STREAM (CL:IF (STRPOS "darwin" OST) "pbpaste" "xclip -o -selection clipboard"))) [SETFILEINFO STRM 'ENDOFSTREAMOP #'(CL:LAMBDA (s) (RETFROM (FUNCTION READCCODE) NIL] STRM]) ) (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]) ) (DEFINEQ (SEDIT.COPYTOCLIPBOARD [LAMBDA (CONTEXT) (* ; "Edited 8-Aug-2020 15:25 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:") [CL:MULTIPLE-VALUE-BIND (SEL SELTYPE) (SEDIT:GET-SELECTION CONTEXT) (* ;; "SEL could be a list of several elements, or a structure, depending on SELTYPE. ") (* ;; "SELTYPE=NIL means not a valid selection, and SEL is NIL. Non-NIL values are :SUB-LIST, :CHARACTERS, and T") (CL:WHEN SELTYPE [PUTCLIPBOARD (CONS SEL (EQ SELTYPE :SUB-LIST)) (FUNCTION (LAMBDA (PAIR STREAM) (LET ((*PRINT-PRETTY* T) (PRETTYTABFLG NIL) (FONTCHANGEFLG NIL) (%#RPARS NIL)) (DECLARE (SPECVARS *PRINT-PRETTY* %#RPARS PRETTYTABFLG FONTCHANGEFLG)) (PRINTDEF (CAR PAIR) 0 NIL (CDR PAIR) NIL STREAM])] 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 ) ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1317 6626 (INSTALL-CLIPBOARD 1327 . 3259) (GETCLIPBOARD 3261 . 3635) (PUTCLIPBOARD 3637 . 4042) (PASTEFROMCLIPBOARD 4044 . 4962) (LISPINTERRUPTS.PASTE 4964 . 5385) (CLIPBOARD-COPY-STREAM 5387 . 5902) (CLIPBOARD-PASTE-STREAM 5904 . 6624)) (6627 7386 (TEDIT.COPYTOCLIPBOARD 6637 . 6918) ( TEDIT.EXTRACTTOCLIPBOARD 6920 . 7384)) (7387 8926 (SEDIT.COPYTOCLIPBOARD 7397 . 8924))))) STOP