Skip to content

Commit e40d331

Browse files
rmkaplanrmkaplan
authored
Rmk16 remove tedit special stuff from CLIPBOARD, move it to TEDIT-COMMAND. (#1676)
* CLIPBOARD: Remove Tedit-specific code * TEDIT-COMMAND: Add interface to Clipboard This also implements a different way of dealing with image objects in the selection. Instead of causing an error (since an imageobject can't be printed to the clipboard stream), it tries to put out a useful representation of the object. If the object has a preprint function, it applies that. Otherwise, it prints out the name of the getfn. Other objects can be explored.
1 parent 047aa5f commit e40d331

File tree

4 files changed

+164
-73
lines changed

4 files changed

+164
-73
lines changed

‎library/CLIPBOARD‎

Lines changed: 8 additions & 53 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

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

5-
:EDIT-BY "lmm"
5+
:EDIT-BY rmk
66

77
:CHANGES-TO (FNS INSTALL-CLIPBOARD)
88
(VARS CLIPBOARDCOMS)
99

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

1212

1313
(PRETTYCOMPRINT CLIPBOARDCOMS)
@@ -16,7 +16,6 @@
1616
[ (* ; "Enable copy and paste")
1717
(FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD CLIPBOARD-COPY-STREAM
1818
CLIPBOARD-PASTE-STREAM)
19-
(FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD)
2019
(FNS SEDIT.COPYTOCLIPBOARD)
2120
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
2221
UNIXCOMM UNICODE)
@@ -32,7 +31,8 @@
3231
(DEFINEQ
3332

3433
(INSTALL-CLIPBOARD
35-
[LAMBDA NIL (* ; "Edited 30-Mar-2024 22:22 by lmm")
34+
[LAMBDA NIL (* ; "Edited 21-Apr-2024 08:56 by rmk")
35+
(* ; "Edited 30-Mar-2024 22:22 by lmm")
3636
(* ; "Edited 24-Jun-2021 21:14 by rmk:")
3737
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
3838
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
@@ -45,34 +45,6 @@
4545
(LIST (CHARCODE "1,V")
4646
'(PASTEFROMCLIPBOARD]
4747
LISPINTERRUPTS)
48-
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
49-
50-
(* ;; "Paste")
51-
52-
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
53-
(FUNCTION PASTEFROMCLIPBOARD)
54-
TEDIT.READTABLE)
55-
(TEDIT.SETFUNCTION (CHARCODE "Meta,V")
56-
(FUNCTION PASTEFROMCLIPBOARD)
57-
TEDIT.READTABLE)
58-
59-
(* ;; "Copy")
60-
61-
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
62-
(FUNCTION TEDIT.COPYTOCLIPBOARD)
63-
TEDIT.READTABLE)
64-
(TEDIT.SETFUNCTION (CHARCODE "Meta,C")
65-
(FUNCTION TEDIT.COPYTOCLIPBOARD)
66-
TEDIT.READTABLE)
67-
68-
(* ;; "Extract")
69-
70-
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
71-
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
72-
TEDIT.READTABLE)
73-
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
74-
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
75-
TEDIT.READTABLE))
7648
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
7749
 "SEDIT copy: INTERRUPTCHAR does paste")
