bin/tkbib1.0/search.tcl

# search dialog
# Copyright (c) 2000 Patrick H. Madden
# SUNY Binghamton Computer Science Dept
# pmadden@cs.binghamton.edu
# http://vlsicad.cs.binghamton.edu/~pmadden
# The latest version should be available at
#    http://vlsicad.cs.binghamton.edu/~pmadden/tkbib

#
# This file is part of tkbib
#
# This program 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.
#
# This program 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 this program; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.


# Global search results
set search_results { }
#CLIP+open_search+TEXT+30+2000/01/29 13:12:08+8.0+#
# open_search -- Creates the window for searching, and adds
# the buttons to allow us to filter/merge/etc.
proc open_search { } {
  toplevel .search
  # Not allowed to delete search window
  wm protocol .search WM_DELETE_WINDOW {
# No operations
}
  wm title .search "tkbib Search"

  entry .search.e
  frame .search.fb
  button .search.fb.s -text "Search" -command search
  button .search.fb.f -text "Filter" -command filter
  button .search.fb.m -text "Merge"  -command merge
  button .search.fb.save -text "Save"   -command save_search_res

  frame .search.rf
  listbox .search.rf.l -yscrollcommand ".search.rf.s set"
  scrollbar .search.rf.s -command ".search.rf.l yview"
  pack .search.rf.l -in .search.rf -side left -expand 1 -fill both
  pack .search.rf.s -in .search.rf -side right -fill y

  bind .search.rf.l <Double-Button-1> "edit article \[selection get\]"

  pack .search.e -side top
  pack .search.fb.s .search.fb.f .search.fb.m .search.fb.save -side left
  pack .search.fb
  pack .search.rf -side bottom -expand 1 -fill both
}
#CLIP+search+TEXT+61+2000/01/21 13:23:39+4.37+#
# search -- Runs through all entries, checking to see if anything
# in the entry matches the search key.  Some day, this'll be field-sensitive,
# and allow regular expressions....  Results are listed in the search
# list, and the global search_results
proc search { } {
  global entries search_results

  set search_results { }

  # Remove anything from the current list
  .search.rf.l delete 0 end

  set kw [.search.e get]

  # Check each entry, and if it matches, add it in to the list
  foreach e $entries {
    set found 0
    foreach p $e {
      if {[string first $kw [lindex $p 1]] > -1} {
        set found 1
      }
    }
    if {$found} {
      # puts "Match [lindex [lindex $e 0] 1]"
      lappend search_results [lindex [lindex $e 0] 1]
    }
  }

  foreach cite $search_results {
    .search.rf.l insert end $cite
  }
}
#CLIP+filter+TEXT+94+2000/01/21 13:24:23+2.59+#
# filter -- Similar to search, but will only list entries that match the
# current term, and were also listed by the previous search
proc filter { } {
  global entries search_results

  set old_search_results $search_results
  set search_results { }

  # Remove anything from the current list
  .search.rf.l delete 0 end

  set kw [.search.e get]

  # Check each entry, and if it matches, add it in to the list
  foreach e $entries {
    set found 0
    foreach p $e {
      if {[string first $kw [lindex $p 1]] > -1} {
        set found 1
      }
    }
    # If this element was not in the old search results, mark it
    # as "not found"
    if {[lsearch $old_search_results [lindex [lindex $e 0] 1]] == -1} {
      set found 0
    }
    if {$found} {
      # puts "Match [lindex [lindex $e 0] 1]"
      lappend search_results [lindex [lindex $e 0] 1]
    }
  }

  foreach cite $search_results {
    .search.rf.l insert end $cite
  }
}
#CLIP+merge+TEXT+131+2000/01/21 13:24:48+2.50+#
# merge -- Similar to search, but does additive listing (so the
# old search results are merged with the new ones)
proc merge { } {
  global entries search_results

  set old_search_results $search_results
  set search_results { }

  # Remove anything from the current list
  .search.rf.l delete 0 end

  set kw [.search.e get]

  # Check each entry, and if it matches, add it in to the list
  foreach e $entries {
    set found 0
    foreach p $e {
      if {[string first $kw [lindex $p 1]] > -1} {
        set found 1
      }
    }
    # If this element was in the old search results, mark it as found
    if {[lsearch $old_search_results [lindex [lindex $e 0] 1]] >= 0} {
      set found 1
    }
    if {$found} {
      # puts "Match [lindex [lindex $e 0] 1]"
      lappend search_results [lindex [lindex $e 0] 1]
    }
  }

  foreach cite $search_results {
    .search.rf.l insert end $cite
  }
}
#CLIP+save_search_res+TEXT+167+2000/01/21 13:25:28+3.0+#
# save_search_res -- After figuring out the set of entries that we're
# interested in, we can save them.  Severe abuse of global vars should
# be cleaned up at some point.
proc save_search_res { } {
  global entries search_results

  set tmp_entries $entries

  set entries { }
  foreach e $tmp_entries {
    if {[lsearch $search_results [lindex [lindex $e 0] 1]] >= 0} {
      lappend entries $e
    }
  }

  save_bib

  set entries $tmp_entries
}
#CLIP+pre+TEXT+1+2000/01/21 13:22:17+29.22+#