# jedit_util.tcl - utility procedures for jedit, a tk-based editor
#
###############################################################################
#  Copyright 1992-2002 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.                                              #
###############################################################################

# 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
}

######################################################################
# basic initialisation
# only has an effect the first time it's called.
######################################################################

proc jedit:init {} {
  global JEDIT_INITIALISED		;# flag - already called?
  if [info exists JEDIT_INITIALISED] {
    return				;# only initialise once
  }
  set JEDIT_INITIALISED 1
  
  global J_PREFS			;# cross-application prefs
  global JEDIT_PREFS			;# editor prefs (all modes)
  global JEDIT_MODEPREFS		;# mode-specific prefs
  
  global JEDIT_WINDOW_COUNT		;# number of toplevel windows
  set JEDIT_WINDOW_COUNT 0
  
  ::aq::aq_init aqedit			;# prefs, libraries, bindings...
  
  # can't do this before aq_init sets package path:
  ::jldb::set_defaults {
    {JEpipe:no_sel {No selection made in text.}}
    {JEpipe:error...:... {Error from $command: $result}}
    {JEgoto:...bad_line_number {`$lineno' is not a valid line number.}}
  }

  global UNDOPTR			;# current index into undo ring
  set UNDOPTR 0
  
  global FILE_MODES			;# filename patterns for modes
  					;# only first two sublist items matter
  set FILE_MODES {
    {*.c		code		{C source}}
    {*.f		code		{Fortran source}}
    {*.h		code		{C header files}}
    {*.xbm		code		{X bitmap (C code)}}
    {*.xpm		code		{X pixmap (C code)}}
    {*[mM]akefile*	code		{make(1) script}}
    {*.html		html		{WWW Hypertext Markup Language}}
    {*.htm		html		{WWW Hypertext Markup Language}}
    {*.jhtml		jhtml		{WYSIWYG WWW Hypertext Markup Language}}
    {*.jht		jhtml		{WYSIWYG WWW Hypertext Markup Language}}
    {*.jdoc		jdoc		{document for jdoc app.}}
    {*.jrt		richtext	{rich-text with fonts and other tags}}
    {*.p		code		{Pascal source}}
    {*.pl		perl		{Perl source (hopefully not Prolog)}}
    {*.ksh		sh		{Korn shell script}}
    {*.sh		sh		{Bourne shell script}}
    {*.shar		sh		{Bourne shell archive}}
    {*.tcl		tcl		{Tcl scripts}}
    {*.tk		tcl		{Tk/Tcl scripts}}
    {*.exp		tcl		{Expect scripts}}
    {*/.letter		mail		{Mail from tin}}
    {.letter		mail		{Mail from tin}}
    {*/.followup	mail		{Posting from slrn}}
    {.followup		mail		{Posting from slrn}}
    {*/.[a-zA-Z]*	code		{~/.login, etc.}}
    {.[a-zA-Z]*		code		{.login, etc.}}
    {*/draft*/[0-9]*	mh		{MH, exmh, xmh, etc.}}
    {*/tmp/snd.[0-9]*	mail		{elm}}
    {*/tmp/R*[0-9]	mail		{UCB Mail}}
    {*.note		note		{short multi-font note}}
  }
  
  global LINE_MODES			;# first-line patterns for modes
  					;# only first two sublist items matter
  set LINE_MODES {
    {%!*		code		{PostScript file}}
    {{#!*/perl*}	code		{Perl scripts}}
    {{#!*/sh*}		sh		{Bourne shell scripts}}
    {{#!*/bash*}	sh		{bash scripts}}
    {{#!*/ksh*}		sh		{Korn shell scripts}}
    {{#!*/wish*}	tcl		{Tk/Tcl scripts}}
    {{#!*/tclsh*}	tcl		{Tcl scripts}}
    {{#!*/expect*}	tcl		{Expect or Expectk scripts}}
    {{#!* perl*}	code		{Perl scripts}}
    {{#!* sh*}		sh		{Bourne shell scripts}}
    {{#!* bash*}	sh		{bash scripts}}
    {{#!* ksh*}		sh		{Korn shell scripts}}
    {{#!* wish*}	tcl		{Tk/Tcl scripts}}
    {{#!* tclsh*}	tcl		{Tcl scripts}}
    {{#!*/expect*}	tcl		{Expect or Expectk scripts}}
    {#!*		code		{executable script}}
  }
  
  global WORD_END
  set WORD_END {
    ampersand
    apostrophe
    asterisk
    colon
    comma
    exclam
    minus
    period
    question
    quotedbl
    quoteright
    semicolon
    slash
    underscore
  }
  
  global JEDIT_CLOSE_BRACKET
  set JEDIT_CLOSE_BRACKET {
    braceright
    bracketright
    parenright
  }
  global JEDIT_LEFT_MATCH
  set JEDIT_LEFT_MATCH(parenright) \(
  set JEDIT_LEFT_MATCH(bracketright) \[
  set JEDIT_LEFT_MATCH(braceright) \{
  
  global CUTBUFFER
  set CUTBUFFER {}
  
  global ABBREV				;# last abbrev expanded
  set ABBREV {}
  global ABBREV_POS			;# start of last abbrev
  set ABBREV_POS {}
  global MATCH				;# last match found
  set MATCH {}
  global MATCH_POS			;# position of last match found
  set MATCH_POS {}
  global ABBREV_LIST			;# list of abbrevs read from file
  set ABBREV_LIST {}			;# (not yet used)
  global ABBREVS			;# text-indexed array of expansions
}

######################################################################
# edit a file
######################################################################

proc jedit:jedit { args } {
  global JEDIT_PREFS
  global JEDIT_MODEPREFS		;# mode-specific prefs
  global JEDIT_WINDOW_COUNT		;# number of toplevel windows
  
  global AQSYSINFO
  
  ::aq::parse_args {
    {window unspecified}
    {mode default}
    {embedded 0}
    {width {}}
    {height {}}
    {command {}}
    {filecommands {
      jedit:cmd:load
      jedit:cmd:save
      jedit:cmd:saveas
      jedit:cmd:print
      -
      jedit:cmd:insfile
      -
      jedit:cmd:close
      jedit:cmd:done
    }}
    {buttons {}}
    {file {}}
    {line {}}
  }
  
  jedit:init				;# ignored second etc. time it's called
  global JEDIT_EMBEDDED
  global JEDIT_EMBEDDED_FILECOMMANDS
  global JEDIT_EMBEDDED_BUTTONS
  global JEDIT_COMMAND
  set JEDIT_EMBEDDED $embedded		;# 1 -> disable exit, etc.
  set JEDIT_COMMAND $command		;# called on window close
  if $JEDIT_EMBEDDED {
    set JEDIT_EMBEDDED_FILECOMMANDS \
      $filecommands			;# commands to include in File menu
    set JEDIT_EMBEDDED_BUTTONS $buttons	;# buttons to display in buttonbar
  }
  
  if {"x$mode" == "xdefault"} {		;# if caller hasn't specified mode
    if {"x$file" != "x"} {		;#   and we have a filename
      set mode [jedit:guess_mode $file]	;#     guess the mode
    } else {				;#   if no filename
      set mode plain			;#     empty window in plain mode
    }
  }
  
  # pick a window name if the user hasn't supplied one
  if { "x$window" == "xunspecified" } {
    set window [jedit:new_window_name]
  }
  
  if { ! [winfo exists $window] } {
    toplevel $window -class Jedit
    if {$AQSYSINFO(tinyscreen)} {
      wm minsize $window $AQSYSINFO(min_width) $AQSYSINFO(min_height)
    }
  }
  
  incr JEDIT_WINDOW_COUNT		;# keep count of each window opened
  
  set text [jedit:top_to_text $window]
  
  if {"x$file" != "x"} {
    jedit:set_filename $window $file
  }
  jedit:set_mode $window $mode
  
  jedit:userinit $window $mode $file
  jedit:mkwindow $window
  jedit:apply_mode $window
  jedit:apply_prefs $window
  
  if {[string length $width]} {
    catch {$text configure -width $width}
  }
  if {[string length $height]} {
    catch {$text configure -height $height}
  }
  
  jedit:mkbindings $text $text
  if {[info procs jedit:userhook] == "jedit:userhook"} {
    jedit:userhook $window
  }
  if {"x$file" != "x"} {
    jedit:read $file $text
    if [string length $line] {		;# specify a particular line to go to
      jedit:go_to_line $text $line
    }
  }
  
  wm protocol $window WM_DELETE_WINDOW \
    [list jedit:cmd:close $text]
  return $window			;# for caller to manipulate
}

######################################################################
# get an unused name for a window
######################################################################

proc jedit:new_window_name {} {
  set i 0
  while {[winfo exists .jedit$i]} {
    incr i
  }
  return .jedit$i
}

######################################################################
# user customisation
######################################################################

proc jedit:userinit {window mode file} {
  ::aq::debug "jedit:userinit $window $mode $file"
  global J_PREFS			;# cross-application prefs
  global JEDIT_MODEPREFS		;# mode-specific prefs
  global JEDIT_PREFS			;# editor prefs (all modes)
  
  # read in user's editor preferences
  #
  j:read_prefs -array JEDIT_PREFS \
    -file jedit-defaults {
    {textbg white}
    {textfg black}
    {textsb black}
    {textsf white}
    {textiw 2}
    {textbw 2}
    {textsbw 2}
    {undolevels 2}
  }
  jedit:read_mode_prefs $mode
  jedit:cmd:read_abbrevs
  
  # read in user's .tk/aqeditrc.tcl
  j:source_config aqeditrc.tcl
}

######################################################################
# apply editor and mode preferences (initially or after they change)
######################################################################
# noreread is a kludge!

proc jedit:apply_all_prefs { window {noreread ""}} {
  global JEDIT_MODEPREFS		;# mode-specific prefs
  jedit:apply_prefs $window
  jedit:apply_mode $window $noreread
}

######################################################################
# apply editor preferences (initially or after they change)
######################################################################

proc jedit:apply_prefs { window } {
  global J_PREFS			;# cross-application prefs
  global JEDIT_MODEPREFS		;# mode-specific prefs
  global JEDIT_PREFS			;# editor prefs (all modes)
  global NAME
  global HOME
  global tk_strictMotif
  
  set text [jedit:top_to_text $window]
  set menubar [jedit:top_to_menubar $window]
  
  # set user's text bindings:
  
  j:tb:init Text
  j:eb:init Entry

  if {$J_PREFS(tk_strictMotif)} {
    set tk_strictMotif 1
  } else {
    set tk_strictMotif 0
  }
  
  # following are handled by jedit:apply_mode
  # jedit:configure_text $text
  # jedit:mkmenus $menubar $text
  # jedit:mkbuttonbar $buttonbar $text
}

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

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

######################################################################
# guarantee that there's a selection by selecting the current line
#   otherwise
######################################################################

proc jedit:guarantee_selection { t } {
  if [j:text:has_selection $t] {
    return
  }
  $t tag remove sel 1.0 end		;# we know we don't need to, but...
  $t tag add sel {insert linestart} {insert lineend+1char}
}

######################################################################
# regsub in selection in t
#   if the original text ends with a newline, it is removed and
#   replaced at the end.
### SHOULD BE MORE GENERAL (eg entire file)
######################################################################
# (i'm not sure why i need to clear the selection from the last character
# in the text widget under tk4, but i do.)

proc jedit:text_regsub { t regex subst } {
  if { ! [j:text:has_selection $t]} {
    ::aq::alert -text [= JEpipe:no_sel]
    return 1
  }
  
  jedit:save_checkpoint $t		;# save undo information
  
  set finalcr 0
  
  set text [selection get]
  if [regexp -- "\n\$" $text] {
    set text [string trimright $text "\n"]
    set finalcr 1
  }
  
  if [$t compare end == sel.last] {
    $t tag remove sel end-1c
  }
  
  regsub -all -- $regex $text $subst result
  
  if $finalcr {
    append result "\n"
  }
  
  j:text:replace $t sel.first sel.last $result
}

######################################################################
# pipe selection through command (and replace)
#   if original text has a newline and new text doesn't, a newline
#   is appended.  this is a workaround for some filters that drop the
#   newline.  not perfect, but should be adequate.
######################################################################
# (i'm not sure why i need to clear the selection from the last character
# in the text widget under tk4, but i do.)

proc jedit:pipe { t command } {
  if { ! [j:text:has_selection $t]} {
    ::aq::alert -text [= JEpipe:no_sel]
    return 1
  }
  
  jedit:save_checkpoint $t		;# save undo information
  
  set finalcr 0
  
  if {![string match "\n" [$t get sel.last-1c]]} {
    $t insert sel.last "\n"
  }
  
  set text [selection get]
  if [regexp -- "\n\$" $text] {
    set finalcr 1
  }
  
  if { ! $finalcr } {			;# doesn't already have newline
    append text "\n"
  }
  
  if [$t compare end == sel.last] {
    $t tag remove sel end-1c
  }
  
  if [catch { eval exec $command << [list $text] } result] {
    ::aq::alert -text \
      [subst -nocommands -nobackslashes [= JEpipe:error...:...]]
    return 1
  }
  
  if {$finalcr && ( ! [regexp -- "\n\$" $result] )} {
    append result "\n"
  }
  
 j:text:replace $t sel.first sel.last $result
  
  return 0
}

######################################################################
# return string with first char capitalised
######################################################################

proc jedit:capitalise {string} {
  set cap [format {%s%s} \
    [string toupper [string range $string 0 0]] \
    [string range $string 1 end]]
  return $cap
}

######################################################################
# return string with first char lowercased
######################################################################

proc jedit:uncapitalise {string} {
  set lc [format {%s%s} \
    [string tolower [string range $string 0 0]] \
    [string range $string 1 end]]
  return $lc
}

######################################################################
# go to a particular line
######################################################################

proc jedit:go_to_line { t {lineno 0} } {
  set result [catch {
    j:tb:move $t $lineno.0
  }]
  if {$result} {
    ::aq::alert -text \
      [subst -nocommands -nobackslashes [= JEgoto:...bad_line_number]]
  }
}

######################################################################
# set the filename corresponding to a window.  the window can be
# specified either as a text widget, or as that text widget's
# corresponding toplevel window.
######################################################################

proc jedit:set_filename { w filename } {
  ::aq::tlinfo $w set filename $filename
}

######################################################################
# return the filename corresponding to a window.  the window can be
# specified either as a text widget, or as that text widget's
# corresponding toplevel window.  if no filename has been set for that
# window, returns {}.
######################################################################

proc jedit:get_filename { w } {
  ::aq::tlinfo $w get filename
}

######################################################################
# unset the filename for a window.  useful when deleting a window.
######################################################################

proc jedit:unset_filename { w } {
  ::aq::tlinfo $w unset filename
}

