From 8f8cdccd5ae74a53f74f32b1c0b68ef6a201fcb4 Mon Sep 17 00:00:00 2001 From: ericm Date: Tue, 1 Aug 2000 18:52:44 +0000 Subject: * generic/tkInt.h: Removed prototype for Tk_ClipboardCmd, added prototype for Tk_ClipboardObjCmd. * generic/tkWindow.c: Updated function pointers for clipboard command to use Tcl_Obj version. * tests/clipboard.test: Updated tests to expect standard error messages. * generic/tkClipboard.c (Tk_ClipboardObjCmd): Obj'ified Tk_ClipboardCmd -> Tk_ClipboardObjCmd. --- ChangeLog | 14 +++ generic/tkClipboard.c | 309 +++++++++++++++++++++++++++----------------------- generic/tkInt.h | 7 +- tests/clipboard.test | 23 +++- 4 files changed, 200 insertions(+), 153 deletions(-) diff --git a/ChangeLog b/ChangeLog index ac3ee7f..cf2e0ee 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2000-08-01 Eric Melski + + * generic/tkInt.h: Removed prototype for Tk_ClipboardCmd, added + prototype for Tk_ClipboardObjCmd. + + * generic/tkWindow.c: Updated function pointers for clipboard + command to use Tcl_Obj version. + + * tests/clipboard.test: Updated tests to expect standard error + messages. + + * generic/tkClipboard.c (Tk_ClipboardObjCmd): Obj'ified + Tk_ClipboardCmd -> Tk_ClipboardObjCmd. + 2000-07-28 Eric Melski * unix/tkUnixButton.c (TkpDisplayButton): Added bits to change diff --git a/generic/tkClipboard.c b/generic/tkClipboard.c index 5791c95..426af71 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.6 2000/05/14 23:25:04 ericm Exp $ + * RCS: @(#) $Id: tkClipboard.c,v 1.7 2000/08/01 18:52:45 ericm Exp $ */ #include "tkInt.h" @@ -408,7 +408,7 @@ Tk_ClipboardAppend(interp, tkwin, type, format, buffer) /* *---------------------------------------------------------------------- * - * Tk_ClipboardCmd -- + * Tk_ClipboardObjCmd -- * * This procedure is invoked to process the "clipboard" Tcl * command. See the user documentation for details on what @@ -424,176 +424,197 @@ Tk_ClipboardAppend(interp, tkwin, type, format, buffer) */ int -Tk_ClipboardCmd(clientData, interp, argc, argv) +Tk_ClipboardObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument strings. */ { Tk_Window tkwin = (Tk_Window) clientData; char *path = NULL; - size_t length; Atom selection; - int count; - char c; - char **args; + static char *optionStrings[] = { "append", "clear", "get", NULL }; + enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET }; + int index, i; - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?\"", (char *) NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } - c = argv[1][0]; - length = strlen(argv[1]); - if ((c == 'a') && (strncmp(argv[1], "append", length) == 0)) { - Atom target, format; - char *targetName = NULL; - char *formatName = NULL; - - for (count = argc-2, args = argv+2; count > 1; count -= 2, args += 2) { - if (args[0][0] != '-') { - break; - } - c = args[0][1]; - length = strlen(args[0]); - if ((c == '-') && (length == 2)) { - args++; - count--; - break; + + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case CLIPBOARD_APPEND: { + Atom target, format; + char *targetName = NULL; + char *formatName = NULL; + char *string; + static char *appendOptionStrings[] = { "-displayof", "-format", + "-type", NULL }; + enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT, + APPEND_TYPE }; + int subIndex, length; + + for (i = 2; i < objc - 1; i++) { + string = Tcl_GetStringFromObj(objv[i], &length); + if (string[0] != '-') { + break; + } + + /* + * If the argument is "--", it signifies the end of arguments. + */ + if (string[1] == '-' && length == 2) { + i++; + break; + } + if (Tcl_GetIndexFromObj(interp, objv[i], appendOptionStrings, + "option", 0, &subIndex) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Increment i so that it points to the value for the flag + * instead of the flag itself. + */ + + i++; + if (i >= objc) { + Tcl_AppendResult(interp, "value for \"", string, + "\" missing", (char *) NULL); + return TCL_ERROR; + } + switch ((enum appendOptions) subIndex) { + case APPEND_DISPLAYOF: + path = Tcl_GetString(objv[i]); + break; + case APPEND_FORMAT: + formatName = Tcl_GetString(objv[i]); + break; + case APPEND_TYPE: + targetName = Tcl_GetString(objv[i]); + break; + } } - if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) { - path = args[1]; - } else if ((c == 'f') - && (strncmp(args[0], "-format", length) == 0)) { - formatName = 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); + if (objc - i != 1) { + Tcl_WrongNumArgs(interp, 2, objv, "?options? data"); return TCL_ERROR; } - } - if (count != 1) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " append ?options? data\"", (char *) NULL); - return TCL_ERROR; - } - if (path != NULL) { - tkwin = Tk_NameToWindow(interp, path, tkwin); - } - if (tkwin == NULL) { - return TCL_ERROR; - } - if (targetName != NULL) { - target = Tk_InternAtom(tkwin, targetName); - } else { - target = XA_STRING; - } - if (formatName != NULL) { - format = Tk_InternAtom(tkwin, formatName); - } else { - format = XA_STRING; - } - return Tk_ClipboardAppend(interp, tkwin, target, format, args[0]); - } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) { - for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) { - if (args[0][0] != '-') { - break; + if (path != NULL) { + tkwin = Tk_NameToWindow(interp, path, tkwin); } - if (count < 2) { - Tcl_AppendResult(interp, "value for \"", *args, - "\" missing", (char *) NULL); + if (tkwin == NULL) { return TCL_ERROR; } - c = args[0][1]; - length = strlen(args[0]); - if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) { - path = args[1]; + if (targetName != NULL) { + target = Tk_InternAtom(tkwin, targetName); } else { - Tcl_AppendResult(interp, "unknown option \"", args[0], - "\"", (char *) NULL); - return TCL_ERROR; + target = XA_STRING; } + if (formatName != NULL) { + format = Tk_InternAtom(tkwin, formatName); + } else { + format = XA_STRING; + } + return Tk_ClipboardAppend(interp, tkwin, target, format, + Tcl_GetString(objv[i])); } - if (count > 0) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " clear ?options?\"", (char *) NULL); - return TCL_ERROR; - } - if (path != NULL) { - tkwin = Tk_NameToWindow(interp, path, tkwin); - } - if (tkwin == NULL) { - return TCL_ERROR; + case CLIPBOARD_CLEAR: { + static char *clearOptionStrings[] = { "-displayof", NULL }; + enum clearOptions { CLEAR_DISPLAYOF }; + int subIndex; + if (objc != 2 && objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?"); + return TCL_ERROR; + } + + if (objc == 4) { + if (Tcl_GetIndexFromObj(interp, objv[2], clearOptionStrings, + "option", 0, &subIndex) != TCL_OK) { + return TCL_ERROR; + } + if ((enum clearOptions) subIndex == CLEAR_DISPLAYOF) { + path = Tcl_GetString(objv[3]); + } + } + if (path != NULL) { + tkwin = Tk_NameToWindow(interp, path, tkwin); + } + if (tkwin == NULL) { + return TCL_ERROR; + } + return Tk_ClipboardClear(interp, tkwin); } - 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; + case CLIPBOARD_GET: { + Atom target; + char *targetName = NULL; + Tcl_DString selBytes; + int result; + char *string; + static char *getOptionStrings[] = { "-displayof", "-type", NULL }; + enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE }; + int subIndex; + + for (i = 2; i < objc; i++) { + string = Tcl_GetString(objv[i]); + if (string[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[i], getOptionStrings, + "option", 0, &subIndex) != TCL_OK) { + return TCL_ERROR; + } + i++; + if (i >= objc) { + Tcl_AppendResult(interp, "value for \"", string, + "\" missing", (char *) NULL); + return TCL_ERROR; + } + switch ((enum getOptions) subIndex) { + case APPEND_DISPLAYOF: + path = Tcl_GetString(objv[i]); + break; + case APPEND_TYPE: + targetName = Tcl_GetString(objv[i]); + break; + } } - if (count < 2) { - Tcl_AppendResult(interp, "value for \"", *args, - "\" missing", (char *) NULL); + if (path != NULL) { + tkwin = Tk_NameToWindow(interp, path, tkwin); + } + if (tkwin == 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); + selection = Tk_InternAtom(tkwin, "CLIPBOARD"); + + if (objc - i > 1) { + Tcl_WrongNumArgs(interp, 2, objv, "?options?"); return TCL_ERROR; + } else if (objc - i == 1) { + target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i])); + } else if (targetName != NULL) { + target = Tk_InternAtom(tkwin, targetName); + } else { + target = XA_STRING; } - } - 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); + 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; } - return result; - } else { - char buf[100 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad option \"%.50s\": must be append, clear, or get", - argv[1]); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - return TCL_ERROR; } + return TCL_OK; } /* diff --git a/generic/tkInt.h b/generic/tkInt.h index bf85dcb..98316d8 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -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: tkInt.h,v 1.24 2000/05/29 01:43:14 hobbs Exp $ + * RCS: $Id: tkInt.h,v 1.25 2000/08/01 18:52:45 ericm Exp $ */ #ifndef _TKINT @@ -904,8 +904,9 @@ EXTERN int Tk_CanvasObjCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_CheckbuttonObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_ClipboardObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); EXTERN int Tk_ChooseColorObjCmd _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); diff --git a/tests/clipboard.test b/tests/clipboard.test index 93e3633..02c3fa2 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.4 2000/05/14 23:25:04 ericm Exp $ +# RCS: @(#) $Id: clipboard.test,v 1.5 2000/08/01 18:52:45 ericm Exp $ # # Note: Multiple display clipboard handling will only be tested if the @@ -196,7 +196,7 @@ test clipboard-7.3 {Tk_ClipboardCmd procedure} { } {0 {} information} test clipboard-7.4 {Tk_ClipboardCmd procedure} { list [catch {clipboard append --x a b} msg] $msg -} {1 {unknown option "--x"}} +} {1 {bad option "--x": must be -displayof, -format, or -type}} test clipboard-7.5 {Tk_ClipboardCmd procedure} { list [catch {clipboard append -- a b} msg] $msg } {1 {wrong # args: should be "clipboard append ?options? data"}} @@ -207,7 +207,7 @@ test clipboard-7.6 {Tk_ClipboardCmd procedure} { } {0 {} -format} test clipboard-7.7 {Tk_ClipboardCmd procedure} { list [catch {clipboard append -displayofoo f} msg] $msg -} {1 {unknown option "-displayofoo"}} +} {1 {bad option "-displayofoo": must be -displayof, -format, or -type}} test clipboard-7.8 {Tk_ClipboardCmd procedure} { list [catch {clipboard append -type TEST} msg] $msg } {1 {wrong # args: should be "clipboard append ?options? data"}} @@ -217,13 +217,13 @@ test clipboard-7.9 {Tk_ClipboardCmd procedure} { test clipboard-7.10 {Tk_ClipboardCmd procedure} { list [catch {clipboard clear -displayof} msg] $msg -} {1 {value for "-displayof" missing}} +} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}} test clipboard-7.11 {Tk_ClipboardCmd procedure} { list [catch {clipboard clear -displayofoo f} msg] $msg -} {1 {unknown option "-displayofoo"}} +} {1 {bad option "-displayofoo": must be -displayof}} test clipboard-7.12 {Tk_ClipboardCmd procedure} { list [catch {clipboard clear foo} msg] $msg -} {1 {wrong # args: should be "clipboard clear ?options?"}} +} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}} test clipboard-7.13 {Tk_ClipboardCmd procedure} { list [catch {clipboard clear -displayof foo} msg] $msg } {1 {bad window path name "foo"}} @@ -232,6 +232,17 @@ test clipboard-7.14 {Tk_ClipboardCmd procedure} { list [catch {clipboard error} msg] $msg } {1 {bad option "error": must be append, clear, or get}} +test clipboard-7.15 {Tk_ClipboardCmd procedure} { + clipboard clear + list [catch {clipboard append -displayof} msg] $msg \ + [selection get -selection CLIPBOARD] +} {0 {} -displayof} +test clipboard-7.16 {Tk_ClipboardCmd procedure} { + clipboard clear + list [catch {clipboard append -type} msg] $msg \ + [selection get -selection CLIPBOARD] +} {0 {} -type} + # cleanup ::tcltest::cleanupTests return -- cgit v0.12