Mac Power 1997 January/macpower199701.bin/AMUG/Publishing_19/Alpha 6.5.sit/Tcl/Menus/filesetsMenu.tcl

Text File | 1996-08-15 | 39.5 KB | 1,445 lines | [TEXT/ALFA]

## -*-Tcl-*-
 # ###################################################################
 #    Vince's    Additions -    an extension package for Alpha
 #
 #    FILE: "filesets.tcl"
 #                                      created: 24/3/96 {12:58:05 pm}
 #                                  last update: 13/6/96 {1:58:16 am}
 #    Author:    Vince Darley
 #    E-mail:    <[e-mail]>
 #      mail:    Division of    Applied    Sciences, Harvard University
 #            Oxford Street, Cambridge MA    02138, USA
 #       www:    <http://www.fas.harvard.edu/~darley/>
 #
 #==============================================================================
 # Alpha calls two fileset-related routines, 'getCurrFileSet', and
 # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
 # on occasion, but this isn't critical.
 #==============================================================================
 #
 #  modified by  rev reason
 #  -------- --- --- -----------
 #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
 #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
 #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
 # ###################################################################
 ##

##
 # These procedures    are    now    more robust    and    general-purpose. Basic new
 # features    are:
 #
 #       *  user configurable    menu
 #       *  unique-menu names    are    ensured, so    there can be no    clashes
 #       *  new fileset types    ('tex' and 'fromHierarchy')
 #       *  new utility functions    ('stuff', 'wordCount',...)
 #       *  filesets need    not    appear in the menu;    in fact    they can be
 #          anywhere you like
 ##

if $startingUp {
    addMenu fsetMenuName
    set fsetMenuName     "･131"
    return
}

##
 # -------------------------------------------------------------------------
 #
 # "gCheckset" --
 #
 #    If the global variable 'var' isn't yet defined,    it is set to the
 #    value 'val'.  Else nothing happens.
 #
 # -------------------------------------------------------------------------
 ##
proc gCheckset {var val} {
    if [uplevel ¥#0 info exists $var] { return [uplevel ¥#0 set $var] }
    uplevel ¥#0 set $var ¥{$val¥}
    return $val
}

proc fsetMenuName {} {}
# Build some filesets on the fly.
catch {unset fileSets}
catch {unset currFileSet}
set gfileSets(Help) "$HOME:Help:*"
set gfileSets(System) "$HOME:Tcl:SystemCode:*.tcl"
set gfileSets(Menus) "$HOME:Tcl:Menus:*.tcl"
set gfileSets(Modes) "$HOME:Tcl:Modes:*.tcl"
set gfileSetsType(Help) "fromDirectory"
set gfileSetsType(System) "fromDirectory"
set gfileSetsType(Menus) "fromDirectory"
set gfileSetsType(Modes) "fromDirectory"

if !$alphaLite {
    set gfileSets(User) "$HOME:Tcl:UserCode:*.tcl"
    set gfileSetsType(User) "fromDirectory"
}

# Default curr fileset is the first one. Can be changed in 'prefs.tcl'.
set currFileSet [lindex [array names gfileSets] 0]

#################################################
#                                                #
#    Section    1:    Fileset    variables and flags.    #
#                                                #
#################################################
# Any of these can be over-ridden by the stored #
# definitions in defs.tcl, arrdefs.tcl          #
#################################################

##
 # We don't    show the 'help'    fileset, since it's    under the MacOS
 # AppleGuide menu.     Also we could perhaps yank    tex-filesets away
 # into    their own menu,    in which case the tex-system could add to
 # this    variable as    it went    along.
 ##
gCheckset filesetsNotInMenu "Help"

##
 # A type is a means of    generating a fileset given its
 # description in the variable 'gfileSets(name)':
 ##
gCheckset fileSetsTypes { "list" "glob" "fromHierarchy" }

##
 # A menu type is a    means of prompting the user    and
 # characterising the interface    to a type, even
 # though the actual storage may be    very simple
 # (a list in most cases).
 ##
set fileSetsTypesMenu(fromDirectory) "glob"
set fileSetsTypesMenu(fromHierarchy) "fromHierarchy"
set fileSetsTypesMenu(think) "list"
set fileSetsTypesMenu(codewarrior) "list"
set fileSetsTypesMenu(ftp) "list"
set fileSetsTypesMenu(fromOpenWindows) "list"

##
 # To add a    new    fileset    type, you need to define the following:
 #       set fileSetsTypesMenu(myType) "list"
 #       proc    myTypeCreateFileset    {} {}
 #       proc    myTypeFilesetUpdate    {name} {}
 #
 # For more    complex    types (e.g.    the    tex-type), define as follows:
 #       set fileSetsTypesMenu(myType) "myType"
 #       proc    myTypeCreateFileset    {} {}
 #       proc    myTypeFilesetSelected {    fset menu item }    {}
 #       proc    myTypeFilesetUpdate    { name } {}
 #       proc    myTypeListFilesInFileset { name    } {}
 #       proc    myTypeMakeFileSetSubMenu { name    } {}
 #
 # These procedures    will all be    called automatically under the
 # correct circumstances.  The purposes of these are as follows:
 #
 #   'create'   -- query the user for name etc. and create
 #   'update'   -- given the information in 'gfileSets', recalculate
 #                   the member files.
 #   'selected' -- a member was selected in a menu.
 #   'list'     -- given info in all except 'fileSets', return list
 #                 of files to be stored in that variable.
 #   'submenu'  -- generate the sub-menu
 #
 # Your    code may wish to call 'isWindowInFileset ?win? ?type?' to
 # check if    a given    (current by    default) window    is in a    fileset    of
 # a given type.
 ##

##
 # -------------------------------------------------------------------------
 #
 #    "filesetSortOrder" --
 #
 #       The structure of    this variable dictates how the fileset
 #       menu    is structured:
 #
 #           '{pattern p}'
 #               lists all filesets which    match 'p'
 #           '-'
 #               adds    a separator    line
 #           '{list of types}'
 #               lists all filesets of those types.
 #           '{submenu name sub-order-list}'
 #               adds    a submenu with name    'name' and recursively
 #               adds    filesets to    that submenu as    given by the
 #               sub-order.
 #
 #       Leading,    trailing and double    separators are automatically
 #       removed.
 #
 # -------------------------------------------------------------------------
 ##
gCheckset filesetSortOrder { {pattern System} {pattern Menus} {pattern Modes} {pattern User} {pattern Preferences} ¥
                        - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} ¥
                        - {fromDirectory think codewarrior ftp ¥
                        fromOpenWindows fromHierarchy} * }

