Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Rmk16 remove tedit special stuff from CLIPBOARD, move it to TEDIT-COMMAND. #1676

Merged
merged 2 commits into from
Apr 30, 2024
Merged

Rmk16 remove tedit special stuff from CLIPBOARD, move it to TEDIT-COMMAND. #1676

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4fd3c10
CLIPBOARD: Remove Tedit-specific code
rmkaplan Apr 21, 2024
b94a9fb
TEDIT-COMMAND: Add interface to Clipboard
rmkaplan Apr 21, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
61 changes: 8 additions & 53 deletions library/CLIPBOARD
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "31-Mar-2024 06:51:14" {DSK}<home>larry>il>medley>library>CLIPBOARD.;2 8932
(FILECREATED "21-Apr-2024 09:12:04" {WMEDLEY}<library>CLIPBOARD.;18 7248

:EDIT-BY "lmm"
:EDIT-BY rmk

:CHANGES-TO (FNS INSTALL-CLIPBOARD)
(VARS CLIPBOARDCOMS)

:PREVIOUS-DATE "19-Oct-2023 00:20:01" {DSK}<home>larry>il>medley>library>CLIPBOARD.;1)
:PREVIOUS-DATE " 2-Apr-2024 17:02:09" {WMEDLEY}<library>CLIPBOARD.;17)


