* 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".

4 files changed, 135 insertions, 28 deletions

diff --git a/ChangeLog b/ChangeLog
index 833efca..6ce38d7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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