home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / bibtexMode.tcl < prev    next >
Encoding:
Text File  |  1999-04-22  |  55.0 KB  |  1,805 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "bibtexMode.tcl"
  6.  #                                    created: 17/8/94 {9:12:06 am} 
  7.  #                                last update: 22/4/1999 {6:10:19 pm} 
  8.  #  Updated by: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Major rewrite of most of BibTeX mode.  Original by Tom Pollard.
  15.  # See the end of the BibTeX Help file for a history.
  16.  # 
  17.  # ###################################################################
  18.  ##
  19.  
  20. alpha::mode Bib 3.4 bibtexMenu {*.bib *.inspec *.bst *.hollis *.isi} { 
  21.     texMenu bibtexMenu electricReturn electricTab
  22. } {
  23.     addMenu bibtexMenu "•282" Bib
  24.     alpha::package require -loose AlphaTcl 7.1.8
  25. } uninstall {this-file} help {file "BibTeX Help"}
  26. # to make sure tex-mode is loaded
  27. texMenu
  28. # Since we use the TeX menu
  29. hook::register activateHook makeProcessMenu Bib
  30.  
  31. newPref v bibAutoIndex 1 Bib "" [list "Never make index" \
  32.   "Ask user when it is necessary" "Always remake when necessary"] index
  33.  
  34. newPref v suffixString    { \\\\} Bib
  35. newPref v prefixString {% } Bib
  36. newPref v fillColumn {65} Bib
  37. newPref f wordWrap {1} Bib
  38. newPref f autoMark {1} Bib
  39.  
  40. ## 
  41.  # The first is for to look in the Tex-inputs folder and, by default, is
  42.  # off (easily you can put it on!).  The two others permit you to use the
  43.  # new feature of Alpha that associates any mode with folders to look into
  44.  # for files....  These folders are managed in the config menu.  The last,
  45.  # of course is to permit the current file folder to be a look for
  46.  # bibliography folder.  Sometimes you want the third possibility, others
  47.  # the two last, others all of them.
  48.  ##
  49. newPref f useTexPaths {0} Bib
  50. newPref f useModePaths {1} Bib
  51. newPref f useCurrentPath {1} Bib
  52.  
  53. ###########################################################################
  54. # Search patterns for entries and cite-keys
  55. #
  56. #     set bibTopPat {^[     ]*@[a-zA-Z]+[\{\(]([-A-Za-z0-9_:/\.]+)}
  57. # match entry type
  58. set bibTopPat {^[     ]*@([a-zA-Z]+)[\{\(]}
  59. # match cite-key
  60. set bibTopPat1 {^[     ]*@[a-zA-Z]+[\{\(][     ]*([^=,     ]+)}    
  61. # match type and cite-key
  62. set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  63. # match first field (no cite-key)
  64. set bibTopPat3 {^[     ]*@([a-zA-Z]+)[\{\(]([     ]*[a-zA-Z]+[     ]*=[     ]*)}    
  65.  
  66. newPref v wordBreak {[a-zA-Z0-9]+} Bib
  67. newPref v wordBreakPreface {[^a-zA-Z0-9]} Bib
  68. newPref v funcExpr $bibTopPat Bib
  69.  
  70. newPref f overwriteBuffer {1} Bib
  71. newPref f fieldBraces {1} Bib
  72. newPref f entryBraces {1} Bib
  73. newPref f segregateStrings {1} Bib
  74. newPref f markStrings {0} Bib
  75. newPref f alignEquals {0} Bib
  76. newPref f zapEmptyFields {0} Bib
  77. newPref f descendingYears {1} Bib
  78. newPref v indentString {   } Bib
  79. newPref v stdAbbrevs {jan feb mar apr may jun jul aug sep oct nov dec} Bib
  80.  
  81. # ◊◊◊◊ Option-click title bar ◊◊◊◊ #
  82. # use TeX routines for Bib mode
  83. proc Bib::OptionTitlebar {} {TeX::OptionTitlebar}
  84. proc Bib::OptionTitlebarSelect {item} {TeX::OptionTitlebarSelect $item}
  85.  
  86. ###########################################################################
  87. # BibTeX Key Bindings.
  88. ###########################################################################
  89. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  90. #
  91. Bind 'b' <sz>    selectEntry "Bib"
  92. Bind 'n' <sz>    nextEntry "Bib"
  93. Bind 'p' <sz>    prevEntry "Bib"
  94.  
  95. Bind 'f' <sz>    searchFields "Bib"
  96. Bind 'm' <sz>    searchEntries "Bib"
  97. Bind 'l' <sz>    formatEntry "Bib"
  98.  
  99. ###########################################################################
  100. # Data Definitions
  101. ###########################################################################
  102. ###########################################################################
  103. # Define the data arrays that contain the names of the required,
  104. # optional, and preferred fields for each entry type.
  105. #
  106. # The index names of the rqdFld() array _define_ the valid entry types
  107. # recognized by the program.
  108. #
  109. set rqdFld(article) {author title journal year} 
  110. set optFld(article) {volume number pages month note}
  111. # example of how to assign your own preferences to some items
  112. #set myFld(article) {author title journal volume pages year note} 
  113.  
  114. set rqdFld(book) {author title publisher year} 
  115. set optFld(book) {editor volume number series address edition month note}
  116.  
  117. set rqdFld(booklet) {title} 
  118. set optFld(booklet) {author howpublished address month year note}
  119.  
  120. set rqdFld(conference) {author title booktitle year} 
  121. set optFld(conference) {editor volume number series pages organization publisher address month note}
  122.  
  123. set rqdFld(inBook) {author title chapter publisher year} 
  124. set optFld(inBook) {editor pages volume number series address edition month type note}
  125.  
  126. set rqdFld(inCollection) {author title booktitle publisher year} 
  127. set optFld(inCollection) {editor volume number series type chapter pages address edition month note}
  128.  
  129. set rqdFld(inProceedings) {author title booktitle year} 
  130. set optFld(inProceedings) {editor volume number series pages organization publisher address month note}
  131.  
  132. set rqdFld(manual) {title} 
  133. set optFld(manual) {author organization address edition year month note}
  134.  
  135. set rqdFld(mastersThesis) {author title school year} 
  136. set optFld(mastersThesis) {address month note type}
  137.  
  138. set rqdFld(misc) {} 
  139. set optFld(misc) {author title howpublished year month note}
  140.  
  141. set rqdFld(phdThesis) {author title school year} 
  142. set optFld(phdThesis) {address month type note}
  143.  
  144. set rqdFld(proceedings) {title year} 
  145. set optFld(proceedings) {editor volume number series publisher organization address month note}
  146.  
  147. set rqdFld(techReport) {author title institution year} 
  148. set optFld(techReport) {type number address month note}
  149.  
  150. set rqdFld(unpublished) {author title note} 
  151. set optFld(unpublished) {year month}
  152.  
  153. set entryNames [lsort [array names rqdFld]]
  154. set customEntries [lsort [array names myFld]]
  155.  
  156. ###########################################################################
  157. # Define an array of flags indicating whether the data a given field
  158. # type should be quoted.  The actual characters used to quote the field are
  159. # given by $bibOpenQuote and $bibCloseQuote, which are set by the routine
  160. # 'bibFieldDelims' according to the flag $fieldBraces.
  161. #
  162. # Note that the index names of the useBrace() array _define_ the valid 
  163. # field types recognized by the program.
  164. #
  165. array set useBrace {
  166.     address 1 annote 1 author 1 booktitle 1 chapter 0 crossref 1 edition 1 
  167.     editor 1 howpublished 1 institution 1 journal 1 key 1 language 1 month 
  168.     1 note 1 number 0 organization 1 pages 1 publisher 1 school 1 series 1 
  169.     title 1 type 1 volume 0 year 0 isbn 1 customField 1 city 1
  170. }
  171.  
  172. set fieldNames [lsort [array names useBrace]]
  173. ###########################################################################
  174. # Default values for newly created fields
  175. #
  176. set defFldVal(language) "german"
  177.  
  178. set fieldDefs [lsort [array names defFldVal]]
  179.  
  180. ###########################################################################
  181. # BibTeX-mode mode definition
  182. ###########################################################################
  183.  
  184. set bibtexKeyWords $fieldNames
  185. regModeKeywords -e {%} -m {@} -c red -k blue Bib $bibtexKeyWords
  186. unset bibtexKeyWords
  187.  
  188. ###########################################################################
  189. # BibTeX Menu Definition.
  190. ###########################################################################
  191. proc bibtexMenu {} {}
  192.  
  193. proc bibtex {} {
  194.     global bibtexSig
  195.     set name [app::launchAnyOfThese {BIBt Vbib CMTu} bibtexSig]
  196.     switchTo [file tail $name]
  197. }
  198.  
  199. menu::buildProc bibtexMenu Bib::buildBibMenu
  200.  
  201. proc Bib::buildBibMenu {} {
  202.     global bibtexMenu
  203.     return [list "build" \
  204.       [list "/-<U<Obibtex" "(-)" \
  205.       [list Menu -n Entries -p makeEntry {}] \
  206.       [list Menu -n Fields -p makeField {}] \
  207.       "(-)" \
  208.       "/B<U<BselectEntry" "/N<U<BnextEntry" "/P<U<BprevEntry" \
  209.       "/L<U<BformatEntry" "/C<U<BcopyCiteKey" \
  210.       "(-)" \
  211.       "/M<U<BsearchEntries" "/F<U<BsearchFields" \
  212.       {Menu -n sortBy... -p bibSortProc {
  213.     "citeKey"
  214.     "firstAuthor,Year"
  215.     "lastAuthor,Year"
  216.     "year,FirstAuthor"
  217.     "year,LastAuthor"}
  218.     } \
  219.       {Menu -n sortMarks... -p markSortProc {
  220.     "alphabetically"
  221.     "byPosition"}
  222.     } \
  223.       "(-)" \
  224.       "countEntries" "formatAllEntries" \
  225.       "/Q<IquickFindCitation" \
  226.       "/A<U<BaddWinToDatabase" \
  227.       "/I<U<IindexOfThisWindow" \
  228.       "(-)" \
  229.       "rebuildIndex" \
  230.       "rebuildDatabase"] \
  231.       Bib::menuProc \
  232.       [list Entries Fields] \
  233.       $bibtexMenu]
  234. }
  235.  
  236. proc Bib::menuProc {menu item} {
  237.     menu::generalProc Bib $item 0
  238. }
  239.  
  240. proc Bib::quickFindCitation {} {
  241.     Bib::GotoEntry [prompt::statusLineComplete "Citation" Bib::completionsForEntry \
  242.       -preeval {source [file join $PREFS bibIndex]} -posteval {unset bibIndex}]
  243. }
  244.  
  245. proc Bib::completionsForEntry {pref} {
  246.     Bib::_FindAllEntries $pref 0
  247. }
  248. set menu::items(Entries) [concat $entryNames "(-)" "customEntry"]
  249. set menu::proc(Entries) makeEntry
  250. set menu::items(Fields) [concat $fieldNames "(-)" "customField" "multipleFields"]
  251. set menu::proc(Fields) makeField
  252.  
  253. menu::buildSome bibtexMenu
  254.  
  255. ## 
  256.  # -------------------------------------------------------------------------
  257.  #   
  258.  # "Bib::openFile" --
  259.  #  
  260.  #  Given a filename, and the directory of the base '.aux' file, try and
  261.  #  find the file.  If we don't succeed, pass the request onto the TeX
  262.  #  code.
  263.  # -------------------------------------------------------------------------
  264.  ##
  265. proc Bib::openFile {filename {dir ""}} {
  266.     # look where base file was
  267.     if {![catch {file::openQuietly [file join ${dir} ${filename}]}]} {
  268.     return
  269.     }
  270.     # look in bibtex inputs folder
  271.     global bibtexSig
  272.     if {![catch {file::openQuietly [file join [file dirname [nameFromAppl $bibtexSig]] "BibTeX inputs" ${filename}]}]} {
  273.     return
  274.     } 
  275.     # look in all usual tex places
  276.     openTeXFile "$filename"
  277.     return
  278. }
  279.  
  280. ## 
  281.  # -------------------------------------------------------------------------
  282.  #   
  283.  # "Bib::noEntryExists" --
  284.  #  
  285.  #  No entry exists in the known .bib files.  Either add an entry, possibly
  286.  #  in a new bibliography file, or add a .bib file to those currently
  287.  #  searched.
  288.  # -------------------------------------------------------------------------
  289.  ##
  290. proc Bib::noEntryExists {item {basefile ""}} {
  291.     set basefile [Bib::getBasefile $basefile]
  292.     set choice [dialog::optionMenu \
  293.       "No entry '$item' exists.  What do you want to do?" \
  294.       [list "New entry" "New entry in new bibliography file" \
  295.       "Add .bib file to \\bibliography\{…\}" \
  296.       "Change original citation" \
  297.       "Search all bibliographies" ]]
  298.     switch -- $choice {
  299.     "New entry" {
  300.         Bib::_newEntry $item
  301.     }
  302.     "New entry in new bibliography file" {
  303.         Bib::_newEntry $item 1
  304.     }
  305.     "Add .bib file to \\bibliography\{…\}" {
  306.         Bib::insertNewBibliography $basefile    
  307.     }
  308.     "Search all bibliographies" {
  309.         alertnote "Not yet implemented"
  310.     }
  311.     "Change original citation" {
  312.         Bib::changeOriginalCitation $item $basefile
  313.     }
  314.     "Cancel" {
  315.         # nothing
  316.     }
  317.     }               
  318. }
  319.  
  320. proc Bib::_newEntry {item {new_file 0}} {
  321.     if {$new_file} {
  322.     set bibfile [putfile "Save new bibliography as…" ".bib"]
  323.     if {$bibfile == ""} {
  324.         error "No bibliography file selected."
  325.     } else {
  326.         new -n $bibfile
  327.     }        
  328.     } else {
  329.     # need to pick a .bib file
  330.     set bibfile [Bib::pickBibliography 1 \
  331.       "Select a bibliography file to which to add an entry"]
  332.     openTeXFile $bibfile
  333.     }
  334.     global entryNames
  335.     bibFormatSetup
  336.     newEntry [listpick -p "Which type of entry?" $entryNames]
  337.     insertText $item
  338.     ring::+
  339.     
  340. }
  341.  
  342. proc Bib::changeOriginalCitation {citation {basefile ""}} {
  343.     if {$basefile == ""} {set basefile [TeX_currentBaseFile]}
  344.     # find .aux and open base .tex/.ltx
  345.     if {[set proj [isWindowInFileset $basefile "tex"]] != ""} {
  346.     set files [texListFilesInFileSet $proj]
  347.     } else {
  348.     set files $basefile
  349.     }
  350.     set got "[eval grep [list $citation] $files]\r"
  351.     if {[string first "; Line " $got] == [string last "; Line " $got]} {
  352.     # just one match
  353.     if ![regexp {∞([^\r\n]*)[\r\n]} $got dmy filename] {
  354.         alertnote "I couldn't find the original.  You probably have a\
  355.           multi-part document which you haven't made into a TeX fileset.\
  356.           Unless it's a fileset, I can't find the other files."
  357.         return
  358.     }
  359.     file::openQuietly $filename
  360.     eval select [searchInFile $filename $citation 1]
  361.     message "This is the original citation.  Change it, then re-run LaTeX and BibTeX."
  362.     } else {
  363.     grepsToWindow "* List of citations *" $got
  364.     }
  365. }
  366.  
  367. proc Bib::getBasefile {{basefile ""}} {
  368.     if {$basefile == ""} {return [TeX_currentBaseFile]}
  369.     # find .aux and open base .tex/.ltx
  370.     set base [file root $basefile]
  371.     if [file exists ${base}.tex] {
  372.     return ${base}.tex
  373.     } elseif [file exists ${base}.ltx] {
  374.     return ${base}.ltx
  375.     } else {
  376.     alertnote "Base file with name '${base}.tex/ltx' not found." 
  377.     error ""
  378.     }                                   
  379. }
  380.  
  381. proc Bib::insertNewBibliography {{basefile ""} {bibfile ""}} {
  382.     set basefile [Bib::getBasefile $basefile]
  383.     file::openQuietly ${basefile}
  384.     
  385.     # find bibliography, position cursor and add
  386.     pushPosition
  387.     endOfBuffer
  388.     if {[catch {set pos [search -s -f 0 -r 0 -m 0 "\\bibliography\{" [getPos]]}]} {
  389.     # add the environment
  390.     set pos [search -s -f 0 "\\end\{document\}" [getPos]]
  391.     goto [pos::math [minPos] + [lindex $pos 0]]
  392.     set preinsert "\\bibliography\{"
  393.     set postinsert "\}\r\r"
  394.     } else {
  395.     set preinsert ""
  396.     set postinsert ","
  397.     goto [pos::math [minPos] + [lindex $pos 1]]
  398.     }
  399.     if {$bibfile == ""} {
  400.     set bibfile [Bib::pickBibliography 0 \
  401.       "Select a bibliography file to add"]
  402.     }
  403.     insertText "${preinsert}[lindex [split $bibfile "."] 0]${postinsert}"
  404.     message "press <Ctrl .> to return to original cursor position"
  405. }
  406.  
  407. # Used by Bib::pickBibliography to set a default in the listpick dialog
  408. # It's useful because you will often want to add a bunch of new items
  409. # in a row to the same bibliography.
  410. # NOTE: this is set by my code, not you.
  411. set Bib::_defaultBib ""
  412.  
  413. ## 
  414.  # -------------------------------------------------------------------------
  415.  #     
  416.  # "Bib::pickBibliography" --
  417.  #    
  418.  #  Put up a list-dialog so the user can select a bibliography file for
  419.  #  some action (taken by the caller).  Can also create a new file if
  420.  #  desired. 
  421.  # -------------------------------------------------------------------------
  422.  ##
  423. proc Bib::pickBibliography {{allowNew 1} {prompt "Pick a bibliography file"}} {
  424.     set biblist [Bib::ListAllBibliographies]
  425.     if {$allowNew} {
  426.     lappend biblist {New file…}
  427.     }
  428.     global Bib::_defaultBib
  429.     set bibfile [listpick -p $prompt -L ${Bib::_defaultBib} $biblist]
  430.     if {$bibfile == ""} {
  431.     error "No bibliography file selected."
  432.     } elseif {$bibfile == "New file…" } {
  433.     set bibfile [putfile "Save new bibliography as…" ".bib"]
  434.     if {$bibfile == ""} {
  435.         error "No bibliography file selected."
  436.     } else {
  437.         set fout [open $bibfile w]
  438.         close $fout
  439.     }        
  440.     }
  441.     return [file tail [set Bib::_defaultBib $bibfile]]
  442. }
  443.  
  444. ## 
  445.  # -------------------------------------------------------------------------
  446.  #     
  447.  # "Bib::ListAllBibliographies" --
  448.  #    
  449.  #  Return all bibliographies on the search path.  Optionally only return
  450.  #  those which are in a given .aux file. 
  451.  # -------------------------------------------------------------------------
  452.  ##
  453. proc Bib::ListAllBibliographies { {auxfile ""} } {
  454.     #
  455.     # with the pref vars I have eliminate all the TeX Paths scanning.
  456.     # Furthermore, I can add the bibliography in the same directory as the
  457.     # original LaTeX doc, and any bibliography in the modeSearchPath.
  458.     # 
  459.     global BibmodeVars
  460.     set   biblist {}
  461.     if {$BibmodeVars(useTexPaths)} {
  462.     set biblist [concat $biblist [Bib::ListTexPathBibs auxfile]]]
  463.     }
  464.     if {$BibmodeVars(useModePaths)} {
  465.     set biblist [concat $biblist [Bib::ListModePathBibs]]
  466.     }
  467.     if {$BibmodeVars(useCurrentPath)} {
  468.     set biblist [concat $biblist [Bib::ListCurrentPathBibs]]
  469.     }
  470.     return [lunique $biblist]
  471. }    
  472.  
  473. proc Bib::ListCurrentPathBibs {} {
  474.     global mode
  475.     set biblist {}
  476.     if {$mode == "TeX" || $mode   == "Bib"} {
  477.     # we should add the current window's path to the search path
  478.     eval lappend biblist \
  479.       [glob -nocomplain [file join [file dirname [win::Current]] *.bib]]
  480.     }
  481.     return $biblist
  482. }
  483.  
  484.  
  485. proc Bib::ListModePathBibs {} {
  486.     set biblist {}
  487.     foreach d [mode::getSearchPath] {
  488.     eval lappend biblist [glob -nocomplain [file join ${d} *.bib]]
  489.     }
  490.     return $biblist
  491. }
  492.  
  493. proc Bib::ListTexPathBibs { {auxfile ""} } {
  494.     TeXEnsureSearchPathSet
  495.     global AllTeXSearchPaths
  496.     set  biblist {}
  497.     if {$auxfile == "" || [catch {set fid [open  "$auxfile" r]}]} {
  498.     foreach d $AllTeXSearchPaths {
  499.         eval lappend biblist [glob -nocomplain [file join ${d} *.bib]]
  500.     }
  501.     } else {
  502.     set  bibs {}
  503.     # get list of bibs from .aux file
  504.     set  cid  [scancontext create]
  505.     scanmatch $cid {bibdata\{([^\}]*)\}} {
  506.         eval lappend bibs [split $matchInfo(submatch0) ","]
  507.     }
  508.     scanfile $cid $fid
  509.     close $fid
  510.     scancontext  delete $cid
  511.     # find the full paths
  512.     foreach b $bibs {
  513.         foreach d $AllTeXSearchPaths {
  514.         if [file exists [file join ${d} ${b}.bib]] {
  515.             lappend biblist [file join ${d} ${b}.bib]
  516.             break
  517.         }
  518.         }      
  519.     }
  520.     }
  521.     return $biblist
  522. }
  523.  
  524.  
  525. ## 
  526.  # -------------------------------------------------------------------------
  527.  #     
  528.  # "Bib::GotoEntry" --
  529.  #    
  530.  #  Look for a bib entry in the given list of files, or if that fails or
  531.  #  isn't given, look in all available bib files on the search path. 
  532.  # -------------------------------------------------------------------------
  533.  ##
  534. proc Bib::GotoEntry {entry {biblist {}}} {
  535.     if ![catch {Bib::gotoEntryFromIndex $entry}] {
  536.     return
  537.     }
  538.     if {[llength $biblist] && ![catch {Bib::_GotoEntry $entry $biblist 0}]} {
  539.     return
  540.     }
  541.     if ![catch {Bib::_GotoEntry $entry [Bib::ListAllBibliographies]}] {
  542.     return
  543.     }
  544.     beep
  545.     error "Can't find entry '$entry' in the .bib file(s)"
  546. }
  547.  
  548. ## 
  549.  # -------------------------------------------------------------------------
  550.  #     
  551.  # "Bib::gotoEntryFromIndex"    --
  552.  #    
  553.  #    Look in    the    bibIndex and find an entry very    quickly.
  554.  # -------------------------------------------------------------------------
  555.  ##
  556. proc Bib::gotoEntryFromIndex {entry} {
  557.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  558.     global PREFS
  559.     # if it fails, but we succeed later, we will have the opportunity
  560.     # to rebuild the bibIndex
  561.     if [file exists [file join ${PREFS} bibIndex]] {
  562.     source [file join ${PREFS} bibIndex]
  563.     foreach f [array names bibIndex] {
  564.         if [regexp "\[ \r\n\]$entry\[ \r\n\]" "$bibIndex($f)"] {
  565.         file::openQuietly $f
  566.         set p [search -s -f 1 -r 1 $bibTopPat$entry [minPos]]
  567.         eval select $p
  568.         refresh
  569.         eval select $p
  570.         unset bibIndex
  571.         return
  572.         }
  573.     }
  574.     unset bibIndex
  575.     }
  576.     error "Entry '$entry' not found in bibIndex"
  577. }
  578.  
  579. ## 
  580.  # -------------------------------------------------------------------------
  581.  #     
  582.  # "Bib::_FindAllEntries"    --
  583.  #    
  584.  #    Find all entries with a    given prefix, optionally attaching the titles
  585.  #    of the entries (this requires a    bibDatabase    file to    be setup).    Used
  586.  #    by TeX citation    completions: \cite{Darley<cmd-Tab>
  587.  # -------------------------------------------------------------------------
  588.  ##
  589. proc Bib::_FindAllEntries {eprefix {withtitles 1}} {
  590.     global PREFS 
  591.     set matches {}
  592.     if {$withtitles} {
  593.     if {![file exists [file join ${PREFS} bibDatabase]]} {
  594.         if {[askyesno "No bibDatabase exists, shall I make one?"]=="yes"} {
  595.         Bib::rebuildDatabase
  596.         } else {
  597.         error "No bib database exists"
  598.         }
  599.     }
  600.     set cid [scancontext create]
  601.     scanmatch $cid "^${eprefix}" {
  602.         lappend matches $matchInfo(line)
  603.     }
  604.     set fid [open [file join ${PREFS} bibDatabase] r]
  605.     scanfile $cid $fid
  606.     close $fid
  607.     scancontext delete $cid    
  608.     } else {
  609.     if ![file exists [file join ${PREFS} bibIndex]] {
  610.         if {[askyesno "No bibIndex exists, shall I make one?"]=="yes"} {
  611.         Bib::rebuildIndex
  612.         } else {
  613.         error "No bib index exists"
  614.         }
  615.     }
  616.     global bibIndex
  617.     if {![array exists bibIndex]} {
  618.         source [file join ${PREFS} bibIndex]
  619.         set unset 1
  620.     }
  621.     foreach f [array names bibIndex] {
  622.         eval lappend matches [completion::fromList $eprefix "bibIndex(${f})"]
  623.     }
  624.     if {[info exists unset]} {unset bibIndex}
  625.     }
  626.     return $matches    
  627. }
  628.  
  629. ## 
  630.  # -------------------------------------------------------------------------
  631.  #     
  632.  # "Bib::_GotoEntry" --
  633.  #    
  634.  #    Find a bib entry in    one    of the given list of files,    and    signal an
  635.  #    error if the entry isn't found.     I think this is the quickest way.
  636.  # -------------------------------------------------------------------------
  637.  ##
  638. proc Bib::_GotoEntry {entry biblist {rebuild 1}} {
  639.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  640.     set cid [scancontext create]
  641.     scanmatch $cid $bibTopPat$entry {
  642.     set found $matchInfo(offset)
  643.     }
  644.     set found ""
  645.     foreach f $biblist {
  646.     message "Searching [file tail $f]…"
  647.     if {![catch {set fid [open $f]}]} {
  648.         scanfile $cid $fid
  649.         close $fid
  650.         if {$found != ""} {
  651.         file::openQuietly $f
  652.         set found [pos::math [minPos] + $found]
  653.         goto $found
  654.         refresh
  655.         select $found [nextLineStart $found]
  656.         scancontext delete $cid
  657.         global BibmodeVars
  658.         # make the index since it was obviously out of date                
  659.         if {$rebuild == 1 && ($BibmodeVars(bibAutoIndex) == 2 \
  660.           || [dialog::yesno "The bibIndex seems to be out of date.  Rebuild?"])} {
  661.             Bib::rebuildIndex
  662.         }
  663.         return
  664.         }    
  665.     }
  666.     }
  667.     scancontext delete $cid
  668.     error "Entry '$entry' not found."
  669. }
  670.  
  671.  
  672. ## 
  673.  # -------------------------------------------------------------------------
  674.  #     
  675.  # "Bib::rebuildIndex" --
  676.  #    
  677.  #    Build the bibIndex file    which allows for very fast lookup of bib
  678.  #    entries.
  679.  # -------------------------------------------------------------------------
  680.  ##
  681. proc Bib::rebuildIndex {} {
  682.     global PREFS 
  683.     set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  684.     set cid [scancontext create]
  685.     # this will actually mark strings as well
  686.     scanmatch $cid $bibTopPat2 {
  687.     if {![regexp -nocase (preamble|string|comment) $matchInfo(submatch0)]} {
  688.         lappend found $matchInfo(submatch1)
  689.     }
  690.     }
  691.     set bout [open [file join ${PREFS} bibIndex] w]
  692.     puts $bout "# Bibliography index file for quick reference lookup"
  693.     puts $bout "# Created on [mtime [now]]"
  694.     set bibs [lsort [Bib::ListAllBibliographies]]
  695.     set bibl [llength $bibs]
  696.     foreach f $bibs {
  697.     set found {}
  698.     puts $bout "set \"bibIndex($f)\" \{"
  699.     message "Indexing ([incr bibl -1] left) [file tail $f]É"
  700.     if {![catch {set fid [open $f]}]} {
  701.         scanfile $cid $fid
  702.         close $fid
  703.     }
  704.     # we sort so we can search it efficiently for all entries with
  705.     # a given prefix.
  706.     puts $bout " [lsort $found] "
  707.     puts $bout "\}"
  708.     }
  709.     close $bout
  710.     scancontext delete $cid
  711.     message "bibIndex creation complete"
  712. }
  713.  
  714. ## 
  715.  # -------------------------------------------------------------------------
  716.  #     
  717.  # "Bib::rebuildDatabase" --
  718.  #    
  719.  #    Build the bibDatabase which    allows speedy completion of    citations and
  720.  #    contains titles, so    that you can pick the correct completion easily.
  721.  # -------------------------------------------------------------------------
  722.  ##
  723. proc Bib::rebuildDatabase {} {
  724.     global PREFS
  725.     set bdatout [open [file join ${PREFS} bibDatabase] w]
  726.     puts $bdatout "# Bibliography database file for quick reference lookup"
  727.     puts $bdatout "# Created on [mtime [now]]"
  728.     # if it fails, but we succeed later, we will have the opportunity
  729.     # to rebuild the bibIndex
  730.     set bibs [lsort -ignore [Bib::ListAllBibliographies]]
  731.     set bibl [llength $bibs]
  732.     foreach f $bibs {
  733.     file::openQuietly $f
  734.     message "Indexing ([incr bibl -1] left) [file tail $f]…"
  735.     puts $bdatout [Bib::makeDatabaseOf $f]
  736.     killWindow
  737.     }
  738.     close $bdatout
  739. }
  740.  
  741. proc Bib::indexOfThisWindow {{f ""}} {
  742.     if {$f == ""} {
  743.     set f [win::Current]
  744.     }
  745.     file::openQuietly $f
  746.     set ret [Bib::makeDatabaseOf $f]
  747.     new -n "* Index for [file tail $f] *" -m Text
  748.     insertText $ret
  749.     winReadOnly
  750. }
  751.  
  752. proc Bib::addWinToDatabase {{f ""}} {
  753.     if {$f == ""} {
  754.     set f [win::Current]
  755.     }
  756.     global PREFS
  757.     set bdatout [open [file join ${PREFS} bibDatabase] a]
  758.     file::openQuietly $f
  759.     puts $bdatout [Bib::makeDatabaseOf $f]
  760.     close $bdatout
  761. }
  762.  
  763. proc Bib::makeDatabaseOf {f} {
  764.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  765.     message "Indexing ${f}…"
  766.     set p [minPos]
  767.     set ret ""
  768.     while {![catch {search -s -f 1 -r 1 -- $bibTopPat $p} epos]} {
  769.     set p [lindex $epos 0]
  770.     set np [nextLineStart $p]
  771.     set entry [getText $p $np]
  772.     regexp {^@([a-zA-Z]+)([\{\(])[     ]*(.*)} $entry "" type brace entry
  773.     if {[regexp -nocase (preamble|string|comment) $type] \
  774.       || [catch {matchIt $brace [pos::math $p + [expr 3 + [string length $type]]]} end]} {
  775.         set p $np
  776.         continue
  777.     }
  778.     set p $end
  779.     if {![catch {search -s -f 1 -r 1 -l $end -- "title\[ \t\]*=\[ \t\]*" $np} epos]} {
  780.         set entry [string trim $entry "\{\( \t\r,"]
  781.         set epos [lindex $epos 1]
  782.         if {[regexp {[\(\{]} [lookAt $epos] brace] \
  783.           && ![catch {matchIt $brace [pos::math $epos + 1]} end] } {
  784.         set title [getText $epos $end]
  785.         } else {
  786.         set title [getText $epos [nextLineStart $epos]]
  787.         }
  788.         regsub -all "\[\{\}\]+" $title {} title
  789.         regsub -all "\[ \n\r\t\]+" $title { } title
  790.         append ret "$entry \{$title\}\r"
  791.     }
  792.     }   
  793.     return $ret
  794. }
  795.  
  796.  
  797. ###########################################################################
  798. # Menu command procs
  799. ###########################################################################
  800.         
  801. proc makeField {menu item} {
  802.     global fieldNames
  803.     bibFormatSetup
  804.     
  805.     if {$item == "multipleFields"} {
  806.     set flds [listpick -l -L {author year} -p "Pick desired fields:" $fieldNames]
  807.     if {[llength flds]} {
  808.         set lines {}
  809.         foreach fld $flds {
  810.         append lines [newField $fld]
  811.         }
  812.     } else {
  813.         return
  814.     }
  815.     } else {
  816.     set lines [newField $item]
  817.     }
  818.     
  819.     goto [nextLineStart [getPos]]
  820.     elec::Insertion $lines
  821. }
  822.  
  823. proc makeEntry {menu item} {
  824.     bibFormatSetup
  825.     newEntry $item
  826. }
  827.  
  828. ###########################################################################
  829. #  Return the bounds of the bibliographic entry surrounding the current 
  830. #  position.
  831. #
  832. proc getEntry {pos} {
  833.     
  834.     set pos1 [search -f 0 -r 1 -n -s {[     ]*@[a-zA-Z]*[\{\(]} $pos ]
  835.     if {$pos1 == ""} {
  836.         set begPos [nextLineStart $pos]
  837.         set endPos $begPos
  838.     } else {
  839.         set begPos [lineStart [lindex $pos1 0]]
  840.         set pos0 [lindex $pos1 1]
  841.         set openBrace [getText [pos::math $pos0 - 1] $pos0 ]
  842.         if {[catch {matchIt $openBrace $pos0} pos1]} {
  843.         alertnote "There seems to be a badly delimited field in here.  Are entry and field delimiters set correctly?"
  844.         goto $begPos
  845.         error "Can't find close brace"
  846.         } else {
  847.         set endPos [nextLineStart $pos1]
  848.         }
  849.     }
  850.     return [list $begPos $endPos]
  851. }
  852.  
  853. ###########################################################################
  854. #  Advance to the next bibliographic entry.
  855. #
  856. proc nextEntry {} {
  857.     global bibTopPat bibTopPat1 bibTopPat2
  858.     #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  859.     
  860.     set pos0 [lindex [getEntry [getPos]] 1]
  861.     set nextPos [nextLineStart $pos0]
  862.     
  863.     while {![catch {search -f 1 -r 1 -s $bibTopPat $pos0} pos]} {
  864.     regexp $bibTopPat [eval getText $pos] mtch type
  865.     if {$type != "string"} {
  866.         set nextPos [lindex $pos 0]
  867.         break
  868.     } else {
  869.         set pos0 [nextLineStart [lindex $pos 1]]
  870.     }
  871.     }
  872.     goto $nextPos
  873. }
  874.  
  875. ###########################################################################
  876. #  Go back to the previous bibliographic entry.
  877. #
  878. proc prevEntry {} {
  879.     global bibTopPat bibTopPat1 bibTopPat2
  880.     #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  881.     
  882.     set pos0 [lindex [getEntry [getPos]] 0]
  883.     if {[pos::compare $pos0 > [minPos]]} {
  884.     set nextPos $pos0
  885.     set pos0 [pos::math $pos0 - 1]
  886.     while {![catch {search -f 0 -r 1 -s $bibTopPat $pos0} pos]} {
  887.         regexp $bibTopPat [eval getText $pos] mtch type
  888.         if {$type != "string"} {
  889.         set nextPos [lindex $pos 0]
  890.         break
  891.         } else {
  892.         set pos0 [lineStart [lindex $pos 0]]
  893.         if {[pos::compare $pos0 == [minPos]]} {break}
  894.         set pos0 [pos::math $pos0 - 1]
  895.         }
  896.     }
  897.     goto $nextPos
  898.     }
  899. }
  900.  
  901. ###########################################################################
  902. #  Select (highlight) the current bibliographic entry.
  903. #
  904. proc selectEntry {} {
  905.     set pos [getEntry [getPos]]
  906.     select [lindex $pos 0] [lindex $pos 1]
  907. }
  908.  
  909. ###########################################################################
  910. #  Put the cite-key of the current entry on the clipboard.
  911. #
  912. proc copyCiteKey {} {
  913.     global bibTopPat2
  914.     set limits [getEntry [getPos]]
  915.     set top [lindex $limits 0]
  916.     set bottom [lindex $limits 1]
  917.     if {[regexp -indices $bibTopPat2 [getText $top $bottom] allofit type citekey]} {
  918.     select [pos::math $top + [lindex $citekey 0]] [pos::math $top + [expr [lindex $citekey 1] + 1]]
  919.     copy
  920.     message "Copied \"[getSelect]\""
  921.     } 
  922. }
  923.  
  924. ###########################################################################
  925. #  Create a new bibliographic entry with its required fields.
  926. #
  927. proc newEntry {entryName} {    
  928.     global  entryNames customEntries fieldNames rqdFld optFld myFld defFldVal
  929.     global bibOpenEntry bibCloseEntry BibmodeVars
  930.     goto [lindex [getEntry [getPos]] 1]
  931.     if {$entryName == "customEntry"} {
  932.     set lines "@••$bibOpenEntry••,\r"
  933.     set theFields [listpick -l -L {author} -p "Pick desired fields:" $fieldNames]
  934.     } else {
  935.     set lines "@${entryName}$bibOpenEntry••,\r"
  936.     if {[lsearch -exact $customEntries $entryName] >= 0 && [llength $myFld($entryName)]} {
  937.         set theFields $myFld($entryName)
  938.     } elseif {[lsearch -exact $entryNames $entryName] >= 0} {
  939.         set theFields $rqdFld($entryName)
  940.     } else {
  941.         set theFields {}
  942.     }
  943.     }
  944.     set nmlen 0
  945.     foreach field $theFields {
  946.     set len [string length $field]
  947.     if {$len > $nmlen} {set nmlen $len}        
  948.     }
  949.     set theTop [lineStart [getPos]]
  950.     foreach field $theFields {
  951.     catch {append lines [newField $field $nmlen]}
  952.     }
  953.     append lines "$bibCloseEntry\r"
  954.     elec::Insertion $lines
  955. }
  956.  
  957. ###########################################################################
  958. #  Create a new field within the current bibliographic entry
  959. #
  960. proc newField {fieldName {nmlen 0}} {    
  961.     global fieldNames useBrace bibOpenQuote bibCloseQuote bibIndent
  962.     global fieldDefs defFldVal
  963.     set spc "                   "
  964.     if {[lsearch -exact $fieldNames $fieldName] >= 0} {
  965.     set needBraces $useBrace($fieldName)
  966.     } else {
  967.     set needBraces 1
  968.     }
  969.     
  970.     if {[lsearch -exact $fieldDefs $fieldName] >= 0} {
  971.     set val $defFldVal($fieldName)
  972.     } else {
  973.     set val "••"
  974.     }
  975.     
  976.     if {$nmlen} {
  977.     set pad [string range $spc 1 [expr $nmlen - [string length $fieldName]]]
  978.     } else {
  979.     set pad ""
  980.     }            
  981.     if {$needBraces || $fieldName == "customField"} {
  982.     set result "$bibIndent$fieldName =$pad ${bibOpenQuote}${val}${bibCloseQuote},\r"
  983.     } else {
  984.     set result "$bibIndent$fieldName =$pad $val,\r"
  985.     }    
  986.     return $result
  987. }
  988.  
  989. proc bibFormatSetup {} {
  990.     global bibOpenQuote bibCloseQuote bibIndent BibmodeVars
  991.     global bibOpenEntry bibCloseEntry bibAbbrevs
  992.     bibFieldDelims
  993.     bibEntryDelims
  994.     set bibIndent $BibmodeVars(indentString)
  995.     regsub {\\t} $bibIndent {    } bibIndent
  996.     set bibAbbrevs [listStrings]
  997.     foreach abbrev $BibmodeVars(stdAbbrevs) {
  998.     lappend bibAbbrevs [string tolower $abbrev]
  999.     }
  1000. }
  1001.  
  1002. ###########################################################################
  1003. #  Find all entries that match a given regular expression and copy them to 
  1004. #  a new buffer.
  1005. #
  1006. proc searchEntries {} {
  1007.     if [catch {prompt "Regular expression:" ""} reg] return
  1008.     if {![string length $reg]} return
  1009.     set reg ^.*$reg.*$
  1010.     
  1011.     set matches [findEntries $reg]
  1012.     if {[llength $matches] >0} {
  1013.     writeEntries $matches 0
  1014.     } else {
  1015.     message "No matching entries were found"
  1016.     }
  1017. }
  1018.  
  1019. ###########################################################################
  1020. #  Find all entries in which the indicated field matches a given regular 
  1021. #  expression and copy them to a new buffer.  
  1022. #
  1023. proc searchFields {} {
  1024.     global fieldNames
  1025.     if {[catch {eval prompt {{Field name:}} "author" {Fields} $fieldNames} fld]} return
  1026.     if {![string length $fld]} return
  1027.     
  1028.     if {[catch {prompt "Regular expression:" ""} reg]} return
  1029.     if {![string length $reg]} return
  1030.     
  1031.     set matches [findEntries $reg]
  1032.     if {[llength $matches] == 0} {
  1033.     return "No matching entries were found"
  1034.     }
  1035.     
  1036.     set vals {}
  1037.     foreach hit $matches {
  1038.     set pos [lindex $hit 1]
  1039.     set top [lindex $hit 2] 
  1040.     set bottom [lindex $hit 3]
  1041.     while {[set failure [expr {[getFldName $pos $top] != $fld}]]  && 
  1042.     ![catch {search -f 1 -r 1 -i 1 -m 0 -l $bottom -s -- $reg $pos} mtch]} {
  1043.         set pos [lindex $mtch 1]
  1044.     }
  1045.     if {!$failure} { lappend vals [list $top $bottom] }
  1046.     }
  1047.     
  1048.     if {[llength $vals] >0} {
  1049.     writeEntries $vals 0
  1050.     } else {
  1051.     message "No matching entries were found"
  1052.     }
  1053.     
  1054. }
  1055.  
  1056. ###########################################################################
  1057. # Sort all of the entries based on one of various criteria.
  1058. #
  1059. proc bibSortProc {menu item} {
  1060.     if {$item == "citeKey"} {
  1061.     sortByCiteKey
  1062.     } elseif  {$item == "firstAuthor,Year"} {
  1063.     sortByAuthors 0 0
  1064.     } elseif  {$item == "lastAuthor,Year"} {
  1065.     sortByAuthors 1 0
  1066.     } elseif  {$item == "year,FirstAuthor"} {
  1067.     sortByAuthors 0 1
  1068.     } elseif  {$item == "year,LastAuthor"} {
  1069.     sortByAuthors 1 1
  1070.     }
  1071. }
  1072.  
  1073. ###########################################################################
  1074. # Sort the file marks. (These operations are also available under the
  1075. # "Search:NamedMarks" menu)
  1076. #
  1077. proc markSortProc {menu item} {
  1078.     if {$item == "alphabetically"} {
  1079.     sortMarksFile
  1080.     } elseif  {$item == "byPosition"} {
  1081.     orderMarks
  1082.     }
  1083. }
  1084.  
  1085. ###########################################################################
  1086. # Sort all of the entries in the file alphabetically by author.
  1087. #
  1088. proc sortByAuthors {{lastAuthorFirst 0} {yearFirst 0}} {
  1089.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1090.     set bibSegStr $BibmodeVars(segregateStrings)
  1091.     
  1092.     set matches [findEntries $bibTopPat]
  1093.     set crossrefs [listCrossrefs]
  1094.     set strings [listStrings]
  1095.     
  1096.     set vals {}
  1097.     set others {}
  1098.     set refs {}
  1099.     set strs {}
  1100.     
  1101.     set beg [maxPos]
  1102.     set end [minPos]
  1103.     
  1104.     foreach hit $matches {
  1105.     set pos [lindex $hit 1]
  1106.     set top [lindex $hit 2] 
  1107.     set bottom [lindex $hit 3]
  1108.     set entry [getText $top $bottom]
  1109.     regsub -all "\[\n\r\]+" $entry { } entry
  1110.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1111.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1112.     if {[regexp $bibTopPat1 $entry allofit citeKey]} {
  1113.         set citeKey [string tolower $citeKey]
  1114.         set keyExists 1
  1115.     } else {
  1116.         set citekey ""
  1117.         set keyExists 0
  1118.     }
  1119.     
  1120.     if {$keyExists && [lsearch -exact $crossrefs $citeKey] >= 0} {
  1121.         lappend refs [list $pos $top $bottom]
  1122.     } elseif {$bibSegStr && $keyExists && [lsearch -exact $strings $citeKey] >= 0} {
  1123.         lappend strs [list $citeKey $top $bottom]        
  1124.     } else {
  1125.         if {![catch {getFldValue $entry author} fldval]} {
  1126.         if {[catch {getFldValue $entry year} year]} { set year 9999 }
  1127.         lappend vals [list [authSortKey $fldval $lastAuthorFirst $year $yearFirst] $top $bottom]
  1128.         } else {
  1129.         lappend others [list $pos $top $bottom]
  1130.         }
  1131.     }
  1132.     if {[pos::compare $top < $beg]} {set beg $top}
  1133.     if {[pos::compare $bottom > $end]} {set end $bottom}
  1134.     }
  1135.     
  1136.     if {$bibSegStr} {
  1137.     set result [concat $strs $others [lsort $vals] $refs]
  1138.     } else {
  1139.     set result [concat $others [lsort $vals] $refs]
  1140.     }
  1141.     
  1142.     if {[llength $result] >0} {
  1143.     writeEntries $result 1 $beg $end
  1144.     } else {
  1145.     message "No results of author sort !!??"
  1146.     }
  1147. }
  1148.  
  1149. ###########################################################################
  1150. # Return a list of the cite-keys of all cross-referenced entries.
  1151. #
  1152. proc listStrings {} {
  1153.     global bibTopPat bibTopPat1 bibTopPat2
  1154.     set matches [findEntries {^[    ]*@string *[\{\(]} 0]
  1155.     
  1156.     message "scanning for @strings…"
  1157.     foreach hit $matches {
  1158.     set top [lindex $hit 2] 
  1159.     set bottom [lindex $hit 3]
  1160.     set entry [getText $top $bottom]
  1161.     regsub -all "\[\n\r\]+" $entry { } entry
  1162.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1163.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1164.     regexp $bibTopPat1 $entry allofit citekey
  1165.     set citekey [string tolower $citekey]
  1166.     if {[catch {incr strings($citekey)} num]} {
  1167.         set strings($citekey) 1
  1168.     }
  1169.     }
  1170.     if {[catch {lsort [array names strings]} res]} {
  1171.     set res {}
  1172.     }
  1173.     message ""
  1174.     return $res
  1175. }
  1176.  
  1177. ###########################################################################
  1178. # Return a list of the cite-keys of all cross-referenced entries.
  1179. #
  1180. proc listCrossrefs {} {
  1181.     set matches [findEntries {crossref}]
  1182.     catch {unset crossrefs}
  1183.     
  1184.     message "scanning for crossrefs…"
  1185.     foreach hit $matches {
  1186.     set top [lindex $hit 2] 
  1187.     set bottom [lindex $hit 3]
  1188.     set entry [getText $top $bottom]
  1189.     regsub -all "\[\n\r\]+" $entry { } entry
  1190.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1191.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1192.     if {![catch {getFldValue $entry crossref} fldval]} {
  1193.         set fldval [string tolower $fldval]
  1194.         if {[catch {incr crossref($fldval)} num]} {
  1195.         set crossrefs($fldval) 1
  1196.         }
  1197.     }
  1198.     }
  1199.     if {[catch {lsort [array names crossrefs]} res]} {
  1200.     set res {}
  1201.     }
  1202.     message ""
  1203.     return $res
  1204. }
  1205.  
  1206. ###########################################################################
  1207. # Create a sort key from an author list.  When sorting entries by author, 
  1208. # performing the sort using keys should be faster than reparsing the author 
  1209. # lists for every comparison (the old method :-( ).
  1210. #
  1211. proc authSortKey {authList lastAuthorFirst {year {}} {yearFirst 0}} {
  1212.     global BibmodeVars
  1213.     set pat1 {\\.\{([A-Za-z])\}}
  1214.     set pat2 {\{([^\{\}]+) ([^\{\}]+)\}}
  1215.     
  1216.     # Remove enclosing braces, quotes, or whitespace
  1217.     set auths %[string trim $authList {{}"     }]&
  1218.     # Remove TeX codes for accented characters
  1219.     regsub -all -- $pat1 $auths {\1} auths
  1220.     # Concatenate strings enclosed in braces
  1221.     while {[regsub -all $pat2 $auths {{\1\2}} auths]} {}
  1222.     # Remove braces (curly and square)
  1223.     regsub -all {[][\{\}]} $auths {} auths
  1224.     #    regsub -all {,} $auths { ,} auths
  1225.     # Replace 'and's with begin-name/end-name delimiters
  1226.     regsub -all {[     ]and[     ]} $auths { \&% } auths
  1227.     # Put last name first in name fields without commas
  1228.     regsub -all {%([^\&,]+) ([^\&, ]+) *\&} $auths {%\2,\1\&} auths
  1229.     # Remove begin-name delimiters
  1230.     regsub -all {%} $auths {} auths
  1231.     # Remove whitespace surrounding name separators
  1232.     regsub -all {[     ]*\&[     ]*} $auths {\&} auths
  1233.     # Replace whitespace separating words with shrieks 
  1234.     regsub -all {[     ,]+} $auths {!} auths
  1235.     # If desired, move last author to head of sort key
  1236.     if {$lastAuthorFirst} {
  1237.     regsub {(.*)&([^&]+)&?$} $auths {\2\&\1} auths
  1238.     }
  1239.     # If provided, sort by year (descending order) as well
  1240.     regsub {^[^0-9]*([0-9]*).*$} $year {\1} year
  1241.     if {$year != {}} {
  1242.     if {$BibmodeVars(descendingYears)} { catch {set year [expr 9999-$year]} }
  1243.     if {$yearFirst} {
  1244.         set auths "$year&$auths"
  1245.     } else {        
  1246.         regsub {^([^&]+)(&?)} $auths "\\1\\&${year}\\2" auths
  1247.     }
  1248.     }
  1249.     
  1250.     return $auths
  1251. }
  1252.  
  1253. ###########################################################################
  1254. # Sort all of the entries in the file alphabetically by their cite-keys.
  1255. #
  1256. proc sortByCiteKey {} {
  1257.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1258.     set bibSegStr $BibmodeVars(segregateStrings)
  1259.     
  1260.     set matches [findEntries $bibTopPat]
  1261.     set crossrefs [listCrossrefs]
  1262.     set strings [listStrings]
  1263.     
  1264.     set begEntries [maxPos]
  1265.     set endEntries [minPos]
  1266.     
  1267.     set strs {}
  1268.     set vals {}
  1269.     set refs {}
  1270.     
  1271.     foreach hit $matches {
  1272.     set beg [lindex $hit 0]
  1273.     set end [lindex $hit 1]
  1274.     set top [lindex $hit 2] 
  1275.     set bottom [lindex $hit 3]
  1276.     if {[regexp $bibTopPat1 [getText $top $bottom] allofit citekey]} {
  1277.         set citekey [string tolower $citekey]
  1278.         set keyExists 1
  1279.     } else {
  1280.         set citekey "000000$beg"
  1281.         set keyExists 0
  1282.     }
  1283.     
  1284.     if {$keyExists && [lsearch -exact $crossrefs $citekey] >= 0} {
  1285.         lappend refs [list $top $top $bottom]
  1286.     } elseif {$keyExists && $bibSegStr && [lsearch -exact $strings $citekey] >= 0} {
  1287.         lappend strs [list $citekey $top $bottom]        
  1288.     } else {
  1289.         lappend vals [list $citekey $top $bottom]
  1290.     }
  1291.     
  1292.     if {[pos::compare $top < $begEntries]} {set begEntries $top}
  1293.     if {[pos::compare $bottom > $endEntries]} {set endEntries $bottom}
  1294.     }
  1295.     
  1296.     if {$bibSegStr} {
  1297.     set result [concat $strs [lsort $vals] $refs]
  1298.     } else {
  1299.     set result [concat [lsort $vals] $refs]
  1300.     }
  1301.     
  1302.     if {[llength $result] >0} {
  1303.     writeEntries $result 1 $begEntries $endEntries
  1304.     } else {
  1305.     message "No results of cite-key sort !!??"
  1306.     }
  1307. }
  1308.  
  1309. ###########################################################################
  1310. # Search for all entries matching a given regular expression.  The results
  1311. # are returned in a list, each element of which is a list of four integers:
  1312. # the beginning and end of the matching entry and the beginning and end of
  1313. # the matching string.  Adapted from "matchingLines" in "misc.tcl".
  1314. #
  1315. proc findEntries {reg {casesen 1}} {
  1316.     if {![string length $reg]} return
  1317.     
  1318.     set pos [minPos]   
  1319.     set result {}                             
  1320.     while {![catch {search -f 1 -r 1 -m 0 -i $casesen -s $reg $pos} mtch]} {
  1321.     set entry [getEntry [lindex $mtch 0]]
  1322.     lappend result [concat $mtch $entry]
  1323.     set pos [lindex $entry 1]
  1324.     }
  1325.     return $result
  1326. }
  1327.  
  1328. ###########################################################################
  1329. #  Return a list containing the data for the current entry, indexed by
  1330. #  the parameter names, e.g., "author", "year", etc.  Index names for the 
  1331. #  entry type and cite-key are "type" and "citekey". 
  1332. #
  1333. proc getFields {pos} {
  1334.     global bibTopPat bibTopPat1 bibTopPat2 bibTopPat3
  1335.     set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}
  1336.     
  1337.     set limits [getEntry $pos]
  1338.     set top [lindex $limits 0]
  1339.     set bottom [lindex $limits 1]
  1340.     
  1341.     set entry [getText $top $bottom]
  1342.     regsub -all "\[\n\r\]+" $entry { } entry
  1343.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1344.     #
  1345.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1346.     
  1347.     if {[regexp -indices $bibTopPat2 $entry mtch theType theKey ]} {
  1348.     set key [string range $entry [lindex $theKey 0] [lindex $theKey 1]]
  1349.     set theRest [expr 1 + [lindex $mtch 1]]
  1350.     } elseif {[regexp -indices $bibTopPat3 $entry mtch theType aField]} {
  1351.     set key {}
  1352.     set theRest [lindex $aField 0]
  1353.     } else {
  1354.     error "Invalid entry"
  1355.     }
  1356.     lappend names type
  1357.     set type [string tolower [string range $entry [lindex $theType 0] [lindex $theType 1]]]
  1358.     lappend data [list $type]
  1359.     
  1360.     lappend names citekey
  1361.     lappend data $key
  1362.     
  1363.     set entry ",[string range $entry $theRest end]"
  1364.     set fldPat {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1365.     set name {}
  1366.     while {[regexp -indices $fldPat $entry mtch sub1]} {
  1367.     set nextName [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
  1368.     lappend names [string tolower $nextName]
  1369.     if {$name != ""} { 
  1370.         set prevData [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1371.         lappend data [breakIntoLines [bibFieldData $prevData]]
  1372.     }    
  1373.     set name $nextName
  1374.     set entry [string range $entry [expr [lindex $mtch 1]+1] end]
  1375.     }
  1376.     
  1377.     lappend data [breakIntoLines [bibFieldData $entry]]
  1378.     
  1379.     return [list $names $data]
  1380. }
  1381.  
  1382. proc bibFieldData {text} {
  1383.     set text [string trim $text {     ,#}]
  1384.     set text1 [string trim $text {\{\}\"     }]            
  1385.     
  1386.     if {[string match {*[\{\}\"]*} $text1]} {
  1387.     set words [parseWords $text]
  1388.     if {[llength $words]==1} {
  1389.         regsub {^[\{\"\']} $text {} text
  1390.         regsub {[\}\"\']$} $text {} text
  1391.     }
  1392.     } else {
  1393.     set text $text1            
  1394.     }
  1395.     return $text
  1396. }
  1397.  
  1398.  
  1399. ###########################################################################
  1400. # Extract the data from the indicated field of an entry, which is passed 
  1401. # as a single string.  This version tries to be completely general, 
  1402. # allowing nested braces within data fields and ignoring escaped 
  1403. # delimiters.  (derived from proc getField).
  1404. #
  1405. proc getFldValue {entry fldname} {
  1406.     set fldPat "\[     \]*${fldname}\[     \]*=\[     \]*"
  1407.     set fldPat2 {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1408.     set slash "\\"
  1409.     set qslash "\\\\"
  1410.     
  1411.     set ok [regexp -indices -nocase $fldPat $entry mtch]
  1412.     if {$ok} {
  1413.     set pos [expr [lindex $mtch 1] + 1]
  1414.     set entry [string range $entry $pos end]
  1415.     
  1416.     if {[regexp -indices $fldPat2 $entry mtch sub1]} {
  1417.         set entry [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1418.     } 
  1419.     set fld [bibFieldData $entry]
  1420.     
  1421.     return $fld
  1422.     
  1423.     } else {
  1424.     error "field not found"
  1425.     }
  1426. }
  1427.  
  1428. ###########################################################################
  1429. # Parse the entry around position "pos" and rewrite it to the original 
  1430. # buffer in a canonical format
  1431. #
  1432. proc formatEntry {} {
  1433.     global useBrace bibOpenQuote bibCloseQuote 
  1434.     global bibOpenEntry bibCloseEntry bibIndent
  1435.     set spc "                           "
  1436.     
  1437.     bibFormatSetup
  1438.     
  1439.     set pos [getPos]
  1440.     set limits [getEntry $pos]
  1441.     set top [lindex $limits 0]
  1442.     set bottom [lindex $limits 1]
  1443.     
  1444.     if {![catch {bibFormatEntry $pos} result]} {
  1445.     if {$result != [getText $top $bottom]} {
  1446.         replaceText $top $bottom $result
  1447.     } else {
  1448.         goto $bottom
  1449.     }
  1450.     goto [lindex [search -s -f 1 -r 1 "\[^ \t\r\n\]" [getPos]] 0]
  1451.     } else {
  1452.     message "Couldn't format this entry for some reason"
  1453.     }
  1454. }
  1455.  
  1456. ###########################################################################
  1457. # Parse the entry around position "pos" and rewrite it to the original 
  1458. # buffer in a canonical format
  1459. #
  1460. proc formatAllEntries {} {
  1461.     global useBrace bibOpenQuote bibCloseQuote 
  1462.     global bibOpenEntry bibCloseEntry bibIndent
  1463.     set spc "                           "
  1464.     
  1465.     bibFormatSetup
  1466.     
  1467.     # This little dance handles the case that the first 
  1468.     # entry starts on the first line
  1469.     #
  1470.     set hit [getEntry [getPos]]
  1471.     if {[pos::compare [lindex $hit 0] == [lindex $hit 1]]} {
  1472.     nextEntry
  1473.     set hit [getEntry [getPos]]
  1474.     }
  1475.     
  1476.     while {[pos::compare [getPos] < [lindex $hit 1]]} {
  1477.     set top [lindex $hit 0] 
  1478.     set bottom [lindex $hit 1]
  1479.     
  1480.     if {![catch {bibFormatEntry $top} result]} {
  1481.         set oldEntry [getText $top $bottom]
  1482.         if {$result != $oldEntry} {
  1483.         deleteText $top $bottom 
  1484.         insertText $result
  1485.         } 
  1486.     }
  1487.     goto $top
  1488.     nextEntry
  1489.     set hit [getEntry [getPos]]
  1490.     }
  1491. }
  1492.  
  1493. ###########################################################################
  1494. # Parse the entry around position "pos" and rewrite it in a canonical format.
  1495. # The formatted entry is returned.
  1496. #
  1497. proc bibFormatEntry {pos} {
  1498.     global useBrace bibOpenQuote bibCloseQuote 
  1499.     global bibOpenEntry bibCloseEntry bibIndent
  1500.     global rqdFld optFld BibmodeVars bibAbbrevs
  1501.     set spc "                           "
  1502.     #    
  1503.     #    note: calling proc must call "bibFormatSetup" before calling "bibFormatEntry"
  1504.     #
  1505.     set limits [getEntry $pos]
  1506.     set top [lindex $limits 0]
  1507.     set bottom [lindex $limits 1]
  1508.     
  1509.     if {[catch {getFields $pos} flds]} {
  1510.     error "bibFormatEntry: Getflds couldn't find any"
  1511.     }
  1512.     
  1513.     set names [lindex $flds 0]
  1514.     set vals [lindex $flds 1]
  1515.     set nfld [llength $names]
  1516.     
  1517.     set type [string tolower [lindex $vals 0]]
  1518.     set citekey [lindex $vals 1]
  1519.     #     message "$citekey"
  1520.     # Don't process @string entries
  1521.     if {$type == "string"} {
  1522.     set lines [getText $top $bottom]
  1523.     return $lines
  1524.     }
  1525.     # Find length of longest field name
  1526.     set nmlen 0
  1527.     foreach nm $names {
  1528.     set len [string length $nm]
  1529.     if {$len > $nmlen} { set nmlen $len }
  1530.     if {![info exists useBrace($nm)]} { set useBrace($nm) 0 }
  1531.     }
  1532.     
  1533.     # Format first line
  1534.     set lines "@${type}${bibOpenEntry}${citekey},\r"
  1535.     
  1536.     # Format each field on a separate line
  1537.     for {set ifld 2} {$ifld < $nfld} {incr ifld} { 
  1538.     set nm [lindex $names $ifld]
  1539.     set vl [lindex $vals $ifld]
  1540.     if {$vl != "" || ! $BibmodeVars(zapEmptyFields) || 
  1541.     [lsearch $rqdFld($type) $nm] >= 0} {
  1542.         set pad [expr $nmlen - [string length $nm]]
  1543.         
  1544.         if {$BibmodeVars(alignEquals)} {
  1545.         set pref "${bibIndent}$nm[string range $spc 1 $pad] ="
  1546.         } else {
  1547.         set pref "${bibIndent}$nm =[string range $spc 1 $pad]"
  1548.         }
  1549.         set ind [string range $spc 1 [string length $pref]]
  1550.         
  1551.         # Delimit field, if appropriate
  1552.         set noBrace [expr ($useBrace($nm) == 0 && [is::UnsignedInteger $vl]) || [regexp {\#} $vl]]
  1553.         if {$noBrace == 0 && [string first " " $vl] < 0} {
  1554.         set noBrace [expr [lsearch $bibAbbrevs [string tolower $vl]] >= 0]
  1555.         }
  1556.         if {$noBrace != 0} {
  1557.         set vl "$vl,"
  1558.         } else {
  1559.         set vl "${bibOpenQuote}${vl}${bibCloseQuote},"
  1560.         }
  1561.         
  1562.         set pieces [split $vl "\r"]
  1563.         append lines "$pref [lindex $pieces 0]\r"
  1564.         foreach piece [lrange $pieces 1 end] {
  1565.         append lines "$ind  $piece\r"
  1566.         }
  1567.     }
  1568.     }
  1569.     append lines "$bibCloseEntry\r"
  1570.     return $lines
  1571. }
  1572.  
  1573. ###########################################################################
  1574. # Get the name of the field that starts before the given position,  
  1575. # $pos.  The positions $top and $bottom restrict the range of the 
  1576. # search for the beginning and end of the field; typically, $top and
  1577. # $bottom will be the limits of a given entry.
  1578. #
  1579. proc getFldName {pos top} {
  1580.     set fldPat {[,     ]+([^     =,\{\}\"\']+)[     ]*=[     ]*}
  1581.     if {![catch {search -f 0 -r 1 -m 0 -i 1 -s -limit $top "$fldPat" $pos} mtch]} {
  1582.     set theText [eval getText $mtch]
  1583.     regexp -nocase $fldPat $theText allofit fldnam
  1584.     return $fldnam
  1585.     } else {
  1586.     return {citekey}
  1587.     }
  1588. }
  1589.  
  1590. ###########################################################################
  1591. #  Set the quote characters for quoted fields based on the value of the 
  1592. #  flag $bibUseBrace
  1593. # 
  1594. proc bibFieldDelims {} {
  1595.     global BibmodeVars bibOpenQuote bibCloseQuote
  1596.     if {$BibmodeVars(fieldBraces)} {
  1597.         set bibOpenQuote "{"
  1598.         set bibCloseQuote "}" 
  1599.     } else {
  1600.         set bibOpenQuote {"} 
  1601.         set bibCloseQuote {"} 
  1602.     }
  1603. }
  1604.  
  1605. proc bibEntryDelims {} {
  1606.     global BibmodeVars bibOpenEntry bibCloseEntry
  1607.     if {$BibmodeVars(entryBraces)} {
  1608.         set bibOpenEntry "{"
  1609.         set bibCloseEntry "}" 
  1610.     } else {
  1611.         set bibOpenEntry "("
  1612.         set bibCloseEntry ")"
  1613.     }
  1614. }
  1615.  
  1616. proc isBibFile {} {
  1617.     set fileName [win::Current]   
  1618.     set ext [file extension $fileName]
  1619.     return [string match ".bib" [string tolower $ext]] 
  1620. }
  1621.  
  1622.  
  1623.  
  1624. ###########################################################################
  1625. # Take a list of lists that point to selected entries and copy these into
  1626. # a new window.  The beginning and ending positions for each entry must 
  1627. # be the last two items in each sublist.  The rest of the sublists are
  1628. # ignored.  It is assumed that each sublist has the same number of items.
  1629. #
  1630. proc writeEntries {entryPos nondestructive {beg {0}} {end {-1}}} {
  1631.     global BibmodeVars
  1632.     if {$end < 0} {set end [maxPos]}
  1633.     set llen [expr [llength [lindex $entryPos 0]] - 1]
  1634.     set llen1 [expr {$llen-1}]
  1635.     foreach entry $entryPos {
  1636.     set limits [lrange $entry $llen1 $llen]
  1637.     append lines [eval getText $limits]
  1638.     }
  1639.     set overwriteOK [expr $nondestructive || ! [isBibFile]]
  1640.     if {$BibmodeVars(overwriteBuffer) && $overwriteOK} {
  1641.     deleteText $beg $end
  1642.     insertText $lines
  1643.     goto $beg
  1644.     } else {
  1645.     set begLines [getText [minPos] [lineStart $beg]]
  1646.     set endLines [getText [nextLineStart $end] [maxPos]]
  1647.     new -n {*BibTeX Sort/Search*} -m Bib
  1648.     insertText $begLines
  1649.     insertText $lines
  1650.     insertText $endLines
  1651.     goto $beg
  1652.     setWinInfo dirty 0
  1653.     catch shrinkWindow
  1654.     }
  1655. }
  1656.  
  1657. ###########################################################################
  1658. # Set a named mark for each entry, using the cite-key name
  1659. #
  1660. proc Bib::MarkFile {} {
  1661.     global BibmodeVars
  1662.     global bibTopPat bibTopPat1 bibTopPat2
  1663.     set pos [minPos]
  1664.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat1 $pos} res]} {
  1665.     set start [lindex $res 0]
  1666.     set pos [nextLineStart $start]
  1667.     set text [getText $start $pos]
  1668.     if {[regexp $bibTopPat2 $text mtch type citekey]} {
  1669.         if {[string tolower $type] != "string" || $BibmodeVars(markStrings)} { 
  1670.         setNamedMark $citekey [lineStart [pos::math $start - 1]] $start $start
  1671.         }
  1672.     }
  1673.     }
  1674. }
  1675.  
  1676. ###########################################################################
  1677. # Report the number of entries of each type
  1678. #
  1679. proc countEntries {} {
  1680.     global entryNames
  1681.     global bibTopPat bibTopPat1 bibTopPat2
  1682.     
  1683.     set pos [minPos]
  1684.     set count 0
  1685.     catch {unset type}
  1686.     
  1687.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat $pos} res]} {
  1688.     incr count
  1689.     set start [lindex $res 0]
  1690.     set end [nextLineStart $start]
  1691.     set text [getText $start $end]
  1692.     set lab ""
  1693.     if {[regexp $bibTopPat $text mtch entryType]} {
  1694.         set entryType [string tolower $entryType]
  1695.         if {[catch {incr type($entryType)} num]} {
  1696.         set type($entryType) 1
  1697.         }
  1698.     }
  1699.     set pos $end
  1700.     }
  1701.     new -n {*BibTeX Statistics*} -m Bib
  1702.     foreach name [lsort [array names type]] {
  1703.     if {$type($name) > 0} {
  1704.         append lines [format "%4.0d  %s\n" $type($name) $name]
  1705.     }
  1706.     }
  1707.     append lines "----  -----------------\n"
  1708.     append lines [format "%4.0d  %s\n" $count "Total entries"]
  1709.     insertText $lines
  1710.     goto [minPos]
  1711.     setWinInfo dirty 0
  1712.     catch {shrinkWindow 1}
  1713. }
  1714. #--------------------------------------------------------------------------
  1715. # command-double-clicking:
  1716. #--------------------------------------------------------------------------
  1717.  
  1718. ###########################################################################
  1719. # In Bib mode, Cmd-double-clicks resolve abbrevs and cross-refs
  1720. #
  1721. proc Bib::DblClick {from to} {
  1722.     global bibTopPat bibTopPat1 bibTopPat2
  1723.     
  1724.     set limits [getEntry $from]
  1725.     set top [lindex $limits 0]
  1726.     set bottom [lindex $limits 1]
  1727.     
  1728.     # Extend selection to largest string that could be an entry reference
  1729.     set text [string trim [eval getText [BibExtendClick $from $to $top $bottom]]]
  1730.     
  1731.     # Get the citekey of current entry, so we can avoid jumping to it    
  1732.     set citekey {}
  1733.     regexp $bibTopPat2 [getText $top $bottom] mtch type citekey ]
  1734.     set fldName [getFldName $from $top]
  1735.     
  1736.     if {[string length $text] == 0 || $text == $citekey || $fldName == $text || 
  1737.     ($fldName == "citekey" && [string tolower $type] != "string")} {
  1738.     message "Command-double-click on abbreviations and crossref arguments"
  1739.     return
  1740.     }
  1741.     
  1742.     # Jump to the mark for the specified citation, if a mark exists...
  1743.     # ...otherwise, do an ordinary search for the cite key
  1744.     pushPosition    
  1745.     set searchPat "$bibTopPat\[     \]*[quote::Regfind $text]\[     ,\}\)\]"
  1746.     if {![catch {search -f 1 -r 1 -i 1 -m 0 $searchPat 0} mtch]} {
  1747.     goto [lindex $mtch 0]
  1748.     } else {
  1749.     popPosition
  1750.     select $from $to
  1751.     if {$fldName == "crossref"} {
  1752.         message "Cross-reference \"$text\" not found"
  1753.     } else {
  1754.         message "Command-double-click on abbreviations and crossref arguments"
  1755.     }
  1756.     return
  1757.     }
  1758.     message "Use Ctl-. to return to original position"
  1759.     return
  1760. }
  1761.  
  1762. # Extend the selection around the initial selection {$from,$to}
  1763. # Extension is restricted to the range {$top,$bottom} (the current entry)
  1764. proc BibExtendClick {from to top bottom} {
  1765.     if {$to == [minPos]} { set to $from }
  1766.     set result [list $from $to]
  1767.     if {![catch {search -f 0 -r 1 -s -m 0 -l $top "\[,\{\]\"\'=" $from} mtch0]} {
  1768.     if {![catch {search -f 1 -r 1 -s -m 0 -l $bottom "\[,\}\]\"\'=" $to} mtch1]} {
  1769.         set from [lindex $mtch0 1]
  1770.         set to [lindex $mtch1 0]
  1771.         # Check for illegal chars embedded in the selection
  1772.         if {[regexp "\[\{\}\]=" [getText $from $to]] == 0} {
  1773.         set result [list $from $to]
  1774.         }
  1775.     }
  1776.     }
  1777.     return $result
  1778. }
  1779.  
  1780. #===============================================================================
  1781. proc pcite {} {
  1782.     set words [getline "Citation keys" ""]
  1783.     if {![llength $words]} {error "No keys"}
  1784.     
  1785.     set pattern {@}
  1786.     foreach w $words {
  1787.     append pattern "(\[^@\]+$w)"
  1788.     }
  1789.     
  1790.     foreach entry [findEntries $pattern] {
  1791.     set res [getFields [lindex $entry 0]]
  1792.     set title [lindex [lindex $res 1] [lsearch [lindex $res 0] "title"]]
  1793.     set citekey [lindex [lindex $res 1] [lsearch [lindex $res 0] "citekey"]]
  1794.     set matches($title) $citekey
  1795.     set where($title) [lindex $entry 0]
  1796.     }
  1797.     if {![info exists matches]} {alertnote "No citations"; return}
  1798.     set title [listpick -p "Citation?" [lsort [array names matches]]]
  1799.     putScrap $matches($title)
  1800.     alertnote $matches($title)
  1801.     goto $where($title)
  1802. }
  1803.  
  1804.  
  1805.