(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "31-Mar-2024 06:51:14" {DSK}larry>il>medley>library>CLIPBOARD.;2 8932 :EDIT-BY "lmm" :CHANGES-TO (FNS INSTALL-CLIPBOARD) (VARS CLIPBOARDCOMS) :PREVIOUS-DATE "19-Oct-2023 00:20:01" {DSK}larry>il>medley>library>CLIPBOARD.;1) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") (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) 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 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)) (/PUTASSOC 'PASTE [LIST (LIST (CHARCODE "1,v") '(PASTEFROMCLIPBOARD)) (LIST (CHARCODE "1,V") '(PASTEFROMCLIPBOARD] LISPINTERRUPTS) (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]) (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 (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Oct-2023 00:19 by rmk") (* ; "Edited 19-Apr-2020 12:17 by rmk:") (* ; "Edited 18-Apr-2018 00:02 by rmk:") (CL:WHEN TSTREAM (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TSTREAM)) (TEDIT.DELETE TSTREAM SEL))]) ) (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 ) ) (DECLARE%: DONTCOPY (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