set    "filesetUtils(browseFilesetﾉ)" [list * browseFileset]
set    "filesetUtils(renameFilesetﾉ)" [list * renameFileset]
set    "filesetUtils(openEntireFilesetﾉ)" [list * openEntireFileset]
set    "filesetUtils(filesetToAlphaﾉ)" [list * filesetToAlpha]
set    "filesetUtils(closeEntireFilesetﾉ)" [list * closeEntireFileset]
set    "filesetUtils(replaceInFilesetﾉ)" [list * replaceInFileset]
set    "filesetUtils(stuffFilesetﾉ)" [list * stuffFileset]
set    "filesetUtils(wordCount)" [list * wordCountFileset]
set    "filesetUtils(wordCountFast)" [list * wordCountFilesetFast]
set    "filesetUtils(openFilesetFolderﾉ)" [list * openFilesetFolder]


##
 # The meaning of these    flags is as    follows:
 #       sortFilesetItems    --
 #           a type can have the option of being unsorted    (e.g. tex-filesets)
 #       indentFilesetItems --
 #           visual formatting may be    of relevance to    some types
 #       sortFilesetsByType --
 #           use the variable    'filesetSortOrder' to determine    the
 #           visual structure    of the fileset menu
 #       autoAdjustFileset --
 #           when    a file is selected from    the    menu, do we    try    and
 #           keep    'currFileSet' accurate?
 #       includeNonTextFiles --
 #           filesets may include non-text files.  Alpha will tell the
 #           finder to open these if they are selected.
 ##
foreach    flag { sortFilesetItems    indentFilesetItems sortFilesetsByType ¥
               autoAdjustFileset includeNonTextFiles } {
    gCheckset filesetFlags($flag) 0
}
unset flag
set filesetFlagsRebuild(sortFilesetsByType) "*"
set filesetFlagsRebuild(includeNonTextFiles) "*"

# To add a new fileset type, all we have to do is this:
set fileSetsTypesMenu(tex) "tex"
lappend fileSetsTypes "tex"
# If you create new types just add lines like that to
# your "prefs.tcl", or install them permanently using
# addDef and addArrDef.

#===========================================================================
# The support routines.
#===========================================================================
# Called from Alpha to get list of files for current file set.
proc getCurrFileSet {} {
    global currFileSet
    return [getFileSet $currFileSet]
}

# Called from Alpha to get names. The first name returned is taken to
# be the current fileset.
proc getFileSetNames {} {
    global gfileSets currFileSet
    set ind [lsearch [array names gfileSets] $currFileSet]
    if {$ind < 0} {set ind 0}
    return [linsert [lsort [lreplace [array names gfileSets] $ind $ind]] 0 $currFileSet]
}


# Keep 'sets' menu up to date.
trace vdelete currFileSet w shadowCurrFileSet
trace variable currFileSet w shadowCurrFileSet
proc shadowCurrFileSet {nm1 nm2 op} {
    global gfileSets currFileSet
    foreach name [array names gfileSets] {
        if {$name == $currFileSet} {
            catch {markMenuItem -m choose $name on}
        } else {
            catch {markMenuItem -m choose $name off}
        }
    }
    return $currFileSet
}


#================================================================================
# Edit a file from a fileset via list dialogs (no mousing around).
#================================================================================
proc editFile {} {
    global currFileSet modifiedVars gfileSetsType

    set fset [pickFileset "" {Fileset?} "list" [list {*recent*}]]
    set currFileSet $fset
    lappend modifiedVars currFileSet

    if {$fset == {*recent*}} {return [editRecentFile]}
    set ff [getFilesInSet $fset]
    foreach f $ff {
        lappend disp [file tail $f]
    }
    foreach res [listpick -l -p {File?} [lsort -ignore $disp]]  {
        set ind [lsearch $ff ¥*:$res]
        if {$gfileSetsType($fset) == "ftp"} {
            ftpFilesetOpen $fset [lindex $ff $ind]
        } else {
            catch {generalOpenFile [lindex $ff $ind]}
        }
    }
}

