sninit.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

      set sn_interp_numslaves 0
  } else {
      incr sn_interp_numslaves
  }

  set appname sourcenav-$sn_interp_numslaves
  set ip [interp create $appname]

  # Move vars from master to slave
  foreach var {argc argv argv0 env auto_path auto_index} {
      if {[array exists ::$var]} {
          $ip eval [list array set $var [array get ::$var]]
      } else {
          $ip eval [list set $var [set ::$var]]
      }
  }

  # We copy some global variables into the target (new) interpreter.
    
  $ip eval [list set tcl_interactive 0]

# FIXME: It is not clear that this is needed, it seems to be done in Sn_setup
#  foreach var {sn_home HOME sn_debug auto_path} {
#    $ip eval [list set $var [set ::$var]]
#  }

  # Call SN interp init method, this also loads Tk into the slave
  # This calls the C method Sn_setup_Init in the slave interp
  $ip eval [list load {} Sn_setup]

  # Alias commands that slaves will use to interact with the master.

  interp alias $ip delete_interp {} sn_master_delete_slave $ip
  interp alias $ip create_interp {} sn_master_create_interp
  interp alias $ip number_interp {} sn_master_number_slave_interps

  # FIXME: Is this right? Seems like a no
  $ip eval [list set argv0 $appname]

  # FIXME: Should we try to create a unique name for this X display ???
  # We have to create a unique interpreter name in the network.
  #set interp_name [format %s-%s-%d application_name [info hostname] interpnum]
      
  # Get the appname of the slave and return it

  set appname [$ip eval [list tk appname $appname]]

  sn_log "created slave interp $ip, its appname is $appname"

  # Eval the -e argument to this function

  $ip eval $cmds

  return $appname
}

# This method is called in the slave interpreter to create a new
# slave interpreter in the master. Each slave holds its own SN
# project, so clearly we can not create a slave in a slave.
# This method is named create_interp in slaves.

proc sn_master_create_interp { cmds } {
  sn_log "called sn_master_create_interp (in [tk appname])"
  create_interp $cmds
}

# Return the number of slave interpreters that exist in the
# master. We assume that each slave interpreter is a SN project.
# This method is named number_interp in slaves.

proc sn_master_number_slave_interps { } {
  set interps [interp slaves]
  set num_interps [llength $interps]

  sn_log "sn_master_number_slave_interps called, there are $num_interps
      slave interps (in [tk appname])"
  return $num_interps
}

# This method is called through an alias in the slave interpreter.
# It is kind of tricky as we need to delete the slave interp but
# it is not actually for an interp to delete itself. That is why
# the master must always delete the slave interp, and the slave
# must not execute any more comands after a request to delete itself.
# This method is named delete_interp in slaves.

proc sn_master_delete_slave { slave } {
  global tcl_interactive tcl_platform
  sn_log "called master_delete_slave $slave ([$slave eval tk appname]) (in [tk appname])"
  interp delete $slave

  set num_interps [sn_master_number_slave_interps]

  # tcl_interactive is always set to 1 on Windows, so ignore it.
  if {$tcl_platform(platform) != "windows" && $tcl_interactive} {
      sn_log "Not exiting: in interactive mode"
  } elseif {$num_interps > 0} {
      sn_log "Not exiting: there are $num_interps still alive"
  } else {
      sn_log "Exiting: no slave interpreters and not in interactive mode"
      exit 0
  }
}

# Called from Sn_setup_Init C function

