[ulis], 2004-01-20. FindProcs is an editor utility that let you jump to a proc. Designed for Textpad it can be used (modified) for other editors.

----
'''A snapshot'''

[http://perso.wanadoo.fr/maurice.ulis/tcl/FindProcs.png]

----
'''The script'''

  #########################
  #
  # FindProcs: jump to a proc (Textpad utility)
  #
  # (C) 2004, ulis; NOL
  #
  #########################

  if 0 \
  {
    # Abstract

    This script let you see a listbox with all the occurrences of a proc, class, method...,
      select one and have the text cursor positionned in front of the selected one.

    # Install

    For Textpad:

      - Optional: copy the DDEOPN32.EXE utility from the Textpad system directory
        to the Windows sytem32 or system directory
      - Put FindProcs.tcl & FindProcs.cfg in the TextPad SYSTEM directory (or elsewhere)
      - With the /Configure/Preferences menu add a new tool with:
          - Commands        = <the path of wish>
          - Parameters      = <the path of this file> $File
          - Initial folder  = $FileDir
      - Rename this tool: FindProcs
      - Modify FindProcs.cfg
        keys = <space separated list of keys as proc, class, method...>
        exec = <script to execute to go to the proc> (where you can have to set the DDEOPN32.EXE path)
                 inside this script: 
                    %FileName% will be replaced by the Tcl source file name
                    %Line% will be replaced by the line where is the proc.
        options = <space separated list of key/value pairs>
                 -sort <boolean>
                    0 : proc list will not be sorted
                    1 : proc list will be sorted
        @keys, @exec, @options : Tcl script returning a value for keys, exec or options

    # Use

    From the Tcl/Tk text window select the /Tools/FindWords menu
    Click the right proc name inside the listbox
  }

  # ------------------
  # GetProcs
  #
  # ------------------
  # returns a list of procs description
  #   in the form of {line-# found-key end-of-line}
  # ------------------

  proc GetProcs {} \
  {
    variable {}
    # open Tcl source file
    set fn $(fn)
    if {![catch { open $fn } res]} { set fp $res } \
    else { tk_messageBox -message $res; exit }
    # loop thru lines
    set procs {}
    set ln 0
    while {![eof $fp]} \
    {
      # get a line
      set line [string trimleft [gets $fp]]
      # update current line number
      incr ln
      # search for a key
      set found 0
      foreach key $(keys) \
      { 
        set n [string length $key]
        if {[string range $line 0 $n] == "$key "} { set found 1; break }
      }
      if {$found} \
      {
        # search for the end of line
        set eol [string trimleft [string range $line $n end]]
        while {$line == "\\"} \
        {
          # continuation line
          set eol [string trimleft [gets $fp]]
          incr ln
        }
        if {[string index $eol end] == "\\"} { set eol [string range $eol 0 end-1] }
        set eol [string trim $eol]
        # filter and add to list
        switch -glob -- $eol \
        {
          \{      -
          -       { # switch items }
          %*      -
          $*      { # skip }
          default { lappend procs [list $ln $key $eol] }
        }
      }
    }
    close $fp
    if {$(-sort)} \
    {
      set procs [lsort -index 2 $procs]
      set procs [lsort -index 1 $procs]
    }
    set (procs) $procs
  }

  # ------------------
  # GotoProc
  #
  # ------------------
  # exec's the (script) to go to the proc
  # ------------------

  proc GotoProc {} \
  {
    variable {}
    set index [.lb curselection]
    if {$index == ""} { return }
    set line [lindex $(procs) $index 0]
    set fn [string map {\\ /} $(fn)]
    set script [string map [list %FileName% $fn %Line% $line] $(exec)]
    catch { eval $script } msg
    if {$msg != ""} { tk_messageBox -message $msg }
    exit
  }

  # ------------------
  # SetParms
  #
  # ------------------
  # sets the (keys) & (script) parameters
  # ------------------

  proc SetParms {} \
  {
    variable {}
    set (keys) {proc class method property}
    set (exec) "exec DDEOPN32.EXE Textpad \"%FileName%(%Line%)\""
    set (opts) {-sort 1 -font {Courier 9}}
    set fn [file join [file dirname [info script]] FindProcs.cfg]
    if {![catch { open $fn } res]} { set fp $res } \
    else { tk_messageBox -message $res; exit }
    while {![eof $fp]} \
    {
      set line [string trimleft [gets $fp]]
      switch -glob -- $line \
      {
        ""    -
        \;*   -
        \[*   -
        #*    { set key "" }
        key*  { set key keys }
        exe*  { set key exec }
        opt*  { set key opts }
        @key* { set key @keys }
        @exe* { set key @exec }
        @opt* { set key @opts }
        default \
        { tk_messageBox -message "unknown key \"$line\" in config file"; exit } 
      }
      if {$key == ""} { continue }
      set n [string first = $line]
      if {$n == -1} \
      { tk_messageBox -message "wrong line \"$line\" in config file"; exit } 
      set value [string trim [string range $line $n end] " ="]
      set ($key) $value
      if {[string match @* $key]} \
      {
        set key [string range $key 1 end]
        set ($key) [$value]
      }
    }
    close $fp
    # get options
    foreach {option value} $(opts) \
    {
      switch -glob -- $option \
      {
        -f*     { set key -font }
        -s*     { set key -sort }
        default \
        { tk_messageBox -message "unknown option \"$option\" in config file"; exit } 
      }
      set ($key) $value
    }
  }

  # ------------------
  # ChooseProc
  #
  # ------------------
  # presents the listbox with all procs
  # ------------------

  proc ChooseProc {} \
  {
    variable {}
    set (fn) [lindex $::argv 0]
    package require Tk
    wm withdraw .
    SetParms
    GetProcs
    if {[llength $(procs)] == 0} \
    { tk_messageBox -message "no proc found"; exit } 
    wm deiconify .
    listbox .lb -font $(-font) -yscrollc {.vs set}
    scrollbar .vs -command {.lb yview}
    grid .lb -row 0 -column 0 -sticky nsew
    grid .vs -row 0 -column 1 -sticky ns
    grid rowconfigure . 0 -weight 1
    grid columnconfigure . 0 -weight 1
    bind .lb <<ListboxSelect>> GotoProc
    set height 0
    set width 0
    foreach proc $(procs) \
    { 
      foreach {line key name} $proc break
      set item "$key $name (line $line)"
      .lb insert end $item
      incr height
      set length [string length $item]
      if {$width < $length} { set width $length }
    }
    if {$height > 40} { set height 40 }
    if {$height < 10} { set height 10 }
    if {$width > 80} { set width 80 }
    if {$width < 20} { set width 20 }
    .lb config -width $width -height $height
  }

  # ========
  #
  # let's go
  #
  # ========

  ChooseProc

----
[Category Editor utility]