# We only return TEXT files, since we don't want Alpha
# manipulating the data fork of non-text files.
proc getFileSet {fset} {
    global filesetFlags
    if $filesetFlags(includeNonTextFiles) {
        set fnames ""
        foreach f [getFilesInSet $fset] {
            getFileInfo $f a
            if {$a(type) == "TEXT"} {
                lappend fnames $f
            }
        }
        return $fnames
    } else {
        return [getFilesInSet $fset]
    }
}

proc browseFileset {{fset ""}} {
    global tileLeft tileTop tileWidth errorHeight

    set fset [pickFileset $fset {Fileset?}]

    foreach f [getFilesInSet $fset] {
        append text "¥t[file tail $f]¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ$f¥r"
    }
    new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight
    global winModes
    set name [lindex [winNames] 0]
    changeMode [set winModes($name) Brws]

    insertText "(<cr> to go to file)¥r-----¥r$text¥r"
    goto 0
    select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
    setWinInfo dirty 0
    setWinInfo read-only 1
    message ""
}

############################################
#                                           #
#    Section    2:    Basic fileset procedures   #
#                                           #
############################################

proc newFileset {} {
    global currFileSet gfileSetsType fileSetsTypesMenu
    set type [eval [list prompt "New fileset type?" ¥
                "fromDirectory" "Type:"] [lsort -ignore [array names fileSetsTypesMenu]]]
    set name [eval ${type}CreateFileset]

    if ![string length $name] return

    addArrDef gfileSetsType $name $type
    set gfileSetsType($name) $type

    set currFileSet $name
    rebuildAllFilesets
    return $currFileSet
}

proc deleteFileset { {fset ""} {yes 0} } {
    global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
    global fsetMenuName subMenuFilesetInfo subMenuInfo

    set fset [pickFileset $fset "Delete which Fileset?"]
     if {$currFileSet == $fset} {catch {set currFileSet System}}

    if {$yes || [askyesno "Delete fileset ¥"$fset¥"?"] == "yes"} {
        catch {unset "fileSetsExtra($fset)"}
        catch {unset "gfileSetsType($fset)"}
        catch {unset "fileSets($fset)"}
        catch {unset "gfileSets($fset)"}

        removeArrDef gfileSetsType $fset
        catch {removeArrDef fileSetsExtra $fset}
        removeArrDef gfileSets $fset

        # find its menu:
        set base ""
        foreach m $subMenuFilesetInfo($fset) {
            # remove info about it's name
            catch {unset subMenuInfo($m)}
            catch {removeMenu $m}
            # try and remove it's base from the main menu too
            if { [string trimright $m] == $fset } { set base $m }
        }
        unset subMenuFilesetInfo($fset)

        if [catch {deleteMenuItem -m $fsetMenuName $base}] {
            # it's on a submenu or somewhere else so we just have
            # to do the lot!
            if !$yes { rebuildAllFilesets }
        } else {
            deleteMenuItem -m choose $fset
            deleteMenuItem -m hideFileset $fset
        }
    }
}

##
 # -------------------------------------------------------------------------
 #
 #    "pickFileset" --
 #
 #     Ask the user for a/several    filesets.  If 'fset' is    set, we    just
 #     return    that (this avoids 'if {$fset !=    ""}    { set fset [pick...] }
 #     constructs    everywhere).  A    prompt can be given, and a dialog type
 #     (either a listpick, a pop-up menu,    or a listpick with multiple
 #     selection), and extra items can be    added to the list if desired.
 # -------------------------------------------------------------------------
 ##
proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
    global gfileSets currFileSet
    if { $fset != "" } { return $fset }
    switch $type {
        "popup" {
            set fset [eval [list prompt $prompt ¥
                $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
            if ![info exists gfileSets($fset)] { error "No such fileset" }
            return $fset
        }
        "list" {
            return [listpick -p $prompt -L $currFileSet ¥
                [lsort -ignore [concat $extras [array names gfileSets]]]]
        }
        "multilist" {
            return [listpick -p $prompt -l -L $currFileSet ¥
                [lsort -ignore [concat $extras [array names gfileSets]]]]
        }
    }
}

proc renameFileset {} {
    global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
    global fileSetsTypesMenu

    set fset [pickFileset "" {Fileset to rename?}]

    set name [getline "Rename to:" $fset]
    if {![string length $name] || $name == $fset} return

    set gfileSets($name) $gfileSets($fset)
    set gfileSetsType($name) $gfileSetsType($fset)
    catch {set fileSets($name) $fileSets($fset)}
    catch {set fileSetsExtra($name) $fileSetsExtra($fset)}

    deleteFileset $fset 1

    addArrDef gfileSets $name $gfileSets($name)
    addArrDef gfileSetsType $name $gfileSetsType($name)
    catch {addArrDef fileSetsExtra $name $fileSetsExtra($name)}

    rebuildAllFilesets
    set currFileSet $name
}

proc updateCurrentFileset {} {
    global currFileSet gfileSetsType
    set type $gfileSetsType($currFileSet)
    catch {eval "${type}FilesetUpdate" ¥{$currFileSet¥} }
    eval [makeFileSetAndMenu $currFileSet 1]

    callFilesetUpdateProcedures $currFileSet
}

proc callFilesetUpdateProcedures { {fset ""} } {
    global filesetUpdateProcs gfileSetsType
    if { $fset == "" } {
        set types [array names filesetUpdateProcs]
    } else {
        set types $gfileSetsType($fset)
    }

    foreach l $types {
        if [info exists filesetUpdateProcs($l)] {
            foreach proc $filesetUpdateProcs($l) {
                eval $proc
            }
        }
    }

}

proc listContains { list item } { return [expr [lsearch -exact $list $item] != -1] }


##################################################
#                                                 #
#    Section    3: Creation    of basic fileset types     #
#                                                 #
##################################################

proc fromDirectoryCreateFileset {} {
    global gfileSets gfileSetsType

    set name [getFilesetDirectoryAndPattern]
    if ![string length $name] return

    set gfileSetsType($name) "fromDirectory"

    if {[askyesno "Save new fileset?"] == "yes"} {
        addArrDef gfileSets $name $gfileSets($name)
        addArrDef gfileSetsType $name "fromDirectory"
    }
    return $name
}

proc getFilesetDirectoryAndPattern {} {
    global gfileSets
    set name [getline "New fileset name:" ""]
    if {![string length $name]} return

    set dir [string trim [get_directory -p "New fileset dir:"] ":"]
    if {![string length $dir]} return

    set filePat [getline "File pattern:" "*"]
    if {![string length $filePat]} return

    set gfileSets($name) "$dir:$filePat"
    return $name
}

proc fromDirectoryFilesetUpdate {name} {
    # done on the fly so no need to update
    #global fileSets gfileSets
    #set fileSets($name) [glob -nocomplain -t TEXT "$gfileSets($name)"]
}

proc fromHierarchyCreateFileset {} {
    global gfileSets gfileSetsType

    set name [getFilesetDirectoryAndPattern]
    if ![string length $name] return

    set gfileSetsType($name) "fromHierarchy"
    set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
    if { $depth == "" } {set depth 3}

    set gfileSets($name) [list $gfileSets($name) $depth]

    if {[askyesno "Save new fileset?"] == "yes"} {
        addArrDef gfileSets $name $gfileSets($name)
        addArrDef gfileSetsType $name "fromHierarchy"
    }
    return $name
}

proc fromHierarchyFilesetUpdate {name} {
    global fileSets gfileSets
    set fileSets($name) [fromHierarchyListFilesInFileSet $name]
}

proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
    global filesetTemp fileSets gfileSets
    set dir [file dirname [lindex $gfileSets($name) 0]]
    set patt [file tail [lindex $gfileSets($name) 0]]
    set depth [lindex $gfileSets($name) 1]
    # we make the menu as a string, but can bin it if we like
    set menu [buildSubMenu [list $dir] $name filesetProc filesetTemp $patt $depth $name]

    # we need to construct the list of items
    set fileSets($name) {}
    foreach n [array names filesetTemp] {
        lappend fileSets($name) $filesetTemp($n)
    }
    unset filesetTemp
    return $menu
}

proc fromHierarchyFilesetSelected {fset menu item} {
    global gfileSets
    set dir [file dirname [lindex $gfileSets($fset) 0]]
    set ff [getFilesInSet $fset]
    if { $fset == $menu } {
        # it's top level
        if {[set match [lsearch $ff ${dir}:$item]] >= 0} {
            autoUpdateFileset $fset
            generalOpenFile [lindex $ff $match]
            return
        }
    }
    # the following two are slightly cumbersome, but give us the best
    # chance of finding the correct file given any ambiguity (which can
    # certainly arise if file and directory names clash excessively).
    if {[set match [lsearch $ff ${dir}:${menu}:$item]] >= 0} {
        autoUpdateFileset $fset
        generalOpenFile [lindex $ff $match]
        return
    }
    if {[set match [lsearch $ff ${dir}:*:${menu}:$item]] >= 0} {
        autoUpdateFileset $fset
        generalOpenFile [lindex $ff $match]
        return
    }
    alertnote "Weird! Couldn't find it."
}


proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
proc codewarriorCreateFileset {} { return [createWarriorFileset] }
proc thinkCreateFileset {} { return [createThinkFileset] }

proc fromOpenWindowsCreateFileset {} {
    global gfileSets

    set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]

    addArrDef gfileSets $name [winNames -f]
    set gfileSets($name) [winNames -f]

    return $name
}

##################################
#                                 #
#    Section    4: Menu    Procedures     #
#                                 #
##################################

##
 # Global procedures to    deal with the fact that    Alpha can only have    one
 # menu    with each given    name.  This    is only    a problem in dealing with
 # user-defined    menus such as fileset menus, tex-package menus,    ...
 ##

##
 # -------------------------------------------------------------------------
 #
 #    "makeFilesetSubMenu" --
 #
 #     If    desired    this is    the    only procedure you need    use    ---    it returns
 #     a menu    creation string, taking    account    of the unique name requirement
 #     and will make sure    your procedure 'proc' is called    with the real
 #     menu name!
 # -------------------------------------------------------------------------
 ##
