Subversion Repositories or1k

/* tclgetdir.c -- TCL code to browse for a directory.

   Copyright (C) 1997, 1998 Cygnus Solutions.

   Written by Ian Lance Taylor <ian@cygnus.com>.  */

#ifdef _WIN32

#include <windows.h>

#ifndef _GNU_H_WINDOWS_H   /* if not using old Cygwin Win32 headers */

#include <shlobj.h>

#endif

#endif

#include <tcl.h>

#include <tk.h>

#include "guitcl.h"

/* This file defines one TCL command.

   ide_get_directory

       Allows the user to select a directory.  Returns the selected

       directory as a string.  */

#ifdef _WIN32

#include <tkWinInt.h>

/* a call back to set the initial selected directory */

/* defines currently missing from Cygwin32 */

#ifndef BFFM_INITIALIZED

LPITEMIDLIST WINAPI SHBrowseForFolderA(LPBROWSEINFO lpbi);

/* message from browser */

#define BFFM_INITIALIZED        1

#define BFFM_SELCHANGED         2

/* messages to browser */

#define BFFM_SETSTATUSTEXTA     (WM_USER + 100)

#define BFFM_ENABLEOK           (WM_USER + 101)

#define BFFM_SETSELECTIONA      (WM_USER + 102)

#define BFFM_SETSELECTIONW      (WM_USER + 103)

#define BFFM_SETSTATUSTEXTW     (WM_USER + 104)

#ifdef UNICODE

#define SHBrowseForFolder   SHBrowseForFolderW

#define BFFM_SETSTATUSTEXT  BFFM_SETSTATUSTEXTW

#define BFFM_SETSELECTION   BFFM_SETSELECTIONW

#else

#define SHBrowseForFolder   SHBrowseForFolderA

#define BFFM_SETSTATUSTEXT  BFFM_SETSTATUSTEXTA

#define BFFM_SETSELECTION   BFFM_SETSELECTIONA

#endif

#endif /* ! BFFM_INITIALIZED */

/* FIXME: We need to dig into the Tk window implementation internals.  */

int CALLBACK MyBrowseCallbackProc(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData)

{

  if (uMsg==BFFM_INITIALIZED)

    {

       SendMessage(hwnd,BFFM_SETSELECTION,(WPARAM)TRUE,(LPARAM)lpData);

    }

  return 0;

}

/* Implement the Windows version of the ide_get_directory command.  */

static int

get_directory_command (ClientData cd, Tcl_Interp *interp, int argc,

                       char **argv)