(PRETTYCOMPRINT CLIPBOARDCOMS)
Expand All @@ -16,7 +16,6 @@
[ (* ; "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)
Expand All @@ -32,7 +31,8 @@
(DEFINEQ

(INSTALL-CLIPBOARD
[LAMBDA NIL (* ; "Edited 30-Mar-2024 22:22 by lmm")
[LAMBDA NIL (* ; "Edited 21-Apr-2024 08:56 by rmk")
(* ; "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:")
Expand All @@ -45,34 +45,6 @@
(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")
Expand Down Expand Up @@ -131,22 +103,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 (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:")
Expand Down Expand Up @@ -190,8 +146,7 @@
(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)))))
(FILEMAP (NIL (1148 5429 (INSTALL-CLIPBOARD 1158 . 2485) (GETCLIPBOARD 2487 . 2861) (PUTCLIPBOARD 2863
. 3268) (PASTEFROMCLIPBOARD 3270 . 4188) (CLIPBOARD-COPY-STREAM 4190 . 4705) (CLIPBOARD-PASTE-STREAM
4707 . 5427)) (5430 6969 (SEDIT.COPYTOCLIPBOARD 5440 . 6967)))))
STOP
Binary file modified library/CLIPBOARD.LCOM
View file
Open in desktop
Binary file not shown.
176 changes: 156 additions & 20 deletions library/tedit/TEDIT-COMMAND
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "27-Mar-2024 15:28:15" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;71 46623
(FILECREATED "21-Apr-2024 11:55:17" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;87 53604

:EDIT-BY rmk

:CHANGES-TO (FNS \TEDIT.INTERRUPT.SETUP)
:CHANGES-TO (FNS \TEDIT.COPYTOCLIPBOARD \TEDIT.WRITE.SEL)
(MACROS \TEDIT.MOUSESTATE)

:PREVIOUS-DATE "20-Mar-2024 11:07:16" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;70)
:PREVIOUS-DATE "21-Apr-2024 10:17:38"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;80)


(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
Expand Down Expand Up @@ -70,12 +73,19 @@
\TEDIT.WORDBOUND.READTABLE
]
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE))
(COMS (* ; "Wheelscroll")
[COMS (* ; "Wheelscroll")
(FILES (SYSLOAD FROM LISPUSERS)
WHEELSCROLL)
(FNS \TEDIT.WHEELSCROLL)
(GLOBALVARS WHEELSCROLLCHARCODES)
(VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL])
(VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL]
(COMS (* ; "Clipboard")
(FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL
)
[DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY (CONSTANTS (CLIPBOARDCODES
(CHARCODE (meta,C meta,X meta,c
meta,X]
(P (\TEDIT.CLIPBOARD])
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE

Expand Down Expand Up @@ -155,14 +165,12 @@

(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON

(* Test to see if only the specified mouse button is down.
 DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last
 time it WAS called.)
(* ;; "Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called.")

(SELECTQ (CAR BUTTON)
(LEFT '(IEQP LASTMOUSEBUTTONS 4))
(MIDDLE '(IEQP LASTMOUSEBUTTONS 1))
(RIGHT '(IEQP LASTMOUSEBUTTONS 2))
(LEFT '(EQ LASTMOUSEBUTTONS 4))
(MIDDLE '(EQ LASTMOUSEBUTTONS 1))
(RIGHT '(EQ LASTMOUSEBUTTONS 2))
(SHOULDNT))))

(PUTPROPS \TEDIT.CHECK MACRO [ARGS (COND
Expand Down Expand Up @@ -249,7 +257,9 @@
TEXTOBJ])

(\TEDIT.COMMAND.LOOP
[LAMBDA (STREAM RTBL) (* ; "Edited 20-Mar-2024 10:59 by rmk")
[LAMBDA (STREAM RTBL) (* ; "Edited 21-Apr-2024 09:08 by rmk")
(* ; "Edited 2-Apr-2024 15:35 by rmk")
(* ; "Edited 20-Mar-2024 10:59 by rmk")
(* ; "Edited 15-Mar-2024 14:23 by rmk")
(* ; "Edited 9-Mar-2024 11:35 by rmk")
(* ; "Edited 24-Feb-2024 15:33 by rmk")
Expand Down Expand Up @@ -394,9 +404,13 @@
(* ; "do it")
(* ;
 "After a user function (that is not wheelscroll) no more blue-pending-delete")
(CL:UNLESS (MEMB CH WHEELSCROLLCHARCODES)

(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")

(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
(MEMB CH CLIPBOARDCODES))
(* ;
 "The wheelscroll FN handled the selection. should preserve the highlighting")
 "The FNs handled the selection. should preserve the highlighting")
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T))))
Expand Down Expand Up @@ -839,11 +853,133 @@
)

(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL))



(* ; "Clipboard")

(DEFINEQ

(\TEDIT.CLIPBOARD
[LAMBDA NIL (* ; "Edited 21-Apr-2024 09:57 by rmk")
(* ; "Edited 2-Oct-2023 23:23 by rmk")

(* ;; "TEDIT disables interrupts, so it has to deal with special interrupt behaviors when the caret is in the Tedit window. This localizes the behavior of WHEELSCROLL and CLIPBOARD inside Tedit.")

(* ;; "Clipboard paste")

(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
(FUNCTION PASTEFROMCLIPBOARD)
TEDIT.READTABLE)
(TEDIT.SETFUNCTION (CHARCODE "Meta,V")
(FUNCTION PASTEFROMCLIPBOARD)
TEDIT.READTABLE)

(* ;; "Clipboard copy")

(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
TEDIT.READTABLE)
(TEDIT.SETFUNCTION (CHARCODE "Meta,C")
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
TEDIT.READTABLE)

(* ;; "Clipboard extract")

(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
TEDIT.READTABLE)
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
TEDIT.READTABLE)

(* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")

(for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I)
`[LAMBDA NIL
(AND WHEELSCROLLENABLED ,(CADR I]
TEDIT.READTABLE)
(CAR I])

(\TEDIT.COPYTOCLIPBOARD
[LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT) (* ; "Edited 21-Apr-2024 11:51 by rmk")
(* ; "Edited 2-Apr-2024 17:01 by rmk")
(* ; "Edited 18-Apr-2018 00:02 by rmk:")

(* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored). .")

(CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD))
(SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS))
T))
(CL:WHEN TSTREAM
(PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL))
(CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))])

(\TEDIT.EXTRACTTOCLIPBOARD
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Apr-2024 09:20 by rmk")
(\TEDIT.COPYTOCLIPBOARD TSTREAM TEXTOBJ SEL T])

(\TEDIT.WRITE.SEL
[LAMBDA (TSTREAM STREAM) (* ; "Edited 21-Apr-2024 11:55 by rmk")

(* ;; "Writes the selected characters in TSTREAM to STREAM. ")

(* ;; "If there are no image objects, this is equivalent to (PRIN3 (TEDIT.SEL.AS.STRING ...)), but that would trip over image objects. Image objects could be skipped, or as here, represented as the OBJECTBYTE or described in some way.")

(* ;; "For Medley-to-Medley copy/paste we could also create a local tmp stream that shadows the system clipboard, and apply the PUTFN to that stream. Then copy/paste could be used to move image objects around with a single Medley or perhaps across Medley's (if the GETFN is available).")

(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
(SEL (FGETTOBJ TEXTOBJ SEL)))
(CL:WHEN (IGREATERP (GETSEL SEL DCH)
0)

(* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.")

(for I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE))
(NOBJECTS _ 0) from (GETSEL SEL CH#) to (SUB1 (GETSEL SEL CHLIM))
while (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I))
do (if (CHARCODEP CODE)
then (PRINTCCODE CODE STREAM)
elseif (IMAGEOBJP CODE)
then (add NOBJECTS 1)
(if OBJECTBYTE
then (PRINTCCODE OBJECTBYTE STREAM)
else (PRIN3 "{" STREAM)
(PRIN4 (IMAGEOBJPROP CODE 'GETFN)
STREAM)
(CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN)
(FUNCTION NILL))
PRE CODE))
(PRIN3 " : " STREAM)
(PRIN4 PRE STREAM))
(PRIN3 "}" STREAM))
else (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE))
finally (CL:WHEN (IGREATERP NOBJECTS 0)
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note: Selection contains " NOBJECTS
" image object"
(CL:IF (EQ NOBJECTS 1)
""
"s"))
T))))])
)
(DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE

(RPAQ CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X)))


[CONSTANTS (CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X]
)
)

(\TEDIT.CLIPBOARD)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7795 29756 (\TEDIT.INTERRUPT.SETUP 7805 . 9452) (\TEDIT.MARKACTIVE 9454 . 9666) (
\TEDIT.MARKINACTIVE 9668 . 9884) (\TEDIT.COMMAND.LOOP 9886 . 23156) (\TEDIT.COMMAND.RESET.SETUP 23158
. 29754)) (30040 45237 (\TEDIT.READTABLE 30050 . 31707) (\TEDIT.WORDBOUND.READTABLE 31709 . 34302) (
TEDIT.GETSYNTAX 34304 . 36743) (TEDIT.SETSYNTAX 36745 . 39223) (TEDIT.GETFUNCTION 39225 . 40585) (
TEDIT.SETFUNCTION 40587 . 43026) (TEDIT.WORDGET 43028 . 43289) (TEDIT.WORDSET 43291 . 43988) (
TEDIT.ATOMBOUND.READTABLE 43990 . 45235)) (45565 46474 (\TEDIT.WHEELSCROLL 45575 . 46472)))))
(FILEMAP (NIL (8457 30896 (\TEDIT.INTERRUPT.SETUP 8467 . 10114) (\TEDIT.MARKACTIVE 10116 . 10328) (
\TEDIT.MARKINACTIVE 10330 . 10546) (\TEDIT.COMMAND.LOOP 10548 . 24296) (\TEDIT.COMMAND.RESET.SETUP
24298 . 30894)) (31180 46377 (\TEDIT.READTABLE 31190 . 32847) (\TEDIT.WORDBOUND.READTABLE 32849 .
35442) (TEDIT.GETSYNTAX 35444 . 37883) (TEDIT.SETSYNTAX 37885 . 40363) (TEDIT.GETFUNCTION 40365 .
41725) (TEDIT.SETFUNCTION 41727 . 44166) (TEDIT.WORDGET 44168 . 44429) (TEDIT.WORDSET 44431 . 45128) (
TEDIT.ATOMBOUND.READTABLE 45130 . 46375)) (46705 47614 (\TEDIT.WHEELSCROLL 46715 . 47612)) (47767
53347 (\TEDIT.CLIPBOARD 47777 . 49532) (\TEDIT.COPYTOCLIPBOARD 49534 . 50314) (
\TEDIT.EXTRACTTOCLIPBOARD 50316 . 50511) (\TEDIT.WRITE.SEL 50513 . 53345)))))
STOP
Binary file modified library/tedit/TEDIT-COMMAND.LCOM
View file
Open in desktop
Binary file not shown.