proc makeFilesetSubMenu {fset name proc args} {
    if { [string length $proc] > 1 } {
        return [concat {menu -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
    } else {
        return [concat {menu -n} [list [registerFilesetMenuName $fset $name]] $args]
    }
}

##
 # -------------------------------------------------------------------------
 #
 #    "registerFilesetMenuName" --
 #
 #     Call to ensure    unique fileset submenu names.  We just add spaces
 #     as    appropriate    and    keep track of everything for you!  Filesets
 #     which have    multiple menus _must_ register the main    menu first.
 # -------------------------------------------------------------------------
 ##
proc registerFilesetMenuName {fset name {proc ""}} {
    global subMenuInfo subMenuFilesetInfo
    if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
        # if the fileset already has a base menu, use that:
        foreach n $subMenuFilesetInfo($fset) {
            if { [string trimright $n] == $fset } {
                set base $n
            }
            unset subMenuInfo($n)
        }
        unset subMenuFilesetInfo($fset)
    }
    set original $name
    if [info exists base] {
        set name $base
    } else {
        # I add at least one space to _all_ hierarchical submenus now.
        # This is so I won't clash with any current or future modes
        # which should never normally add spaces themselves.
        append name " "
        while { [info exists subMenuInfo($name)] } {
            append name " "
        }
    }

    set subMenuInfo($name) [list "$fset" "$original" "$proc"]
    # build list of a fileset's menus
    lappend subMenuFilesetInfo($fset) "$name"

    return $name
}


proc realMenuName {name} {
    global subMenuInfo
    return [lindex $subMenuInfo($name) 1]
}

##
 # -------------------------------------------------------------------------
 #
 #    "subMenuProc" --
 #
 #     This procedure    is implicitly used to deal with    ensuring unique
 #     sub-menu names.  It calls the procedure you asked for,    with
 #     the name of the menu you think    you're using.
 # -------------------------------------------------------------------------
 ##
proc subMenuProc {menu item} {
    global subMenuInfo
    set l $subMenuInfo($menu)
    set realProc [lindex $l 2]
    # try and call the proc with three arguments (fileset is 1st)
    if [catch {$realProc [lindex $l 0] [lindex $l 1] "$item"}] {
        $realProc [lindex $l 1] "$item"
    }
}


proc filesetMenuProc {menu item} {
    global HOME
    switch $item {
        "Edit File" {
        editFile
        return
        }
    "Help" {
        editMark "$HOME:Help:Manual" "File Sets" -r
        return
        }
    "New Fileset" {
        return [newFileset]
        }
    "Delete Fileset" {
        return [deleteFileset]
        }
    }

}

##
 # -------------------------------------------------------------------------
 #
 #    "filesetProc" --
 #
 #     Must be called    by 'subMenuProc'
 # -------------------------------------------------------------------------
 ##
proc filesetProc {fset menu item} {
    global gfileSetsType
    if {$fset != ""} {set m $fset} else { set m $menu}
    switch $gfileSetsType($m) {
        "fromDirectory" -
        "think" -
        "codewarrior" -
        "fromOpenWindows" {
            filesetBasicOpen $m $item
        }
        "ftp" { ftpFilesetOpen $m $item }
        "default" {
            # try a type-specific method first
            if [catch {eval $gfileSetsType($m)FilesetSelected ¥{$fset¥} ¥{$menu¥} ¥{$item¥}}] {
                # if that failed then perhaps it only wants two parameters
                if [catch {eval $gfileSetsType($m)FilesetSelected ¥{$menu¥} ¥{$item¥}}] {
                    # if that failed then just hope it's an ordinary list
                    filesetBasicOpen $m $item
                }
            }
        }
    }

}

proc filesetBasicOpen { menu item } {
    if {[set match [lsearch [getFilesInSet $menu] *:$item]] >= 0} {
        autoUpdateFileset $menu
        generalOpenFile [lindex [getFilesInSet $menu] $match]
    }
}

proc generalOpenFile {file} {
    getFileInfo $file a
    if {$a(type) == "TEXT"} {
        edit $file
    } else {
        sendOpenEvent -noreply Finder "${file}"
    }
}

proc registerUpdateProcedure { type proc } {
    global filesetUpdateProcs
    lappend filesetUpdateProcs($type) [list $proc]
}

proc filesetUtilsProc { menu item } {
    global filesetUtils gfileSetsType currFileSet filesetFlags filesetFlagsRebuild
    if [info exists filesetUtils($item)] {
        # it's a utility
        set utilDesc $filesetUtils($item)
        set allowedTypes [lindex $utilDesc 0]
        if [string match $allowedTypes $gfileSetsType($currFileSet)] {
            return [eval [lindex $utilDesc 1]]
        } else {
            beep
            message "That utility can't be applied to the current file-set."
            return
        }
    } elseif [info exists filesetFlags($item)] {
        # it's a flag

        if [set    filesetFlags($item)    [expr 1    - $filesetFlags($item)]] {
            markMenuItem "filesetFlags" $item on
        } else {
            markMenuItem "filesetFlags" $item off
        }
         addArrDef filesetFlags "$item" "$filesetFlags($item)"
        if [info exists filesetFlagsRebuild($item)] {
            rebuildSomeFilesetMenu $filesetFlagsRebuild($item)
        }

        return
    } else {
        $item
    }
}

proc getFilesInSet {fset} {
    global gfileSets fileSetsTypesMenu gfileSetsType
    switch $fileSetsTypesMenu($gfileSetsType($fset)) {
        "list" {
            return $gfileSets($fset)
        }
        "glob" {
            global filesetFlags
            if $filesetFlags(includeNonTextFiles) {
                return [glob -nocomplain "$gfileSets($fset)"]
            } else {
                return [glob -nocomplain -t TEXT "$gfileSets($fset)"]
            }
        }
        "default" {
            global fileSets
            return $fileSets($fset)
        }
    }
}

proc makeFileSetAndMenu { name andMenu } {
    global gfileSetsType fileSetsTypesMenu
    message "Building ${name}..."
    set type $gfileSetsType($name)
    switch $fileSetsTypesMenu($type) {
        "list" -
        "glob" {
            if $andMenu {
                set menu {}
                foreach m [getFilesInSet $name] {
                    lappend menu "[file tail $m]¥&"
                }
                return [makeFilesetSubMenu $name $name filesetProc -s -m [lsort -i $menu]]
            } else {
                return
            }
        }
        "default" {
            return [${type}MakeFileSetAndMenu $name $andMenu]
        }
    }
}

proc filesetsSorted { order usedvar } {
    upvar $usedvar used
    global filesetFlags gfileSets gfileSetsType
    set sets {}
    foreach item $order {
        switch -- [lindex $item 0] {
          "-" {
              # add divider
            lappend sets "(-"
            continue
          }
          "*" {
            # add all the rest
              set subset {}
            foreach s [array names gfileSets] {
                if ![listContains $used $s]  {
                    lappend subset $s
                    lappend used $s
                }
            }
            foreach f [lsort $subset] {
                lappend sets [makeFileSetAndMenu $f 1]
            }
          }
          "pattern" {
              # find all which match a given pattern
              set patt [lindex $item 1]
              set subset {}
            foreach s [array names gfileSets] {
                if ![listContains $used $s]  {
                    if [string match $patt $s] {
                        lappend subset $s
                        lappend used $s
                    }
                }
            }
            foreach f [lsort $subset] {
                lappend sets [makeFileSetAndMenu $f 1]
            }

          }
          "submenu" {
              # add a submenu with name following and sub-order
              set name [lindex $item 1]
              set suborder [list [lindex $item 2]]
              # we make kind of a pretend fileset here.
              set subsets [filesetsSorted $suborder used]
              if { $subsets != "" } {
                  lappend sets [makeFilesetSubMenu $name $name filesetProc -m $subsets]
              }
          }
          "default" {
            set subset {}
            foreach s [array names gfileSets] {
                if {[listContains $item $gfileSetsType($s)] && ![listContains $used $s]}  {
                    lappend subset $s
                    lappend used $s
                }
            }
            foreach f [lsort $subset] {
                lappend sets [makeFileSetAndMenu $f 1]
            }
          }
        }

    }
    # remove multiple and leading, trailing '-' in case there were gaps
    regsub -all {¥(-( ¥(-)+} $sets {(-} sets
    while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
    set l [expr [llength $sets] -1]
    if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }

    return $sets
}


# This should be used by "AlphaBits.tcl" for the initial build.
# After that it is only necessary to call 'rebuildAllFilesets'.
# Currently this proc is only necessary for backwards compatibility
# It should be removed at some future date.
proc rebuildFilesetMenu {} {
    global gfileSets gfileSetsType
    foreach fset [array names gfileSets] {
        if ![info exists gfileSetsType($fset)] {
            addArrDef gfileSetsType "$fset" "fromDirectory"
            set gfileSetsType($fset) "fromDirectory"
        }
    }

    rebuildAllFilesets
}

##
 # -------------------------------------------------------------------------
 #
 #    "zapAndBuildFilesets" --
 #
 #     This does a complete rebuild of all information.  The problem is that
 #     the names of menus    may    actually change    (spaces    added/deleted).    This
 #     is    not    a problem for the fileset menu,    but    is a problem for any
 #     filesets which    have been added    to other menus,    since they won't know
 #     that they need    to be rebuilt.
 # -------------------------------------------------------------------------
 ##
proc zapAndBuildFilesets {} {
    global subMenuInfo subMenuFilesetInfo
    unset subMenuInfo
    unset subMenuFilesetInfo
    rebuildAllFilesets
}

proc rebuildAllFilesets {} {
    global gfileSets fsetMenuName  filesetSortOrder
    global filesetFlags filesetsNotInMenu

    if $filesetFlags(sortFilesetsByType) {
        # just make file-sets for those we don't want in the menu
        foreach f $filesetsNotInMenu {
            makeFileSetAndMenu $f 0
        }

        set used $filesetsNotInMenu
        set sets [filesetsSorted $filesetSortOrder used]
    } else {
        foreach f [lsort [array names gfileSets]] {
            set doMenu [expr ![listContains $filesetsNotInMenu $f]]
            set menu [makeFileSetAndMenu $f $doMenu]
            if { $doMenu && $menu != "" } {
                lappend sets $menu
            }
        }
    }

    regsub -all {[-][nm]} $sets "" names
    set names [map cadr $names]
    set names [map "string trimright" $names]

    menu -m -n $fsetMenuName -p filesetMenuProc ¥
        [concat {{/'Edit Fileﾉ} {menu -n Utilities {}}} ¥
        ¥{[list menu -n Palette -m -p filesetPalette $names]¥} "Help" ¥
        "(-" $sets]
    rebuildFilesetUtilsMenu
    callFilesetUpdateProcedures

    message ""
}

proc filesetPalette {menu item} {
    float -m "$item " -n $item
}



##
 # -------------------------------------------------------------------------
 #
 #    "rebuildSomeFilesetMenu" --
 #
 #     If    given '*' rebuild the entire menu, else    rebuild    only those types
 #     given.     This is generally useful to avoid excessive rebuilding    when
 #     flags are adjusted
 # -------------------------------------------------------------------------
 ##
proc rebuildSomeFilesetMenu {amount} {
    global gfileSets gfileSetsType
    switch -- $amount {
        "*" {
            rebuildAllFilesets
        }
        "default" {
            foreach f [lsort [array names gfileSets]] {
                if {$f == "Help"} continue
                if [listContains $amount $gfileSetsType($f)] {
                    eval [makeFileSetAndMenu $f 1]
                }

            }
        }
    }

}

proc rebuildFilesetUtilsMenu {} {
    global gfileSets  currFileSet fileSetsTypesMenu filesetUtils filesetFlags

    menu -n "Utilities" -p filesetUtilsProc [concat ¥
        "newFilesetﾉ" ¥
        "deleteFilesetﾉ" ¥
        "updateCurrentFileset" ¥
        "<S<EzapAndBuildFilesets" ¥
        "<SrebuildAllFilesets" ¥
        ¥{[list menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]]¥} ¥
        ¥{[list menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]¥} ¥
        ¥{[list menu -n filesetFlags -p filesetUtilsProc [lsort [array names filesetFlags]]]¥} ¥
        "(-" ¥
        "/T<I<OfindTag" ¥
        "createTagFile" ¥
        "(-" ¥
        [lsort [array names filesetUtils]] ¥
        ]

    filesetUtilsMarksTicks
}

proc rebuildSimpleFilesetMenus {} {
    global gfileSets fileSetsTypesMenu
    menu -n choose -m -p changeFileSet [lsort [array names gfileSets]]
    menu -n createFileset -p createFileset [array names fileSetsTypesMenu]
    menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
    filesetUtilsMarksTicks
}

proc hideShowFileset { menu item } {
    global filesetsNotInMenu fsetMenuName
    if [listContains $filesetsNotInMenu $item] {
        set idx [lsearch $filesetsNotInMenu $item]
        set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]
        markMenuItem -m hideFileset $item off
        # would be better if we could just insert it
        rebuildAllFilesets
    } else {
        lappend filesetsNotInMenu $item
        markMenuItem -m hideFileset $item on
        removeMenu $item
        if [catch { deleteMenuItem -m $fsetMenuName $item }] {
            # it's on a submenu and I can't be bothered to write
            # code to find that submenu name right now.
            rebuildAllFilesets
        }
    }
}

proc filesetUtilsMarksTicks {} {
    global currFileSet filesetFlags filesetsNotInMenu
    markMenuItem -m choose $currFileSet on

    foreach flag [array names filesetFlags] {
        if $filesetFlags($flag) {
            markMenuItem "filesetFlags" $flag on
        } else {
            markMenuItem "filesetFlags" $flag off
        }
    }

    foreach name $filesetsNotInMenu {
        markMenuItem -m hideFileset $name on
    }

}


# Called in response to user changing filesets from the fileset menu.
proc changeFileSet {menu item} {
    global currFileSet tagFile

    markMenuItem -m choose $currFileSet off
    set currFileSet $item
    markMenuItem -m choose $currFileSet on

    # Bring in the tags file for this fileset
    set fname [tagFileName]
    if {[file exists $fname]} {
        if {[askyesno "Use tag file from folder ¥"$dir¥" ?"] == "yes"} {
            set tagFile $fname
        }
    }
}

proc autoUpdateFileset { name } {
    global currFileSet filesetFlags
    if $filesetFlags(autoAdjustFileset) {
        set currFileSet $name
    }
}

#############################################
#                                            #
#    Section    5: General Utility procedures    #
#                                            #
#############################################

proc isWindowInFileset { {win "" } {type ""} } {
    if {$win == ""} { set win [lindex [winNames -f] 0] }
    global currFileSet gfileSets gfileSetsType

    if { $type == "" } {
        set okSets [array names gfileSets]
    } else {
        set okSets {}
        foreach s [array names gfileSets] {
            if { $gfileSetsType($s) == $type } {
                lappend okSets $s
            }
        }
    }

    if [array exists gfileSets] {
        if {[lsearch -exact $okSets $currFileSet] != -1 } {
            # check current fileset
            if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
                # we're set, it's in this fileset
                return  $currFileSet
            }
        }

        # check other fileset
        foreach fset $okSets {
            if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
                # we're set, it's in this project
                return  $fset
            }
        }
    }
    return ""

}



##
 # -------------------------------------------------------------------------
 #
 #    "iterateFileset" --
 #
 #       Utility procedure to    iterate    over all files in a    project,
 #       calling some    predefined function    '$fn' for each member of
 #       project '$proj'.    The    results    of such    a call are passed to
 #       '$resfn'    if given. Finally "done" is    passed to 'resfn'.
 #
 # -------------------------------------------------------------------------
 ##
proc iterateFileset { proj fn { resfn ¥# } } {
    global gfileSets gfileSetsType
    eval $resfn "first"

    set check [expr ![catch {$gfileSetsType($proj)IterateCheck check}]]

    foreach ff [getFileSet $proj] {
        if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
            continue
        }
        set res [eval $fn ¥{$ff¥}]
        eval $resfn ¥{$res¥}

    }

    if $check {
        catch {$gfileSetsType($proj)IterateCheck done}
    }

    eval $resfn "done"

}

########################
#                       #
#    Section    6:    Tags   #
#                       #
########################

if ![string length [info commands alphaFindTag]] {
    rename findTag alphaFindTag
    rename createTagFile alphaCreateTagFile
}

proc tagFileName {} {
    global gfileSets currFileSet
    return [file dirname [car $gfileSets($currFileSet)]]:[join ${currFileSet}]TAGS
}

proc findTag {} {
    global gfileSetsType currFileSet
    # try a type-specific method first
    if [catch {$gfileSetsType($currFileSet)FindTag}] {
        alphaFindTag
    }
}

proc createTagFile {} {
    global gfileSetsType currFileSet tagFile modifiedVars
    set tagFile [tagFileName]
    lappend modifiedVars tagFile

    # try a type-specific method first
    if [catch {$gfileSetsType($currFileSet)CreateTagFile}] {
        alphaCreateTagFile
    }
}


############################
#                           #
#        Section    7: Utils   #
#                           #
############################


proc dirtyFileset { fset } {
    foreach f [getFilesInSet $fset] {
        if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
    }
    return 0
}

proc saveEntireFileset { fset } {
    foreach f [getFilesInSet $fset] {
        if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} {
            bringToFront $f
            save
        }
    }
}

