Subversion Repositories or1k_old

/* paths.c - Find IDE and application Tcl libraries.
   Copyright (C) 1997 Cygnus Solutions.
   Written by Tom Tromey <tromey@cygnus.com>.  */
 
#include <tk.h>
#include <tcl.h>
 
#include "guitcl.h"
 
 
 
/* This Tcl code sets up all the path information we care about.
 
   We first look for the gui library.  This can be set by the
   CYGNUS_GUI_LIBRARY environment variable.  Otherwise, it is named
   gui, and is found in $prefix/share/cygnus, where $prefix is
   determined by looking at the directory where the running executable
   is installed.
 
   We then look for the ide library.  This can be set by the
   CYGNUS_IDE_LIBRARY environment variable.  Otherwise, it is named
   ide, and is also found in $prefix/share/cygnus.
 
   It is OK if only one of these libraries exist.  If neither exists,
   we report an error.
 
   We also set the following elements in the global Paths array.
 
   prefix         -- as in the configure argument
   exec_prefix    -- ditto
   bindir         -- ditto
   libexecdir     -- ditto
   guidir         -- the gui directory (not set if it does not exist)
   idedir         -- the ide directory (not set if it does not exist)
   appdir         -- see below
   bitmapdir      -- see below
 
   Paths(appdir) is set based on the ide_initialize_paths APPNAME
   parameter.  If a directory $prefix/share/cygnus/APPNAME exists, we
   set Paths(appdir) to it.  More precisely, we set Paths(appdir) if
   an APPNAME directory exists which is a sibling directory of the gui
   or ide directory.  For convenience of some tools, we also check for
   $prefix/share/APPNAME, or, more precisely, we check whether APPNAME
   is a sibling directory of the parent of the gui or ide directory.
 
   Paths(bitmapdir) is set if gui or ide have a sibling directory
   named bitmaps.  */
 
