exportindex.tcl

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

# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# This procedure creates the tclIndex file for all of the Tcl source files
# in a project.

# To bind this procedure to a menu item, use something like:
# $menu add command -label "Export tclIndex" -underline 0 -command sn_mkindex

proc sn_mkindex {} {
    global sn_options

    catch {cd [sn_read_option project-dir]}

    # Take every sufix from the tcl group
    set prop [file_properties tcl]

    set files ""
    catch {keylget prop SUF files}

    if {[catch {set fd [open tclIndex "w+"]} err]} {
        sn_error_dialog ${err}
        return
    }

    fconfigure ${fd} -encoding $sn_options(def,system-encoding) -blocking 0
    puts ${fd} "# Tcl autoload index file, version 2.0"
    puts ${fd} "# This file is generated by Source-Navigator"
    puts ${fd} "# and sourced to set up indexing information for one or"
    puts ${fd} "# more commands.  Typically each line is a command that"
    puts ${fd} "# sets an element in the auto_index array, where the"
    puts ${fd} "# element name is the name of a command and the value is"
    puts ${fd} "# a script that loads the command.\n"

    mkindex_scope ${fd} [list fu cl] ${files}

    close ${fd}
}

# This proc dumps the known Tcl procs of the project.
proc mkindex_scope {fd scope files} {
    foreach s ${scope} {
        if {[catch {set cont [lsort [paf_db_${s} seq -col {0 2}]]}]} {
            continue
        }
    }
    foreach f ${files} {
        foreach c [lmatch ${cont} "* ${f}"] {
            set nm [lindex ${c} 0]
            set file [lindex ${c} 1]
            puts ${fd} "set auto_index\(${nm}\) \[list source \[file join\
              \$dir ${file}\]\]"
        }
    }
}