proc sn_tcl_tk_init {} {
    global sn_options
    global sn_path
    global env sn_debug auto_path
    global tkPriv tcl_platform
    global tcl_platform
    global set

    wm withdraw .
    update
    update idletasks

    # First set up all paths.
    sn_initialize_paths

    # Use 1 pixel border width so SN looks more "modern"
    option add *borderWidth 1

    # Use sourcenav icon bitmap for all toplevels under Win32
    if {$tcl_platform(platform) == "windows"} {
        wm iconbitmap . -default [file join $sn_path(bitmapdir) sourcenav.ico]
    }

    init_some_font_attributes

    set vis [winfo screenvisual .]
    sn_log "Screenvisual: ${vis}"
    if {[string first "color" ${vis}] != -1} {
        set sn_options(iscolor) 1
    } else {
        set sn_options(iscolor) 0
    }

    # Prepend SN bin dir to PATH env var
    if {$tcl_platform(platform) == "windows"} {
        set SEP \;
    } else {
        set SEP :
    }
    set env(PATH) "$sn_path(bindir)${SEP}$env(PATH)"

    if {$tcl_platform(platform) == "windows"} {
        if {![info exists env(LOGNAME)] && [catch {set env(LOGNAME)\
          [get_username]}]} {
            set env(LOGNAME) "navigator"
        }
        set env(USERNAME) $env(LOGNAME)
        set sn_options(def,font-family) "*"
    } else {
        set sn_options(def,font-family) "Adobe"
    }

    set tkPriv(oldGrab) ""
    # Tk bugs !
    set tkPriv(activeBg) [. cget -background]

    set bitd $sn_path(bitmapdir)

    set pixmap "pixmap"
    set suf "xpm"
    set cursor "watch"

    if {[sn_batch_mode]} {
        #make sure that the "." window isn't displayed.
        catch {wm withdraw .}
    }

    image create ${pixmap} info_image -file [file join ${bitd} info.${suf}]
    image create ${pixmap} error_image -file [file join ${bitd} stop.${suf}]
    image create ${pixmap} question_image -file [file join ${bitd}\
      question.${suf}]

    #init global variables
    sn_init_globals

    #after initialization, we need to interpret the
    #command line options, they should override all settings!
    sn_read_commandline_arguments

    # Initialise and load toolchain specs.
    InitializeToolChainInfo

    #read configuration file 'sn_prop.cfg'
    sn_read_properities

    if {![file isdirectory $sn_options(profile_dir)]} {
        sn_log "Create dir: $sn_options(profile_dir)"
        catch {file mkdir $sn_options(profile_dir)}
    }

    #load user defined variable settings from a profile
    sn_read_profiles
    set sn_options(def,system-encoding) $sn_options(def,encoding)

    #read language dependent file
    sn_log "Text file: [file join $sn_path(etcdir)\
      $sn_options(def,language).txt]"
    sn_string_init [file join $sn_path(etcdir) $sn_options(def,language).txt]

    #if user wants to see help, show it him and exit
    global sn_arguments
    if {[info exists sn_arguments(help)]} {
        if {$tcl_platform(platform) == "windows"} {
            #on windows it has to be a dialog box.
            tk_dialog auto "Valid Option Parameters" $sn_arguments(help)\
              info_image -1 [get_indep String Ok]
        } else {
            puts stdout $sn_arguments(help)
        }
        exit 0
    }

    #load image and bitmap files
    #read user saved options and init some other options
    sn_load_pixmaps

    #Now we can read the stored user default settings
    Preferences&::load_default_settings 1

    #set default color&fonts for the gui (after loading settings)
    Preferences&::set_color_font_attributes

    #bind SN events for several widgets (treetable, text, canvas, ..)
    sn_bindings

    #load user defined rc file
    sn_load_rc_file rc.tcl

    if {${sn_debug}} {
        set pltfrm ""
        foreach v [array names tcl_platform] {
            append pltfrm "${v}: $tcl_platform(${v}) "
        }
        sn_log "plattform settings: ${pltfrm}"
    }

    # Register as an editor server.  We first check to see if the
    # command exists because, if it doesn't, then we aren't
    # connected to the IDE system at all, and we don't want to run
    # this.
    global ide_running
    if {[llength [info commands ide_editor_register]]} {
        ide_editor_register ide_edit_event
        ide_event initialize {} {file-created file-changed}

        # FIXME: for now, this mapping is hard-coded.  Later
        # it should be stored in properties.
        ide_interface_autolaunch build {} [list [file join $sn_path(bindir)\
          vmake]]

        set ide_running 1
    } else {
        set ide_running 0
    }
}