{

  BROWSEINFO bi;

  char buf[MAX_PATH + 1];

  Tk_Window parent;

  int i, oldMode;

  LPITEMIDLIST idlist;

  char *p;

  int atts;

  Tcl_DString tempBuffPtr;

#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)

  Tcl_DString titleDString;

  Tcl_DString initialDirDString;

  Tcl_DString resultDString;

  Tcl_DStringInit(&titleDString);

  Tcl_DStringInit(&initialDirDString);

#endif

  Tcl_DStringInit(&tempBuffPtr);

  bi.hwndOwner = NULL;

  bi.pidlRoot = NULL;

  bi.pszDisplayName = buf;

  bi.lpszTitle = NULL;

  bi.ulFlags = 0;

  bi.lpfn = NULL;

  bi.lParam = 0;

  bi.iImage = 0;

  parent = Tk_MainWindow (interp);

  for (i = 1; i < argc; i += 2)

    {

      int v;

      int len;

      v = i + 1;

      len = strlen (argv[i]);

      if (strncmp (argv[i], "-parent", len) == 0)

        {

          if (v == argc)

            goto arg_missing;

          parent = Tk_NameToWindow (interp, argv[v],

                                    Tk_MainWindow (interp));

          if (parent == NULL)

            return TCL_ERROR;

        }

      else if (strncmp (argv[i], "-title", len) == 0)

        {

          if (v == argc)

            goto arg_missing;

#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)

          Tcl_UtfToExternalDString(NULL, argv[v], -1, &titleDString);

          bi.lpszTitle = Tcl_DStringValue(&titleDString);

#else

          bi.lpszTitle = argv[v];

#endif

        }

      else if (strncmp (argv[i], "-initialdir", len) == 0)

        {

          if (v == argc)

            goto arg_missing;

          /* bi.lParam will be passed to the callback function.(save the need for globals)*/

          bi.lParam = (LPARAM) Tcl_TranslateFileName(interp, argv[v], &tempBuffPtr);

#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)

          Tcl_UtfToExternalDString(NULL, (char *) bi.lParam, -1, &initialDirDString);

          bi.lParam = (LPARAM) Tcl_DStringValue(&initialDirDString);

#endif

          bi.lpfn   = MyBrowseCallbackProc;

        }

      else

        {

          Tcl_AppendResult (interp, "unknown option \"", argv[i],

                            "\", must be -parent or -title", (char *) NULL);

          return TCL_ERROR;

        }

    }

  if (Tk_WindowId (parent) == None)

    Tk_MakeWindowExist (parent);

  bi.hwndOwner = Tk_GetHWND (Tk_WindowId (parent));

  oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);

  idlist = SHBrowseForFolder (&bi);

  Tcl_SetServiceMode(oldMode);

  if (idlist == NULL)

    {

      /* User pressed the cancel button.  */

      return TCL_OK;

    }

  if (! SHGetPathFromIDList (idlist, buf))

    {

      Tcl_SetResult (interp, "could not get path for directory", TCL_STATIC);

      return TCL_ERROR;

    }

  /* Ensure the directory exists.  */

  atts = GetFileAttributesA (buf);

  if (atts == -1 || ! (atts & FILE_ATTRIBUTE_DIRECTORY))

    {

      Tcl_AppendResult (interp, "path \"", buf, "\" is not a directory",

                        (char *) NULL);

      /* FIXME: free IDLIST.  */

      return TCL_ERROR;

    }

  /* FIXME: We are supposed to free IDLIST using the shell task

     allocator, but cygwin32 doesn't define the required interfaces

     yet.  */

  /* Normalize the path for Tcl.  */

#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)

  Tcl_ExternalToUtfDString(NULL, buf, -1, &resultDString);

  p = Tcl_DStringValue(&resultDString);

#else

  p = buf;

#endif

  for (; *p != '\0'; ++p)

    if (*p == '\\')

      *p = '/';

  Tcl_ResetResult(interp);

#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)

  Tcl_SetResult(interp, Tcl_DStringValue(&resultDString), TCL_VOLATILE);

  Tcl_DStringFree(&resultDString);

  Tcl_DStringFree(&titleDString);

  Tcl_DStringFree(&initialDirDString);

#else

  Tcl_SetResult(interp, buf, TCL_VOLATILE);

#endif

  Tcl_DStringFree(&tempBuffPtr);

  return TCL_OK;

 arg_missing:

  Tcl_AppendResult(interp, "value for \"", argv[argc - 1], "\" missing",

                   NULL);

  return TCL_ERROR;

}

#else /* ! _WIN32 */

/* Use our modified file dialog, and hope the user picks a directory.  */

static int

get_directory_command (ClientData cd, Tcl_Interp *interp, int argc,

                       char **argv)

{

  char **new_args;

  char *merge;

  int result, i;

  /* We can't directly run Tk_GetOpenFile, because it wants some

     ClientData that we're best off not knowing.  So instead we

     re-eval.  This is a lot less efficient, but it doesn't really

     matter.  */

  new_args = (char **) Tcl_Alloc ((argc + 2) * sizeof (char *));

  new_args[0] = "tk_getOpenFile";

  new_args[1] = "-choosedir";

  new_args[2] = "1";

  for (i = 1; i < argc; ++i)

    new_args[2 + i] = argv[i];

  merge = Tcl_Merge (argc + 2, new_args);

  result = Tcl_GlobalEval (interp, merge);

  Tcl_Free (merge);

  Tcl_Free ((char *) new_args);

  return result;

}

#endif /* ! _WIN32 */

/* This function creates the ide_get_directory TCL command.  */

int

ide_create_get_directory_command (Tcl_Interp *interp)

{

  if (Tcl_CreateCommand (interp, "ide_get_directory", get_directory_command,

                         NULL, NULL) == NULL)

    return TCL_ERROR;

  return TCL_OK;

}