utilcmds.cpp

来自「算断裂的」· C++ 代码 · 共 211 行

// ------------------------------------------------------------------
// utilcmds.cpp
//
// This file contains some utility Tcl/Tk commands for qmg.
// ------------------------------------------------------------------
// Author: Stephen A. Vavasis
// Copyright (c) 1999 by Cornell University.  All rights reserved.
// 
// See the accompanying file 'Copyright' for authorship information,
// the terms of the license governing this software, and disclaimers
// concerning this software.
// ------------------------------------------------------------------
// This file is part of the QMG software.  
// Version 2.0 of QMG, release date September 3, 1999.
// ------------------------------------------------------------------



extern "C" {
#include "tcl.h"
}

#include "qsimpcomp.h"
#include "qfrontend.h"

namespace QMG {
  namespace FrontEnd {
    using namespace QMG;
    extern SimpComplex_From_FrontEnd get_simpcomp_from_obj(Tcl_Interp* interp, Tcl_Obj* obj, int& returncode);
  }
}

/*
 *----------------------------------------------------------------------
 *
 * gmset --
 *
 *      This procedure is invoked to process the "gmset" Tcl command.
 * Works just like "set" in Tcl except that it doesn't set interp->result
 * to the answer so that you don't get big printouts.
 *
 * Results:
 *      A standard Tcl result value.
 *
 * Side effects:
 *      A variable's value may be changed.
 *
 *----------------------------------------------------------------------
 */


extern "C" {

#ifdef _WIN32

#include <windows.h>
#include <ddeml.h>

#endif



int gmset(ClientData, 
               Tcl_Interp* interp, 
               int objc, 
               Tcl_Obj* const objv[]) {
  if (objc != 3) {
    Tcl_WrongNumArgs(interp, 1, objv, "<varnamelist> value(s)");
    return TCL_ERROR;
  }

  int llength1;
  int returncode = Tcl_ListObjLength(interp, objv[1], &llength1);
  if (returncode != TCL_OK) {
    Tcl_AppendResult(interp, "gmset: Couldn't process arg 1 as list", 0);
    return returncode;
  }
  if (llength1 > 1) {
    int llength2;
    returncode = Tcl_ListObjLength(interp, objv[2], &llength2);
    if (returncode != TCL_OK) {
      Tcl_AppendResult(interp, "gmset: Couldn't process arg 2 as list", 0);
      return returncode;
    }
    if (llength2 != llength1) {
      Tcl_AppendResult(interp, "gmset: Arg1 and arg2 have different number of entries", 0);
      return TCL_ERROR;
    }
    for (int j = 0; j < llength1; ++j) {
      Tcl_Obj* src;
      Tcl_Obj* dest;
      returncode = Tcl_ListObjIndex(interp, objv[1], j, &src);
      if (returncode != TCL_OK) {
        return returncode;
      }
      returncode = Tcl_ListObjIndex(interp, objv[2], j, &dest);
      if (returncode != TCL_OK) {
        return returncode;
      }
      Tcl_Obj* returnval = Tcl_ObjSetVar2(interp, src, 0, dest, 
        TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
      if (returnval == 0)
        return TCL_ERROR;
    }
    return TCL_OK;
  }
  Tcl_Obj* returnval = Tcl_ObjSetVar2(interp, objv[1], 0, objv[2], 
    TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
  if (returnval == 0)
    return TCL_ERROR;
  return TCL_OK;
}

// gm_objtype returns the type of an object, or empty string if
// none is defined.

int gm_objtype(ClientData,
               Tcl_Interp* interp,
               int objc,
               Tcl_Obj* const objv[]) {
  if (objc != 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "<object>");
    return TCL_ERROR;
  }
  Tcl_Obj* returnval;
  if (objv[1] -> typePtr != 0 && objv[1] -> typePtr -> name != 0) {
    returnval = Tcl_NewStringObj(objv[1] -> typePtr -> name, -1);
  }
  else {
    returnval = Tcl_NewStringObj("", -1);
  }
  Tcl_SetObjResult(interp, returnval);
  return TCL_OK;
}




#ifdef _WIN32

HDDEDATA CALLBACK mycallback(UINT utype,
                             UINT ufmt,
                             HCONV hconv,
                             HSZ hsz1,
                             HSZ hsz2,
                             HDDEDATA hdata,
                             DWORD extra1,
                             DWORD extra2) {
  return 0;
}


#endif

// dde_openurl defines a function to open a URL in the
// specified browser using a DDE invocation.

int dde_openurl(ClientData,
                Tcl_Interp* interp, 
                int argc,
                char** argv) {

#ifdef _WIN32

  if (argc != 3) {
    interp -> result = "Wrong number of arguments to dde_openurl";
    return TCL_ERROR;
  }
  const char* browser = argv[1];
  const char* url = argv[2];

              
  DWORD myid;
  myid = 0;
  DdeInitialize(&myid, &mycallback, 0, 0);  
  HSZ server1 = DdeCreateStringHandle(myid, browser, CP_WINANSI);
  HSZ topic1 = DdeCreateStringHandle(myid, "WWW_OpenURL", CP_WINANSI);
  HCONV hconv = DdeConnect(myid, server1, topic1, 0);
  if (hconv == 0) {
    UINT code = DdeGetLastError(myid);
    char tmp[100];
    sprintf(tmp, "error code = %d\n", code);
    Tcl_AppendResult(interp, tmp, 0);
    Tcl_AppendResult(interp, "Couldn't start DDE conversation; browser = ",
      (char*) browser, 0);
    return TCL_ERROR;
  }

  HDDEDATA result = DdeClientTransaction((LPBYTE) url, 
    strlen(url) + 1,
    hconv,
    0,
    0,
    XTYP_EXECUTE,
    5000,
    0);
  BOOL result2 = DdeDisconnect(hconv);
  BOOL result3 = DdeUninitialize(myid);
  return TCL_OK;

#else
  Tcl_AppendResult(interp, "dde_openurl function valid only for Windows", 0);
  return TCL_ERROR;
#endif

}



}