proc sn_read_profiles {} {
    global sn_options
    global sn_path
    global sn_arguments

    # Execute first the general profile, then the user's!
    foreach f [list [file join $sn_path(etcdir) profile] [file join\
      $sn_options(profile_dir) profile]] {
        sn_read_profile ${f}
    }

    set sn_options(def,page-formats) [split $sn_options(def,page-formats) ";"]

    #if the user specified some arguments using "--define" option,
    #execute those here
    foreach {var value} $sn_arguments(--define) {
        sn_modify_option ${var} ${value}
    }
}

proc sn_read_profile {fname} {
    global sn_options

    sn_log "Profile file: ${fname}"
    if {[catch {set fd [open ${fname}]} err]} {
        sn_log ${err}
        return
    }

    set lines [split [read -nonewline ${fd}] "\n"]
    close ${fd}

    #Query variables to set! Format must be name:value
    #name is alphanumeric with "-".
    foreach line ${lines} {
        set line [string trim ${line}]
        if {[string first "#" ${line}] == 0} {
            continue
        }
        set off [string first ":" ${line}]
        if {${off} == -1} {
            continue
        }
        set param [string trim [string range ${line} 0 [expr ${off} - 1]]]
        set value [string trim [string range ${line} [expr ${off} + 1] end]]
        #uplevel #0 "set sn_options($param) {$value}"
        sn_modify_option ${param} ${value}
    }
}

#read configuratoin file 'sn_prop.cfg'
proc sn_read_properities {} {
    global sn_options
    global sn_path

    if {[file exists [file join $sn_options(both,db-directory) sn_prop.cfg]]} {
        set nm [file join $sn_options(both,db-directory) sn_prop.cfg]
    }\
    elseif {[file exists [file join $sn_options(profile_dir) sn_prop.cfg]]} {
        set nm [file join $sn_options(profile_dir) sn_prop.cfg]
    } else {
        set nm [file join $sn_path(etcdir) sn_prop.cfg]
    }

    sn_log "Loading parsers from: ${nm}"

    #here we load the "sn_prop.cfg" file to load the supported
    #parsers and some other user-defined stuff.
    if {[catch {uplevel #0 source [list ${nm}]} err]} {
        sn_error_dialog ${err}
        exit 1
    }
    return 1
}

proc sn_read_commandline_arguments {} {
    global sn_options
    global argc argv
    global sn_arguments
    global ProcessingCancelled
    global tcl_platform

    sn_log "process command line argc <${argc}> argv <${argv}>"

    set sn_arguments(--define) ""
    set sn_arguments(import-file) ""
    set sn_arguments(new) 0

    for {set idx 0} {${idx} < ${argc}} {incr idx} {
        set arg [lindex ${argv} ${idx}]

        switch -glob -- ${arg} {
            "--batchmode" -
            "-b" {
                    #batchmode mode
                    set sn_arguments(batchmode) 1
                    set new 1
                }
            "--projectname" -
            "-p" {
                    #project name
                    incr idx
                    set sn_arguments(projectfile) [lindex ${argv} ${idx}]
                }
            "-n" -
            "-new" -
            "--new" -
            "-c" -
            "-cr" -
            "-create" -
            "--create" {
                    #-create: create a new project queckly, don't call
                    #project selection
                    #-cr, -create: backward compatibility.
                    #-n, -new: backward compatibility.
                    set sn_arguments(new) 1
                }
            "-d" -
            "--databasedir" -
            "--dbdir" {
                    #database directory
                    incr idx
                    set sn_arguments(databasedir) [lindex ${argv} ${idx}]
                }
            "--import" -
            "-import" -