proc closeEntireFileset { {fset ""} } {
    set fset [pickFileset $fset "Close which fileset?" "popup"]

    foreach f [getFilesInSet $fset] {
        if ![catch {getWinInfo -w $f arr}] {
            bringToFront $f
            killWindow
        }
    }
}

proc fileToAlpha {f} {
    if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
        message "Converting $f"
        setFileInfo $f creator ALFA
    }
}

proc filesetToAlpha {} {
    set fset [pickFileset "" {Convert all files from which fileset?} "popup"]
    iterateFileset $fset fileToAlpha
}

proc replaceInFileset {} {
    global gfileSets

    set from [prompt "Search string:" [searchString]]
    searchString $from
    set from [quoteExpr $from]
    regsub -all {&} $from {¥¥&} from
    set to [prompt "Replace string:" [replaceString]]
    replaceString $to
    set to [quoteExpr $to]
    regsub -all {&} $to {¥¥&} to
    set fsets [pickFileset "" "Which filesets?" "multilist"]

    if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
    saveAll

    set cid [scancontext create]
    scanmatch $cid $from {
        set matches($f) 1
    }
    foreach fset $fsets {
        foreach f [getFileSet $fset] {
            if {![catch {set fid [open $f]}]} {
                message "Looking at '[file tail $f]'"
                scanfile $cid $fid
                close $fid
            }
        }
    }

    scancontext delete $cid

    foreach f [array names matches] {
        message "Modifying ${f}ﾉ"
        set cid [open $f "r"]
        if {[regsub -all $from [read $cid] $to out]} {
            set ocid [open $f "w+"]
            puts -nonewline $ocid $out
            close $ocid
        }
        close $cid
    }

    if {[buttonAlert "Revert affected windows?" "Yes" "No"] == "Yes"} {
        foreach f [array names matches] {
            bringToFront $f
            revert
        }
    }
    message ""
}

