home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 45_8.c < prev    next >
Text File  |  2003-04-15  |  2KB  |  109 lines
  1. /*
  2.  * Example 45-8
  3.  * The BlobCmd command procedure.
  4.  */
  5.  
  6. /*
  7. * BlobCmd --
  8. *
  9. *        This implements the blob command, which has these
  10. *        subcommands:
  11. *            create
  12. *            command name ?script?
  13. *            data name ?value?
  14. *            N name ?value?
  15. *            names ?pattern?
  16. *            poke name
  17. *            delete name
  18. *
  19. *    Results:
  20. *        A standard Tcl command result.
  21. */
  22. int
  23. BlobCmd(ClientData data, Tcl_Interp *interp,
  24.     int objc, Tcl_Obj *CONST objv[])
  25. {
  26.     BlobState *statePtr = (BlobState *)data;
  27.     Blob *blobPtr;
  28.     Tcl_HashEntry *entryPtr;
  29.     Tcl_Obj *valueObjPtr;
  30.  
  31.     /*
  32.      * The subCmds array defines the allowed values for the
  33.     * first argument. These are mapped to values in the
  34.     * BlobIx enumeration by Tcl_GetIndexFromObj.
  35.     */
  36.  
  37.     char *subCmds[] = {
  38.         "create", "command", "data", "delete", "N", "names",
  39.         "poke", NULL
  40.     };
  41.     enum BlobIx {
  42.         CreateIx, CommandIx, DataIx, DeleteIx, NIx, NamesIx,
  43.         PokeIx 
  44.     };
  45.     int result, index;
  46.  
  47.     if (objc == 1 || objc > 4) {
  48.         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
  49.         return TCL_ERROR;
  50.     }
  51.     if (Tcl_GetIndexFromObj(interp, objv[1], subCmds,
  52.             "option", 0, &index) != TCL_OK) {
  53.         return TCL_ERROR;
  54.     }
  55.     if (((index == NamesIx || index == CreateIx) && 
  56.             (objc > 2)) ||
  57.         ((index == PokeIx || index == DeleteIx) &&
  58.             (objc == 4))) {
  59.         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
  60.         return TCL_ERROR;
  61.     }
  62.     if (index == CreateIx) {
  63.         return BlobCreate(interp, statePtr);
  64.     }
  65.     if (index == NamesIx) {
  66.         return BlobNames(interp, statePtr);
  67.     }
  68.     if (objc < 3) {
  69.         Tcl_WrongNumArgs(interp, 1, objv, 
  70.             "option blob ?arg ...?");
  71.         return TCL_ERROR;
  72.     } else if (objc == 3) {
  73.         valueObjPtr = NULL;
  74.     } else {
  75.         valueObjPtr = objv[3];
  76.     }
  77.     /*
  78.      * The rest of the commands take a blob name as the third
  79.      * argument. Hash from the name to the Blob structure.
  80.      */
  81.     entryPtr = Tcl_FindHashEntry(&statePtr->hash,
  82.             Tcl_GetString(objv[2]));
  83.     if (entryPtr == NULL) {
  84.         Tcl_AppendResult(interp, "Unknown blob: ",
  85.                 Tcl_GetString(objv[2]), NULL);
  86.         return TCL_ERROR;
  87.     }
  88.     blobPtr = (Blob *)Tcl_GetHashValue(entryPtr);
  89.     switch (index) {
  90.         case CommandIx: {
  91.             return BlobCommand(interp, blobPtr, valueObjPtr);
  92.         }
  93.         case DataIx: {
  94.             return BlobData(interp, blobPtr, valueObjPtr);
  95.         }
  96.         case NIx: {
  97.             return BlobN(interp, blobPtr, valueObjPtr);
  98.         }
  99.         case PokeIx: {
  100.             return BlobPoke(interp, blobPtr);
  101.         }
  102.         case DeleteIx: {
  103.             return BlobDelete(blobPtr, entryPtr);
  104.         }
  105.     }
  106. }
  107.  
  108.  
  109.