7850
(SEDIT:ADD-COMMAND "Meta,c" 'SEDIT.COPYTOCLIPBOARD "M-c" "Copy to clipboard")
@@ -131,22 +103,6 @@
131103
)
132104
(DEFINEQ
133105

134-
(TEDIT.COPYTOCLIPBOARD
135-
[LAMBDA NIL (* ; "Edited 18-Apr-2018 00:02 by rmk:")
136-
(LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
137-
(IF TEXTSTREAM
138-
THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM])
139-
140-
(TEDIT.EXTRACTTOCLIPBOARD
141-
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Oct-2023 00:19 by rmk")
142-
(* ; "Edited 19-Apr-2020 12:17 by rmk:")
143-
(* ; "Edited 18-Apr-2018 00:02 by rmk:")
144-
(CL:WHEN TSTREAM
145-
(PUTCLIPBOARD (TEDIT.SEL.AS.STRING TSTREAM))
146-
(TEDIT.DELETE TSTREAM SEL))])
147-
)
148-
(DEFINEQ
149-
150106
(SEDIT.COPYTOCLIPBOARD
151107
[LAMBDA (CONTEXT) (* ; "Edited 8-Aug-2020 15:25 by rmk:")
152108
(* ; "Edited 24-Apr-2018 20:39 by rmk:")
@@ -190,8 +146,7 @@
190146
(ADDTOVAR LAMA )
191147
)
192148
(DECLARE%: DONTCOPY
193-
(FILEMAP (NIL (1243 6345 (INSTALL-CLIPBOARD 1253 . 3401) (GETCLIPBOARD 3403 . 3777) (PUTCLIPBOARD 3779
194-
. 4184) (PASTEFROMCLIPBOARD 4186 . 5104) (CLIPBOARD-COPY-STREAM 5106 . 5621) (CLIPBOARD-PASTE-STREAM
195-
5623 . 6343)) (6346 7113 (TEDIT.COPYTOCLIPBOARD 6356 . 6637) (TEDIT.EXTRACTTOCLIPBOARD 6639 . 7111)) (
196-
7114 8653 (SEDIT.COPYTOCLIPBOARD 7124 . 8651)))))
149+
(FILEMAP (NIL (1148 5429 (INSTALL-CLIPBOARD 1158 . 2485) (GETCLIPBOARD 2487 . 2861) (PUTCLIPBOARD 2863
150+
. 3268) (PASTEFROMCLIPBOARD 3270 . 4188) (CLIPBOARD-COPY-STREAM 4190 . 4705) (CLIPBOARD-PASTE-STREAM
151+
4707 . 5427)) (5430 6969 (SEDIT.COPYTOCLIPBOARD 5440 . 6967)))))
197152
STOP

‎library/CLIPBOARD.LCOM‎

-799 Bytes
Binary file not shown.

‎library/tedit/TEDIT-COMMAND‎

Lines changed: 156 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,15 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

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

56
:EDIT-BY rmk
67

7-
:CHANGES-TO (FNS \TEDIT.INTERRUPT.SETUP)
8+
:CHANGES-TO (FNS \TEDIT.COPYTOCLIPBOARD \TEDIT.WRITE.SEL)
9+
(MACROS \TEDIT.MOUSESTATE)
810

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

1114

1215
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
@@ -70,12 +73,19 @@
7073
\TEDIT.WORDBOUND.READTABLE
7174
]
7275
(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE))
73-
(COMS (* ; "Wheelscroll")
76+
[COMS (* ; "Wheelscroll")
7477
(FILES (SYSLOAD FROM LISPUSERS)
7578
WHEELSCROLL)
7679
(FNS \TEDIT.WHEELSCROLL)
7780
(GLOBALVARS WHEELSCROLLCHARCODES)
78-
(VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL])
81+
(VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL]
82+
(COMS (* ; "Clipboard")
83+
(FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL
84+
)
85+
[DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY (CONSTANTS (CLIPBOARDCODES
86+
(CHARCODE (meta,C meta,X meta,c
87+
meta,X]
88+
(P (\TEDIT.CLIPBOARD])
7989
(DECLARE%: EVAL@COMPILE DONTCOPY
8090
(DECLARE%: EVAL@COMPILE
8191

@@ -155,14 +165,12 @@
155165

156166
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON
157167

158-
(* Test to see if only the specified mouse button is down.
159-
 DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last
160-
 time it WAS called.)
168+
(* ;; "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.")
161169

162170
(SELECTQ (CAR BUTTON)
163-
(LEFT '(IEQP LASTMOUSEBUTTONS 4))
164-
(MIDDLE '(IEQP LASTMOUSEBUTTONS 1))
165-
(RIGHT '(IEQP LASTMOUSEBUTTONS 2))
171+
(LEFT '(EQ LASTMOUSEBUTTONS 4))
172+
(MIDDLE '(EQ LASTMOUSEBUTTONS 1))
173+
(RIGHT '(EQ LASTMOUSEBUTTONS 2))
166174
(SHOULDNT))))
167175

168176
(PUTPROPS \TEDIT.CHECK MACRO [ARGS (COND
@@ -249,7 +257,9 @@
249257
TEXTOBJ])
250258

251259
(\TEDIT.COMMAND.LOOP
252-
[LAMBDA (STREAM RTBL) (* ; "Edited 20-Mar-2024 10:59 by rmk")
260+
[LAMBDA (STREAM RTBL) (* ; "Edited 21-Apr-2024 09:08 by rmk")
261+
(* ; "Edited 2-Apr-2024 15:35 by rmk")
262+
(* ; "Edited 20-Mar-2024 10:59 by rmk")
253263
(* ; "Edited 15-Mar-2024 14:23 by rmk")
254264
(* ; "Edited 9-Mar-2024 11:35 by rmk")
255265
(* ; "Edited 24-Feb-2024 15:33 by rmk")
@@ -394,9 +404,13 @@
394404
(* ; "do it")
395405
(* ;
396406
 "After a user function (that is not wheelscroll) no more blue-pending-delete")
397-
(CL:UNLESS (MEMB CH WHEELSCROLLCHARCODES)
407+
408+
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
409+
410+
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
411+
(MEMB CH CLIPBOARDCODES))
398412
(* ;
399-
 "The wheelscroll FN handled the selection. should preserve the highlighting")
413+
 "The FNs handled the selection. should preserve the highlighting")
400414
(\TEDIT.SHOWSEL SEL NIL)
401415
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
402416
(\TEDIT.SHOWSEL SEL T))))
@@ -839,11 +853,133 @@
839853
)
840854

841855
(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL))
856+
857+
858+
859+
(* ; "Clipboard")
860+
861+
(DEFINEQ
862+
863+
(\TEDIT.CLIPBOARD
864+
[LAMBDA NIL (* ; "Edited 21-Apr-2024 09:57 by rmk")
865+
(* ; "Edited 2-Oct-2023 23:23 by rmk")
866+
867+
(* ;; "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.")
868+
869+
(* ;; "Clipboard paste")
870+
871+
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
872+
(FUNCTION PASTEFROMCLIPBOARD)
873+
TEDIT.READTABLE)
874+
(TEDIT.SETFUNCTION (CHARCODE "Meta,V")
875+
(FUNCTION PASTEFROMCLIPBOARD)
876+
TEDIT.READTABLE)
877+
878+
(* ;; "Clipboard copy")
879+
880+
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
881+
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
882+
TEDIT.READTABLE)
883+
(TEDIT.SETFUNCTION (CHARCODE "Meta,C")
884+
(FUNCTION \TEDIT.COPYTOCLIPBOARD)
885+
TEDIT.READTABLE)
886+
887+
(* ;; "Clipboard extract")
888+
889+
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
890+
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
891+
TEDIT.READTABLE)
892+
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
893+
(FUNCTION \TEDIT.EXTRACTTOCLIPBOARD)
894+
TEDIT.READTABLE)
895+
896+
(* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).")
897+
898+
(for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I)
899+
`[LAMBDA NIL
900+
(AND WHEELSCROLLENABLED ,(CADR I]
901+
TEDIT.READTABLE)
902+
(CAR I])
903+
904+
(\TEDIT.COPYTOCLIPBOARD
905+
[LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT) (* ; "Edited 21-Apr-2024 11:51 by rmk")
906+
(* ; "Edited 2-Apr-2024 17:01 by rmk")
907+
(* ; "Edited 18-Apr-2018 00:02 by rmk:")
908+
909+
(* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored). .")
910+
911+
(CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD))
912+
(SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS))
913+
T))
914+
(CL:WHEN TSTREAM
915+
(PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL))
916+
(CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))])
917+
918+
(\TEDIT.EXTRACTTOCLIPBOARD
919+
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Apr-2024 09:20 by rmk")
920+
(\TEDIT.COPYTOCLIPBOARD TSTREAM TEXTOBJ SEL T])
921+
922+
(\TEDIT.WRITE.SEL
923+
[LAMBDA (TSTREAM STREAM) (* ; "Edited 21-Apr-2024 11:55 by rmk")
924+
925+
(* ;; "Writes the selected characters in TSTREAM to STREAM. ")
926+
927+
(* ;; "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.")
928+
929+
(* ;; "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).")
930+
931+
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
932+
(SEL (FGETTOBJ TEXTOBJ SEL)))
933+
(CL:WHEN (IGREATERP (GETSEL SEL DCH)
934+
0)
935+
936+
(* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.")
937+
938+
(for I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE))
939+
(NOBJECTS _ 0) from (GETSEL SEL CH#) to (SUB1 (GETSEL SEL CHLIM))
940+
while (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I))
941+
do (if (CHARCODEP CODE)
942+
then (PRINTCCODE CODE STREAM)
943+
elseif (IMAGEOBJP CODE)
944+
then (add NOBJECTS 1)
945+
(if OBJECTBYTE
946+
then (PRINTCCODE OBJECTBYTE STREAM)
947+
else (PRIN3 "{" STREAM)
948+
(PRIN4 (IMAGEOBJPROP CODE 'GETFN)
949+
STREAM)
950+
(CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN)
951+
(FUNCTION NILL))
952+
PRE CODE))
953+
(PRIN3 " : " STREAM)
954+
(PRIN4 PRE STREAM))
955+
(PRIN3 "}" STREAM))
956+
else (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE))
957+
finally (CL:WHEN (IGREATERP NOBJECTS 0)
958+
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note: Selection contains " NOBJECTS
959+
" image object"
960+
(CL:IF (EQ NOBJECTS 1)
961+
""
962+
"s"))
963+
T))))])
964+
)
965+
(DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY
966+
(DECLARE%: EVAL@COMPILE
967+
968+
(RPAQ CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X)))
969+
970+
971+
[CONSTANTS (CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X]
972+
)
973+
)
974+
975+
(\TEDIT.CLIPBOARD)
842976
(DECLARE%: DONTCOPY
843-
(FILEMAP (NIL (7795 29756 (\TEDIT.INTERRUPT.SETUP 7805 . 9452) (\TEDIT.MARKACTIVE 9454 . 9666) (
844-
\TEDIT.MARKINACTIVE 9668 . 9884) (\TEDIT.COMMAND.LOOP 9886 . 23156) (\TEDIT.COMMAND.RESET.SETUP 23158
845-
. 29754)) (30040 45237 (\TEDIT.READTABLE 30050 . 31707) (\TEDIT.WORDBOUND.READTABLE 31709 . 34302) (
846-
TEDIT.GETSYNTAX 34304 . 36743) (TEDIT.SETSYNTAX 36745 . 39223) (TEDIT.GETFUNCTION 39225 . 40585) (
847-
TEDIT.SETFUNCTION 40587 . 43026) (TEDIT.WORDGET 43028 . 43289) (TEDIT.WORDSET 43291 . 43988) (
848-
TEDIT.ATOMBOUND.READTABLE 43990 . 45235)) (45565 46474 (\TEDIT.WHEELSCROLL 45575 . 46472)))))
977+
(FILEMAP (NIL (8457 30896 (\TEDIT.INTERRUPT.SETUP 8467 . 10114) (\TEDIT.MARKACTIVE 10116 . 10328) (
978+
\TEDIT.MARKINACTIVE 10330 . 10546) (\TEDIT.COMMAND.LOOP 10548 . 24296) (\TEDIT.COMMAND.RESET.SETUP
979+
24298 . 30894)) (31180 46377 (\TEDIT.READTABLE 31190 . 32847) (\TEDIT.WORDBOUND.READTABLE 32849 .
980+
35442) (TEDIT.GETSYNTAX 35444 . 37883) (TEDIT.SETSYNTAX 37885 . 40363) (TEDIT.GETFUNCTION 40365 .
981+
41725) (TEDIT.SETFUNCTION 41727 . 44166) (TEDIT.WORDGET 44168 . 44429) (TEDIT.WORDSET 44431 . 45128) (
982+
TEDIT.ATOMBOUND.READTABLE 45130 . 46375)) (46705 47614 (\TEDIT.WHEELSCROLL 46715 . 47612)) (47767
983+
53347 (\TEDIT.CLIPBOARD 47777 . 49532) (\TEDIT.COPYTOCLIPBOARD 49534 . 50314) (
984+
\TEDIT.EXTRACTTOCLIPBOARD 50316 . 50511) (\TEDIT.WRITE.SEL 50513 . 53345)))))
849985
STOP

‎library/tedit/TEDIT-COMMAND.LCOM‎

2.4 KB
Binary file not shown.

0 commit comments

Comments
 (0)