proc openEntireFileset {} {
    set fset [pickFileset "" "Open which fileset?" "popup"]

    # we use our iterator in case there's something special to do
    iterateFileset $fset "edit -c -w"
}

proc openFilesetFolder {} {
    global gfileSets
    set fset [pickFileset "" "Open which fileset's folder?" "popup"]
    titlebar [file dirname $gfileSets($fset)]
}

proc stuffFileset {} {
    global gfileSetsType gfileSets
    set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
    if [string length $fset] {
        if { $gfileSetsType($fset) == "fromDirectory" && ¥
             [askyesno "Stuff entire directory?"] == "yes" } {
             launchForeAppl DStf
             sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]:"
        } else {
            launchForeAppl DStf
            eval sendOpenEvents 'DStf' [getFilesInSet $fset]
        }
        sendQuitEvent 'DStf'
    }
}

proc filesetRememberOpenClose { file } {
    global fileset_openorclosed
    set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
}

proc filesetRevertOpenClose { file } {
    global fileset_openorclosed
    if { [lindex $fileset_openorclosed 0] == "$file" } {
        if { [lindex $fileset_openorclosed 1] < 0 } {
            killWindow
        }
    }
    catch {unset fileset_openorclosed}
}

proc wordCountFileset {} {
  global currFileSet
  iterateFileset $currFileSet wordCountProc filesetUtilWordCount
}