#ifndef _MSC_VER
static char init_script[] = "\
proc initialize_paths {} {\n\
  global ide_application_name auto_path env Paths\n\
  global tcl_library\n\
  rename initialize_paths {}\n\
  # First find the GUI library.\n\
  set guidirs {}\n\
  set prefdirs {}\n\
  if [info exists env(CYGNUS_GUI_LIBRARY)] {\n\
    lappend guidirs $env(CYGNUS_GUI_LIBRARY)\n\
  }\n\
  set here [pwd]\n\
  set exec_name [info nameofexecutable]\n\
  if {[string compare [file type $exec_name] \"link\"] == 0} {\n\
    set exec_name [file readlink $exec_name]\n\
    if {[string compare [file pathtype $exec_name] \"relative\"] == 0} {\n\
        set exec_name [file join [pwd] $exec_name]\n\
    }\n\
  }\n\
  cd [file dirname $exec_name]\n\
  # Handle build with --exec-prefix and build without.\n\
  set d [file join [file dirname [pwd]] usr share]\n\
  lappend prefdirs $d\n\
  lappend guidirs [file join $d cygnus gui]\n\
  set d [file join [file dirname [pwd]] share]\n\
  lappend prefdirs $d\n\
  lappend guidirs [file join $d cygnus gui]\n\
  set d [file join [file dirname [file dirname [pwd]]] share]\n\
  lappend prefdirs $d\n\
  lappend guidirs [file join $d cygnus gui]\n\
  set Paths(bindir) [pwd]\n\
 	# Base `prefix' on where the `share' dir is found\n\
 	foreach sd $prefdirs {\n\
 	  if [file isdirectory $sd] {\n\
 			set Paths(prefix) [file dirname $sd]\n\
 			break\n\
 		}\n\
 	}\n\
  if {[file isdirectory [file join [file dirname [pwd]] libexec]]} {\n\
    set Paths(libexecdir) [file join [file dirname [pwd]] libexec]\n\
  } else {\n\
    set Paths(libexecdir) $Paths(bindir)\n\
  }\n\
  set Paths(exec_prefix) [file dirname [pwd]]\n\
  cd $here\n\
  # Try to handle running from the build tree:\n\
  lappend guidirs [file join [file dirname [file dirname $tcl_library]] libgui library]\n\
  foreach sd $guidirs {\n\
    if {[file exists [file join $sd tclIndex]]} {\n\
      lappend auto_path $sd\n\
      set Paths(guidir) $sd\n\
      break\n\
    }\n\
  }\n\
  # Now find the IDE library, if it exists.\n\
  set idedirs {}\n\
  if [info exists env(CYGNUS_IDE_LIBRARY)] {\n\
    lappend idedirs $env(CYGNUS_IDE_LIBRARY)\n\
  }\n\
  foreach d $prefdirs {\n\
    lappend idedirs [file join $d cygnus ide]\n\
  }\n\
  # Try to handle running from the build tree:\n\
  lappend idedirs [file join [file dirname [file dirname $tcl_library]] libide library]\n\
  foreach sd $idedirs {\n\
    if {[file exists [file join $sd tclIndex]]} {\n\
      lappend auto_path $sd\n\
      set Paths(idedir) $sd\n\
      break\n\
    }\n\
  }\n\
  # Now set the bitmap directory:\n\
  foreach v [list guidir idedir] {\n\
    if {[info exists Paths($v)]} {\n\
      set d [file dirname $Paths($v)]\n\
      if {[file isdirectory [file join $d bitmaps]]} {\n\
        set Paths(bitmapdir) [file join $d bitmaps]\n\
      }\n\
    }\n\
  }\n\
  \n\
  # We do things in a somewhat roundabout way here.  This lets us\n\
  # run from the source directory, if we're willing to be a little messy\n\
  # in our test scripts.  FIXME: find a cleaner way.\n\
  # This routine is really meant to find the libgui & libide library directories.\n\
  #\n\
  # The client may not want it trying to find the application library\n\
  # Signal that by setting ide_application_name to empty string\n\
  if {$ide_application_name != \"\"} {\n\
    foreach v [list guidir idedir] {\n\
      if {[info exists Paths($v)]} {\n\
        set d [file dirname $Paths($v)]\n\
        if {[file isdirectory [file join $d $ide_application_name]]} {\n\
	  lappend auto_path [file join $d $ide_application_name]\n\
	  set Paths(appdir) [file join $d $ide_application_name]\n\
        }\n\
      }\n\
    }\n\
    if {! [info exists Paths(appdir)]} {\n\
      foreach v [list guidir idedir] {\n\
        if {[info exists Paths($v)]} {\n\
	  set d [file dirname [file dirname $Paths($v)]]\n\
	  if {[file isdirectory [file join $d $ide_application_name]]} {\n\
	    lappend auto_path [file join $d $ide_application_name]\n\
	    set Paths(appdir) [file join $d $ide_application_name]\n\
	  }\n\
        }\n\
      }\n\
    }\n\
  }\n\
  if {[info exists Paths(guidir)] || [info exists Paths(idedir)]} {\n\
    return\n\
  }\n\
  # FIXME: must run this message through gettext.\n\
  # Can only do this once gettext is in C and not just a stub.\n\
  set msg \"Can't find the GUI Tcl library in the following directories:\n\"\n\
  append msg \"    $guidirs $idedirs\n\"\n\
  error $msg\n\
}\n\
initialize_paths";
#else
static char init_script[] = "\
proc initialize_paths {} {\n\
  global ide_application_name auto_path env Paths\n\
  global tcl_library\n\
  rename initialize_paths {}\n\
  set guidirs {}\n\
  set here [pwd]\n\
  cd [file dirname [info nameofexecutable]]\n\
  set d [file join [file dirname [pwd]] share]\n\
  lappend guidirs [file join $d cygnus gui]\n\
  set d [file join [file dirname [file dirname [pwd]]] share]\n\
  lappend guidirs [file join $d cygnus gui]\n\
  lappend guidirs [file join [file dirname [file dirname $tcl_library]] libgui library]\n\
  foreach sd $guidirs {\n\
    if {[file exists [file join $sd tclIndex]]} {\n\
      lappend auto_path $sd\n\
      set Paths(guidir) $sd\n\
      break\n\
    }\n\
  }\n\
  foreach v [list guidir] {\n\
    if {[info exists Paths($v)]} {\n\
      set d [file dirname $Paths($v)]\n\
      if {[file isdirectory [file join $d bitmaps]]} {\n\
        set Paths(bitmapdir) [file join $d bitmaps]\n\
      }\n\
    }\n\
  }\n\
  \n\
  if {$ide_application_name != \"\"} {\n\
    foreach v [list guidir ] {\n\
      if {[info exists Paths($v)]} {\n\
        set d [file dirname $Paths($v)]\n\
        if {[file isdirectory [file join $d $ide_application_name]]} {\n\
	  lappend auto_path [file join $d $ide_application_name]\n\
	  set Paths(appdir) [file join $d $ide_application_name]\n\
        }\n\
      }\n\
    }\n\
    if {! [info exists Paths(appdir)]} {\n\
      foreach v [list guidir] {\n\
        if {[info exists Paths($v)]} {\n\
	  set d [file dirname [file dirname $Paths($v)]]\n\
	  if {[file isdirectory [file join $d $ide_application_name]]} {\n\
	    lappend auto_path [file join $d $ide_application_name]\n\
	    set Paths(appdir) [file join $d $ide_application_name]\n\
	  }\n\
        }\n\
      }\n\
    }\n\
  }\n\
  if {[info exists Paths(guidir)]} {\n\
    return\n\
  }\n\
  set msg \"Can't find the GUI Tcl library in the following directories:\n\"\n\
  append msg \"    $guidirs\n\"\n\
  error $msg\n\
}\n\
initialize_paths";
#endif
 
