#!/usr/bin/env wish8.3
# aqabbrevs - abbreviation manager for jedit
#
###############################################################################
#  Copyright 1992-2001 by Jay Sekora.  This file may be freely distributed,   #
#  modified or unmodified, for any purpose, provided that this copyright      #
#  notice is retained verbatim in all copies and no attempt is made to        #
#  obscure the authorship of this file.  If you distribute any modified       #
#  versions, I ask, but do not require, that you clearly mark any changes     #
#  you make as such and that you provide your users with instructions for     #
#  getting the original sources.                                              #
###############################################################################
## begin boiler_header

if {[info exists env(AQTOOLS_LIB)]} {
  set aq_library $env(AQTOOLS_LIB)
  set aq_pkg [file join $env(AQTOOLS_LIB) pkg]
} else {
  set aq_library /usr/lib/aq
  set aq_pkg [file join $aq_library pkg]
}

# add the aq library to the library search path:

set auto_path  [concat  [list $aq_pkg]  [list $aq_library]  $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the aq libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header

# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  # following likely to fail, because done by other libraries too
  namespace import ::jldb::shortcuts::*
}

catch {
  package require aq
  namespace eval ::aq { }			;# so namespace is defined
}

::jldb::set_defaults {
  {Abbrevs Abbrevs 0}
  {File File 0}
  {Help Help 0}
  {{Help on aqabbrevs} {Help on aqabbrevs} 0}
  {{Help on Using Abbreviations in jedit}
    {Help on Using Abbreviations in jedit} 8}
  {{Help on aq} {Help on aq} 10}

  {aqabbrevs:cmd:about {About the Abbrevs Manager...} 0 <Meta-Key-A> {[h]}}
  {aqabbrevs:cmd:help {Help} 0 <Meta-Key-h> {[H]}}
  {aqabbrevs:cmd:quit {Quit} 0 <Meta-Key-q> {[q]}}
  {aqabbrevs:cmd:add {Add}}
  {aqabbrevs:cmd:delete {Delete}}
  {aqabbrevs:cmd:reload {Reload} 2 <Meta-Key-l> {[l]}}
  {aqabbrevs:cmd:save {Save} 0 <Meta-Key-s> {[s]}}
}

######################################################################

global HOME env
set HOME $env(HOME)

global ABBREVPREFS
set ABBREVPREFS(filename) "$HOME/.tk/abbrevs.tcl"
set ABBREVPREFS(vi_filename) "$HOME/vi-abbrevs"
set ABBREVPREFS(emacs_filename) "$HOME/.abbrev_defs"

######################################################################
# aqabbrevs:init - basic initialisation
######################################################################

proc aqabbrevs:init {} {
  global J_PREFS			;# cross-application prefs
  global THIS_ABBREV			;# abbrev being entered
  global THIS_EXPANSION			;# expansion being entered
  
  ::aq::aq_init aqabbrevs	;# prefs, libraries, bindings...
  
  global ABBREVS			;# text-indexed array of expansions
  set ABBREVS(0) {0}			;# to make sure it's an array
}


######################################################################
# aqabbrevs:userinit - user customisation
######################################################################

proc aqabbrevs:userinit {} {
  global J_PREFS			;# cross-application prefs
  global NAME
  global HOME
  
  # read in user's .tk/aqabbrevsrc.tcl
  j:source_config aqabbrevsrc.tcl
}

######################################################################
# aqabbrevs:apply_prefs
######################################################################

proc aqabbrevs:apply_prefs {} {
  global J_PREFS			;# cross-application prefs
  global NAME
  global HOME
  global tk_strictMotif
  
  # set user's text bindings:
  
  switch -exact $J_PREFS(bindings) {
    basic {
      j:eb:basic_bind Entry
    }
    emacs {
      j:eb:emacs_bind Entry
    }
    vi {
      j:eb:vi_bind Entry
    }
  }

  if {$J_PREFS(tk_strictMotif)} {
    set tk_strictMotif 1
  } else {
    set tk_strictMotif 0
  }
}

######################################################################
# abbrev - set an abbreviation (used by .tk/abbrevs.tcl
######################################################################

proc abbrev {{abbrev} {expansion}} {
  global ABBREVS
  
  set ABBREVS($abbrev) $expansion
}

######################################################################
# aqabbrevs:mkmenus - make menu bar
######################################################################