proc wordCountFilesetFast {} {
  global currFileSet
  iterateFileset $currFileSet wc filesetUtilWordCount
}

proc filesetUtilWordCount { count } {
    global fs_ccount fs_wcount fs_lcount
    switch $count {
        "first" {
            set fs_ccount 0
            set fs_wcount 0
            set fs_lcount 0
        }
        "done" {
            alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_ccount chars"
            unset fs_ccount fs_wcount fs_lcount
        }
        default {
            incr fs_ccount [lindex $count 2]
            incr fs_wcount [lindex $count 1]
            incr fs_lcount [lindex $count 0]
        }
    }
}



##
 # ----------------------------------------------------------------------
 #
 #  "wordCountProc" --
 #
 #   We use this proc to count words.  Calling 'wc' would be quicker (it is a
 #   C procedure and doesn't require the opening of a file), however it seems
 #   to have a HUGE memory leak so is a bit useless for our purposes.
 #
 # ----------------------------------------------------------------------
 ##
proc wordCountProc { file } {
    filesetRememberOpenClose "$file"
    openFileQuietly "$file"
    set chars [maxPos]
    set lines [lindex [posToRowCol $chars] 0]
    set text [getText 0 [maxPos]]
    regsub -all {[!=;.,¥(¥#¥=¥):¥{¥"¥}]} $text " " ret
    set words [llength $ret]
    unset text ret
    filesetRevertOpenClose $file
    return "$chars $words $lines"
}




# Should be last so all filesets make it in.
message "Building filesets..."

rebuildFilesetMenu