/* Initialize the global Paths variable.  */
int
ide_initialize_paths (Tcl_Interp *interp, char *appname)
{
  if (Tcl_SetVar (interp, "ide_application_name", appname,
		  TCL_GLOBAL_ONLY) == NULL)
    return (TCL_ERROR);
  return (Tcl_GlobalEval (interp, init_script));
}
 
#ifdef TCLPRO_DEBUGGER
static char run_app_script[] = "\
proc initialize_find_app_script {} {\n\
  global Paths env ide_application_name\n\
  rename initialize_find_app_script {}\n\
  if {[info exists env(TCLPRO_DEBUG_DIR)]} {\n\
     source [file join $env(TCLPRO_DEBUG_DIR) prodebug.tcl]\n\
     debugger_init\n\
  }\n\
  # Look in idedir for the sake of test apps like idetrace.\n\
  foreach v [list appdir idedir] {\n\
    if {[info exists Paths($v)]} {\n\
      set file [file join $Paths($v) ${ide_application_name}.tcl]\n\
      if {[file exists $file]} {\n\
        if {[info exists env(TCLPRO_DEBUG_DIR)]} {\n\
          # Right now, only one process can be debugged at a time.\n\
          # Unset the debug dir, so we won't try to debug any\n\
          # child processes...\n\
          unset env(TCLPRO_DEBUG_DIR)\n\
          uplevel #0 debugger_eval [list source $file]\n\
        } else {\n\
          uplevel #0 [list source $file]\n\
        }\n\
        return\n\
      }\n\
    }\n\
  }\n\
  # FIXME: must run message through gettext.\n\
  error \"Can't find ${ide_application_name}.tcl\"\n\
}\n\
initialize_find_app_script";
#else
static char run_app_script[] = "\
proc initialize_find_app_script {} {\n\
  global Paths ide_application_name\n\
  rename initialize_find_app_script {}\n\
  # Look in idedir for the sake of test apps like idetrace.\n\
  foreach v [list appdir idedir] {\n\
    if {[info exists Paths($v)]} {\n\
      set file [file join $Paths($v) ${ide_application_name}.tcl]\n\
      if {[file exists $file]} {\n\
        uplevel #0 [list source $file]\n\
        return\n\
      }\n\
    }\n\
  }\n\
  # FIXME: must run message through gettext.\n\
  error \"Can't find ${ide_application_name}.tcl\"\n\
}\n\
initialize_find_app_script";
#endif
 
/* Run the application-specific init script.  */
int
ide_run_app_script (Tcl_Interp *interp)
{
  return (Tcl_GlobalEval (interp, run_app_script));
}