proc aqabbrevs:mkmenus { mb w } {
  frame $mb -borderwidth 2 -relief raised
  
  j:menu:menubutton $mb.abbrevs $mb.abbrevs.m Abbrevs
  j:menu:commands $mb.abbrevs.m $w {
    aqabbrevs:cmd:about
    ::aq::cmd::global_pref_panel
    -
    ::aq::cmd::prompt_tcl
    ::aq::cmd::prompt_unix
  }
  
  j:menu:menubutton $mb.file $mb.file.m File
  j:menu:commands $mb.file.m $w {
    aqabbrevs:cmd:reload
    aqabbrevs:cmd:save
    -
    aqabbrevs:cmd:quit
  }
  
  j:menu:menubutton $mb.help $mb.help.m Help
  j:menu:docs $mb.help.m {
    {{Help on aqabbrevs} {aqabbrevs.jdoc}}
    {{Help on Using Abbreviations in jedit} {jedit.jdoc#Abbreviations}}
    -
    {{Help on aq} {aq.jdoc}}
  }
  
  pack $mb.abbrevs $mb.file -side left
  pack $mb.help -side right
  pack $mb -side top -fill x
  
  tk_menuBar $mb $mb.abbrevs $mb.file $mb.help
}

######################################################################
# aqabbrevs:mkmain - make main body with fields and buttons
######################################################################

proc aqabbrevs:mkmain {} {
  global J_PREFS			;# cross-application prefs
  global THIS_ABBREV			;# abbrev being entered
  global THIS_EXPANSION			;# expansion being entered
  
  frame .main
  frame .main.abbrev
  label .main.abbrev.l \
    -width 15 \
    -text [::jldb::long_text "Abbreviation:"] \
    -anchor w \
    -relief flat
  entry .main.abbrev.e -width 40 -textvariable THIS_ABBREV
  frame .main.expn
  label .main.expn.l \
    -width 15 \
    -text [::jldb::long_text "Expansion:"] \
    -anchor w \
    -relief flat
  entry .main.expn.e -width 40 -textvariable THIS_EXPANSION
  
  pack .main.abbrev.l .main.abbrev.e -side left
  pack .main.expn.l .main.expn.e -side left
  pack \
    [::aq::filler .main]\
    .main.abbrev \
    [::aq::filler .main] \
    .main.expn \
    [::aq::filler .main] \
    -side top -fill x
  
  ::aq::command_buttonbar .b . {
    aqabbrevs:cmd:add
    aqabbrevs:cmd:delete
    aqabbrevs:cmd:save
    aqabbrevs:cmd:quit
  } -default aqabbrevs:cmd:add
  ::aq::default_button .b.aqabbrevs:cmd:add .main.abbrev.e .main.expn.e
  ::aq::cancel_button .b.aqabbrevs:cmd:quit .main.abbrev.e .main.expn.e
  
  pack .b [::aq::rule .] -side bottom -fill x
  pack \
    [::aq::filler .] \
    .main \
    [::aq::filler .] \
    -side left -fill y
  
  focus .main.abbrev.e
  catch {focus default .main.abbrev.e}	;# caught for Tk 4.0
}

######################################################################
####
#    OUTPUT PROCEDURES
####
######################################################################

proc aqabbrevs:write_native {} {
  global ABBREVS THIS_ABBREV THIS_EXPANSION ABBREVPREFS
  
  set file [open $ABBREVPREFS(filename) w]
  
  foreach abbrev [lsort [array names ABBREVS]] {
    puts $file "abbrev [list $abbrev] [list $ABBREVS($abbrev)]"
  }
  
  close $file
  return 0
}

### THIS DOESN'T WORK YET
### 
proc aqabbrevs:write_emacs {} {
  global ABBREVS THIS_ABBREV THIS_EXPANSION ABBREVPREFS
  
  set file [open $ABBREVPREFS(emacs_filename) w]
  
  puts $file {(define-abbrev-table 'c-mode-abbrev-table '( ))}
  puts $file {(define-abbrev-table 'text-mode-abbrev-table '(}
  foreach abbrev [lsort [array names ABBREVS]] {
    if {! [regexp -- {"} $abbrev] && ! [regexp -- {"} $ABBREVS($abbrev)]} {
      puts $file [format \
        {    ("%s" "%s" nil 0)} \
        $abbrev $ABBREVS($abbrev)]
    }
  }
  puts $file {    ))}
  puts $file {(define-abbrev-table 'lisp-mode-abbrev-table '( ))}
  puts $file {(define-abbrev-table 'fundamental-mode-abbrev-table '( ))}
  puts $file {(define-abbrev-table 'global-abbrev-table '( ))}
  
  close $file
  return 0
}

proc aqabbrevs:write_vi {} {
  global ABBREVS THIS_ABBREV THIS_EXPANSION ABBREVPREFS
  
  set file [open $ABBREVPREFS(vi_filename) w]
  
  foreach abbrev [lsort [array names ABBREVS]] {
    puts $file "ab $abbrev $ABBREVS($abbrev)"
  }
  
  close $file
  return 0
}

######################################################################
####
#    COMMAND PROCEDURES
####
######################################################################

::aq::command_register aqabbrevs:cmd:about {About the Abbrevs Manager...}
proc aqabbrevs:cmd:about { w args } {
  global JSTOOLS_VERSION
  set about_aqabbrevs [format {
    j:rt:hl "aqabbrevs"
    j:rt:cr
    j:rt:rm "by Jay Sekora, "
    j:rt:tt "js@aq.org"
    j:rt:par
    j:rt:rm "An X Windows tool for managing abbreviations."
    j:rt:cr
    j:rt:rm "Version %s."
    j:rt:par
    j:rt:rm "Copyright \251 1994-1995 by Jay Sekora.  "
    j:rt:rm "All rights reserved, except that this file may be freely "
    j:rt:rm "redistributed in whole or in part for non-profit, "
    j:rt:rm "noncommercial use."
    j:rt:par
    j:rt:rm "If you find bugs or have suggestions for improvement, "
    j:rt:rm "please let me know.  "
    j:rt:rm "Feel free to use bits of this code in your own "
    j:rt:tt "wish"
    j:rt:rm " scripts."
  } $JSTOOLS_VERSION]
  j:about .about $about_aqabbrevs
  j:about:button .about {About aqabbrevs} $about_aqabbrevs
  j:about:button .about {About the Author} [j:about_jay]
  j:about:button .about {About Tk and Tcl} [j:about_tktcl]
  
  tkwait window .about
}

######################################################################

::aq::command_register aqabbrevs:cmd:quit {Quit}
proc aqabbrevs:cmd:quit { w args } {
  if [::aq::confirm -text [= "Are you sure you want to quit?"]] {
    exit 0
  }
  return 0
}

######################################################################

::aq::command_register aqabbrevs:cmd:add {Add}
proc aqabbrevs:cmd:add { w args } {
  global ABBREVS THIS_ABBREV THIS_EXPANSION
  
  set THIS_ABBREV [string trim $THIS_ABBREV]
  
  set THIS_EXPANSION [string trim $THIS_EXPANSION]
  
  if {"x$THIS_ABBREV" == "x"} {
    ::aq::alert -text "No abbreviation specified."
    focus .main.abbrev.e
    return 1
  }
  
  if {"x$THIS_EXPANSION" == "x"} {
    if {[lsearch -exact [array names ABBREVS] $THIS_ABBREV] != -1} {
      set THIS_EXPANSION $ABBREVS($THIS_ABBREV)
      focus .main.expn.e
      return 0
    } else {
      ::aq::alert -text \
        "No expansion given, and no abbreviation `$THIS_ABBREV' is defined."
    }
    focus .main.abbrev.e
    return 1
  }
  
  set ABBREVS($THIS_ABBREV) $THIS_EXPANSION
  set THIS_ABBREV {}
  set THIS_EXPANSION {}
  focus .main.abbrev.e
  return 0
}

######################################################################

::aq::command_register aqabbrevs:cmd:delete {Delete}
proc aqabbrevs:cmd:delete { w args } {
  global ABBREVS THIS_ABBREV THIS_EXPANSION
  
  set THIS_ABBREV [string trim $THIS_ABBREV]
  
  if {"x$THIS_ABBREV" == "x"} {
    ::aq::alert -text "No abbreviation specified."
    focus .main.abbrev.e
    return 1
  }
  
  if {"x$THIS_EXPANSION" == "x"} {
    ::aq::alert -text "No expansion specified."
    focus .main.abbrev.e
    return 1
  }
  
  unset ABBREVS($THIS_ABBREV)
  set THIS_ABBREV {}
  set THIS_EXPANSION {}
  focus .main.abbrev.e
  return 0
}

######################################################################

::aq::command_register aqabbrevs:cmd:reload {Reload}
proc aqabbrevs:cmd:reload { w args } {
  global ABBREVS ABBREVPREFS
  
  catch {unset ABBREVS}
  set ABBREVS(0) {0}
  
  if [file exists $ABBREVPREFS(filename)] {
    uplevel #0 {catch {source $ABBREVPREFS(filename)}}
  }
  
  catch {focus .main.abbrev.e}
  return 0
}

######################################################################

::aq::command_register aqabbrevs:cmd:save {Save}
proc aqabbrevs:cmd:save { w args } {
  aqabbrevs:write_native
#  aqabbrevs:write_emacs
#  aqabbrevs:write_vi
  
  # tell all the jedit applications to re-read the abbrevs file:
  foreach interp [winfo interps] {
    switch -glob -- $interp {
      {jedit} -
      {jedit #*} {
        catch {send $interp {after 1 jedit:cmd:read_abbrevs}}
      }
    }
  }
  
  focus .main.abbrev.e
  return 0
}

######################################################################

aqabbrevs:init
aqabbrevs:userinit

aqabbrevs:mkmenus .menu .
aqabbrevs:mkmain

tk_bindForTraversal all
::aq::command_bind all . [::aq::command_list]

aqabbrevs:cmd:reload .

aqabbrevs:apply_prefs

