diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/clipboard.n | 9 | ||||
| -rw-r--r-- | generic/tkClipboard.c | 96 | ||||
| -rw-r--r-- | tests/clipboard.test | 50 |
4 files changed, 135 insertions, 28 deletions
@@ -1,5 +1,13 @@ 2000-05-14 Eric Melski <ericm@scriptics.com> + * doc/clipboard.n: Added documentation for "clipboard get". + + * generic/tkClipboard.c (Tk_ClipboardCmd): Added "clipboard get" + subcommand [RFE: 4628]. + + * tests/clipboard.test: Updated to use "clipboard get" instead of + "selection get -s CLIPBOARD". + * library/entry.tcl: Adjusted Button-1 binding to set focus to the entry when it is readonly or normal. diff --git a/doc/clipboard.n b/doc/clipboard.n index 44bb3bb..3417623 100644 --- a/doc/clipboard.n +++ b/doc/clipboard.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: clipboard.n,v 1.2 1998/09/14 18:22:55 stanton Exp $ +'\" RCS: @(#) $Id: clipboard.n,v 1.3 2000/05/14 23:25:03 ericm Exp $ '\" .so man.macros .TH clipboard n 4.0 Tk "Tk Built-In Commands" @@ -76,6 +76,13 @@ next argument will always be used as \fIdata\fR. This feature may be convenient if, for example, \fIdata\fR starts with a \fB\-\fR. .RE +.TP +\fBclipboard get\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-type\fR? +Retrieve data from the clipboard on \fIwindow\fR's display. +\fIwindow\fR defaults to ".". \fIType\fR specifies the form in which +the data is to be returned and should be an atom name such as STRING +or FILE_NAME. \fIType\fR defaults to STRING. This command is +equivalent to \fBselection get -selection CLIPBOARD\fR. .SH KEYWORDS clear, format, clipboard, append, selection, type diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index 4ed3bd9..5791c95 100644 --- a/generic/tkClipboard.c +++ b/generic/tkClipboard.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkClipboard.c,v 1.5 1999/04/21 21:53:25 rjohnson Exp $ + * RCS: @(#) $Id: tkClipboard.c,v 1.6 2000/05/14 23:25:04 ericm Exp $ */ #include "tkInt.h" @@ -30,6 +30,8 @@ static int ClipboardWindowHandler _ANSI_ARGS_(( ClientData clientData, int offset, char *buffer, int maxBytes)); static void ClipboardLostSel _ANSI_ARGS_((ClientData clientData)); +static int ClipboardGetProc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, char *portion)); /* *---------------------------------------------------------------------- @@ -432,6 +434,7 @@ Tk_ClipboardCmd(clientData, interp, argc, argv) Tk_Window tkwin = (Tk_Window) clientData; char *path = NULL; size_t length; + Atom selection; int count; char c; char **args; @@ -527,10 +530,67 @@ Tk_ClipboardCmd(clientData, interp, argc, argv) return TCL_ERROR; } return Tk_ClipboardClear(interp, tkwin); + } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) { + Atom target; + char *targetName = NULL; + Tcl_DString selBytes; + int result; + for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) { + if (args[0][0] != '-') { + break; + } + if (count < 2) { + Tcl_AppendResult(interp, "value for \"", *args, + "\" missing", (char *) NULL); + return TCL_ERROR; + } + c = args[0][1]; + length = strlen(args[0]); + if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) { + path = args[1]; + } else if ((c == 't') + && (strncmp(args[0], "-type", length) == 0)) { + targetName = args[1]; + } else { + Tcl_AppendResult(interp, "unknown option \"", args[0], + "\"", (char *) NULL); + return TCL_ERROR; + } + } + if (path != NULL) { + tkwin = Tk_NameToWindow(interp, path, tkwin); + } + if (tkwin == NULL) { + return TCL_ERROR; + } + selection = Tk_InternAtom(tkwin, "CLIPBOARD"); + + if (count > 1) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " get ?options?\"", (char *) NULL); + return TCL_ERROR; + } else if (count == 1) { + target = Tk_InternAtom(tkwin, args[0]); + } else if (targetName != NULL) { + target = Tk_InternAtom(tkwin, targetName); + } else { + target = XA_STRING; + } + + Tcl_DStringInit(&selBytes); + result = Tk_GetSelection(interp, tkwin, selection, target, + ClipboardGetProc, (ClientData) &selBytes); + if (result == TCL_OK) { + Tcl_DStringResult(interp, &selBytes); + } else { + Tcl_DStringFree(&selBytes); + } + return result; } else { char buf[100 + TCL_INTEGER_SPACE]; - sprintf(buf, "bad option \"%.50s\": must be clear or append", argv[1]); + sprintf(buf, "bad option \"%.50s\": must be append, clear, or get", + argv[1]); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } @@ -605,3 +665,35 @@ TkClipInit(interp, dispPtr) (ClientData) dispPtr, XA_STRING); return TCL_OK; } + +/* + *-------------------------------------------------------------- + * + * ClipboardGetProc -- + * + * This procedure is invoked to process pieces of the selection + * as they arrive during "clipboard get" commands. + * + * Results: + * Always returns TCL_OK. + * + * Side effects: + * Bytes get appended to the dynamic string pointed to by the + * clientData argument. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +ClipboardGetProc(clientData, interp, portion) + ClientData clientData; /* Dynamic string holding partially + * assembled selection. */ + Tcl_Interp *interp; /* Interpreter used for error + * reporting (not used). */ + char *portion; /* New information to be appended. */ +{ + Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1); + return TCL_OK; +} + diff --git a/tests/clipboard.test b/tests/clipboard.test index 7e482e9..93e3633 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: clipboard.test,v 1.3 1999/04/16 01:51:35 stanton Exp $ +# RCS: @(#) $Id: clipboard.test,v 1.4 2000/05/14 23:25:04 ericm Exp $ # # Note: Multiple display clipboard handling will only be tested if the @@ -31,13 +31,13 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { test clipboard-1.1 {ClipboardHandler procedure} { clipboard clear clipboard append "test" - selection get -s CLIPBOARD + clipboard get } {test} test clipboard-1.2 {ClipboardHandler procedure} { clipboard clear clipboard append "test" clipboard append "ing" - selection get -s CLIPBOARD + clipboard get } {testing} test clipboard-1.3 {ClipboardHandler procedure} { clipboard clear @@ -45,43 +45,43 @@ test clipboard-1.3 {ClipboardHandler procedure} { clipboard append "e" clipboard append "s" clipboard append "t" - selection get -s CLIPBOARD + clipboard get } {test} test clipboard-1.4 {ClipboardHandler procedure} { clipboard clear clipboard append $longValue - selection get -s CLIPBOARD + clipboard get } "$longValue" test clipboard-1.5 {ClipboardHandler procedure} { clipboard clear clipboard append $longValue clipboard append "test" - selection get -s CLIPBOARD + clipboard get } "${longValue}test" test clipboard-1.6 {ClipboardHandler procedure} { clipboard clear clipboard append -t TEST $longValue clipboard append -t STRING "test" - list [selection get -s CLIPBOARD -t STRING] \ - [selection get -s CLIPBOARD -t TEST] + list [clipboard get -t STRING] \ + [clipboard get -t TEST] } [list test $longValue] test clipboard-1.7 {ClipboardHandler procedure} { clipboard clear clipboard append -t TEST [string range $longValue 1 4000] clipboard append -t STRING "test" - list [selection get -s CLIPBOARD -t STRING] \ - [selection get -s CLIPBOARD -t TEST] + list [clipboard get -t STRING] \ + [clipboard get -t TEST] } [list test [string range $longValue 1 4000]] test clipboard-1.8 {ClipboardHandler procedure} { clipboard clear clipboard append "" - selection get -s CLIPBOARD + clipboard get } {} test clipboard-1.9 {ClipboardHandler procedure} { clipboard clear clipboard append "" clipboard append "Test" - selection get -s CLIPBOARD + clipboard get } {Test} ############################################################################## @@ -114,15 +114,15 @@ test clipboard-4.1 {ClipboardLostSel procedure} { clipboard clear clipboard append "Test" selection clear -s CLIPBOARD - list [catch {selection get -s CLIPBOARD} msg] $msg + list [catch {clipboard get} msg] $msg } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}} test clipboard-4.2 {ClipboardLostSel procedure} { clipboard clear clipboard append "Test" clipboard append -t TEST "Test2" selection clear -s CLIPBOARD - list [catch {selection get -s CLIPBOARD} msg] $msg \ - [catch {selection get -s CLIPBOARD -t TEST} msg] $msg + list [catch {clipboard get} msg] $msg \ + [catch {clipboard get -t TEST} msg] $msg } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} test clipboard-4.3 {ClipboardLostSel procedure} { clipboard clear @@ -130,8 +130,8 @@ test clipboard-4.3 {ClipboardLostSel procedure} { clipboard append -t TEST "Test2" clipboard append "Test3" selection clear -s CLIPBOARD - list [catch {selection get -s CLIPBOARD} msg] $msg \ - [catch {selection get -s CLIPBOARD -t TEST} msg] $msg + list [catch {clipboard get} msg] $msg \ + [catch {clipboard get -t TEST} msg] $msg } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} ############################################################################## @@ -139,19 +139,19 @@ test clipboard-4.3 {ClipboardLostSel procedure} { test clipboard-5.1 {Tk_ClipboardClear procedure} { clipboard clear clipboard append -t TEST "test" - set result [lsort [selection get -s CLIPBOARD TARGETS]] + set result [lsort [clipboard get TARGETS]] clipboard clear - list $result [lsort [selection get -s CLIPBOARD TARGETS]] + list $result [lsort [clipboard get TARGETS]] } {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test clipboard-5.2 {Tk_ClipboardClear procedure} { clipboard clear clipboard append -t TEST "test" - set result [lsort [selection get -s CLIPBOARD TARGETS]] + set result [lsort [clipboard get TARGETS]] selection own -s CLIPBOARD . - lappend result [lsort [selection get -s CLIPBOARD TARGETS]] + lappend result [lsort [clipboard get TARGETS]] clipboard clear clipboard append -t TEST "test" - lappend result [lsort [selection get -s CLIPBOARD TARGETS]] + lappend result [lsort [clipboard get TARGETS]] } {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} ############################################################################## @@ -162,14 +162,14 @@ test clipboard-6.1 {Tk_ClipboardAppend procedure} { selection own -s CLIPBOARD . list [catch { clipboard append " second chunk" - selection get -s CLIPBOARD + clipboard get } msg] $msg } {0 {first chunk second chunk}} test clipboard-6.2 {Tk_ClipboardAppend procedure} {unixOnly} { setupbg clipboard clear clipboard append -f INTEGER -t TEST "16" - set result [dobg {selection get -s CLIPBOARD TEST}] + set result [dobg {clipboard get TEST}] cleanupbg set result } {0x10} @@ -230,7 +230,7 @@ test clipboard-7.13 {Tk_ClipboardCmd procedure} { test clipboard-7.14 {Tk_ClipboardCmd procedure} { list [catch {clipboard error} msg] $msg -} {1 {bad option "error": must be clear or append}} +} {1 {bad option "error": must be append, clear, or get}} # cleanup ::tcltest::cleanupTests |