#!./mofeperl

&wafe_cmd(<<'__');
# for X11R4 users... use merge resources instead of fallbackResources...
if [string match "" [info command fallbackResources]] {
    alias fallbackResources mergeResources
}

# things, we allow the user to change via app-defaults or Xdefaults
fallbackResources topLevel \
    *search_label.labelString          "Search Pattern:"  \
    *replace_label.labelString         "Replace Pattern:" \
    *searchmenu.next.labelString       "Find Next"        \
    *searchmenu.next.mnemonic           N                 \
    *searchmenu.find.labelString       "Find All"         \
    *searchmenu.find.mnemonic           A                 \
    *searchmenu.replace.labelString    "Replace All"      \
    *searchmenu.replace.mnemonic        R                 \
    *searchmenu.clear.labelString      "Clear"            \
    *searchmenu.clear.mnemonic          C                 \
    *File*New.okLabelString             Open              \
    *File*New.dialogTitle              "Open File"        \
    *File*Save.okLabelString            Save              \
    *File*Save.dialogTitle             "Save File"        \
    *menubar.File.mnemonic              F                 \
    *menubar.Edit.mnemonic              E                 \
    *menubar.Search.mnemonic            S                 \
    *menubar.Help.mnemonic              H                 \
    *filemenu.New.mnemonic              N                 \
    *filemenu.Save.mnemonic             S                 \
    *filemenu.Quit.mnemonic             Q                 \
    *editmenu.Cut.mnemonic              C                 \
    *editmenu.Copy.mnemonic             o                 \
    *editmenu.Paste.mnemonic            P                 \
    *editmenu.Clear.mnemonic            l                 \
    *Foreground                         #000000000000     \
    *XmScrollBar*Foreground             #bfbfbfbfbfbf     \
    *XmLabel*Foreground                 #1d1d15155b5b     \
    *XmPushButton*Foreground            #5b5b00000000     \
    *Background                         #bfbfbfbfbfbf     \
    *XmTextField*Background             #9c9c9c9c9c9c     \
    *e*Background                       #dfdfdfdfdfdf     \
    *XmList*Background                  #dfdfdfdfdfdf     \
    *TopShadowColor                     #e7e7e7e7e7e7     \
  *XmCascadeButton.fontList       -*-helvetica-bold-o-normal-*-14-*-iso8859-1 \
  *XmLabel*fontList       -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-iso8859-1 \
  *XmPushButtonGadget*fontList  -*-helvetica-medium-r-normal-*-12-*-iso8859-1 \
  *XmText.fontList       -*-lucidatypewriter-medium-r-normal-*-12-*-iso8859-1 \
  *XmTextField.fontList  -*-lucidatypewriter-medium-r-normal-*-12-*-iso8859-1 \
  *XmPushButton*fontList        -*-helvetica-medium-r-normal-*-12-*-iso8859-1 \
  *XmList*fontList              -*-helvetica-medium-r-normal-*-12-*-iso8859-1


# things, we do not want the user to change..
mergeResources topLevel \
    *leftAttachment ATTACH_FORM \
    *rightAttachment ATTACH_FORM \
    *editmenu*activateCallback {perl editcb %w} \
    *searchmenu*activateCallback {perl searchcb %w} \
    *filemenu*activateCallback {fileDialog %w}

XmMainWindow main topLevel width 300
  XmMenuBar menubar main

      XmPulldownMenu filemenu menubar unmanaged
        XmPushButtonGadget New filemenu
        XmPushButtonGadget Save filemenu
        XmSeparatorGadget sep filemenu
        XmPushButtonGadget Quit filemenu activateCallback quit \
               accelerator Ctrl<Key>C acceleratorText Ctrl+C
    XmCascadeButton File menubar subMenuId filemenu

      XmPulldownMenu editmenu menubar unmanaged
        XmPushButtonGadget Cut editmenu
        XmPushButtonGadget Copy editmenu
        XmPushButtonGadget Paste editmenu
        XmSeparatorGadget sep editmenu
        XmPushButtonGadget Clear editmenu
    XmCascadeButton Edit menubar subMenuId editmenu

      XmPulldownMenu searchmenu menubar unmanaged
        XmPushButtonGadget next searchmenu 
        XmPushButtonGadget find searchmenu
        XmPushButtonGadget replace searchmenu
        XmSeparatorGadget sep searchmenu
        XmPushButtonGadget clear searchmenu
    XmCascadeButton Search menubar subMenuId searchmenu

      XmPulldownMenu helpmenu menubar unmanaged
        XmPushButtonGadget Help helpmenu \
            activateCallback "manageChild helpbox"
        XmPushButtonGadget Version helpmenu \
            activateCallback "manageChild versionbox"
    XmCascadeButton Help menubar subMenuId helpmenu

XmMessageDialog versionbox helpmenu unmanaged \
        dialogTitle "Motif Editor demo Program using Mofeperl" \
        okLabelString "Close" \
        messageString "(nc) No Copyright Peter Sylvester, Gustaf Neumann 1994"
unmanageChild \
        [XmMessageBoxGetChild versionbox DIALOG_CANCEL_BUTTON] \
        [XmMessageBoxGetChild versionbox DIALOG_HELP_BUTTON]

XmMessageDialog helpbox helpmenu unmanaged \
        dialogTitle "Help" \
        okLabelString "Close" \
        messageString "This program is a simple demo program for Mofeperl."
unmanageChild \
        [XmMessageBoxGetChild helpbox DIALOG_CANCEL_BUTTON] \
        [XmMessageBoxGetChild helpbox DIALOG_HELP_BUTTON]

sV menubar menuHelpWidget Help

XmForm form main
  XmRowColumn SearchPanel form \
         orientation horizontal packing PACK_TIGHT \
         topAttachment ATTACH_FORM
    XmLabel search_label SearchPanel
    XmTextField search_text SearchPanel
    XmLabel replace_label SearchPanel marginLeft 16
    XmTextField replace_text SearchPanel

  XmText text_output form editable False \
         cursorPositionVisible False shadowThickness 0 \
         bottomAttachment ATTACH_FORM

  XmScrolledText e form \
         rows 20 columns 80 editMode MULTI_LINE_EDIT \
         topAttachment ATTACH_WIDGET topWidget SearchPanel \
         bottomAttachment ATTACH_WIDGET bottomWidget text_output
realize

# create fileDialog the first time it is used...
proc fileDialog {name} {
  if [isWidget File*$name] {
     manageChild $name
     raiseWindow [parent $name]
  } else {
      XmFileSelectionDialog $name File \
	  cancelCallback "unmanageChild %W" \
          okCallback "perl filecb $name %d \"%s\""
  }
}

# for Motif 1.1 users... 
# implementation of XmTextFindString, which is available in Motif 1.2..
if [string match "" [info command XmTextFindString]] {
  proc XmTextFindString {w start string direction pos} {
    upvar $pos returnPos
    switch $direction {
      TEXT_FORWARD {
        set content [string range [gV $w value] $start end]
        set returnPos [string first $string $content]
      }
      TEXT_BACKWARD {
        set content [string range [gV $w value] 0 $start]
        set returnPos [string last $string $content]
      }
    }
    if {$returnPos != -1} {
      incr returnPos $start
      return 1
    } else {
      return 0
    }
  }
}
__

sub setarg {
    @ARGV=();
    local($ARGC) = &wafe_cmd('return [set argc]');
    for($i=0; $i<$ARGC; $i++) {
	push(@ARGV,&wafe_cmd("return [lindex [set argv] $i]"));
    }
}
&setarg();

sub errmsg {
    local($_) = @_;
    &infomsg($_); 
    &wafe_cmd('bell text_output 0');
}
sub infomsg {
    local($_) = @_;
    &wafe_set('_',$_); &wafe_cmd('sV text_output value $_; unset _');
}

sub filecb {
   local($op,$dir,$fileName) = @_;
   if (!$fileName || $dir eq $fileName) {
       &errmsg("Choose a file.");
   }
   if ($op eq 'New') {
       if (!-T $fileName) {
	   &errmsg("Cannot read text file '$fileName'");
	   return;
       }
       undef($/);
       open(F,"<$fileName");
       local($_) = <F>;
       close(F);
       &wafe_set('_',$_); &wafe_cmd('sV e value $_; unset _');
       &infomsg("Loaded ".&wafe_cmd("XmTextGetLastPosition e")
		." bytes from '$fileName'.");
   } else { # Save 
       if (!open(F,">$fileName")) {
	   &errmsg("Cannot open file '$fileName'.");
	   return;
       }
       print F &wafe_cmd("gV e value");
       local($written) = tell(F);
       if ($written == &wafe_cmd("XmTextGetLastPosition e")) {
	   &infomsg("Saved $written bytes to '$fileName'.");
       } else {
	   &errmsg("Warning did not write entire file.");
       }
       close(F);
   }
   &wafe_cmd("unmanageChild $op");
}

sub searchcb {
   local($_) = @_;
   local($endPos) = &wafe_cmd("XmTextGetLastPosition e");
   if (/clear/) {
       &wafe_cmd("XmTextSetHighlight e 0 $endPos HIGHLIGHT_NORMAL");
       return;
   }
   if ($endPos == 0) {
       &errmsg("No text to search.");
       return;
   }
   local($search_length)=length(&wafe_cmd("set srch [gV search_text value]"));
   if (! $search_length) {
       &errmsg("Specify a search pattern.");
       return;
   }
   
   if (/next/) {
       local($p) = &wafe_cmd("gV e cursorPosition") + 1;
       if (&wafe_cmd("XmTextFindString e $p [set srch] TEXT_FORWARD fp")) {
	   local($found_pos) = &wafe_cmd("set fp");
	   &wafe_cmd("XmTextSetHighlight e $found_pos "
		     .($found_pos+$search_length)." HIGHLIGHT_SELECTED");
	   &infomsg("Pattern found at position $found_pos.");
	   &wafe_cmd("sV e cursorPosition $found_pos");
	   return;
       }
   } else {
       # we have to handle now findall and replace, which iterate over
       # the whole file
       local($p,$count,$found_pos) = (0,0,0);
       local($rpl_length)=length(&wafe_cmd("set rpl [gV replace_text value]"));
       # unset old highlighing
       &wafe_cmd("XmTextSetHighlight e 0 $endPos HIGHLIGHT_NORMAL");

       while(&wafe_cmd("XmTextFindString e $p [set srch] TEXT_FORWARD fp")){
	   $found_pos = &wafe_cmd("set fp");
	   $p = $found_pos+$search_length;
	   if (/replace/) {
	       &wafe_cmd("XmTextReplace e $found_pos $p [set rpl]");
	       $p = $found_pos+$rpl_length;
	   }
	   &wafe_cmd("XmTextSetHighlight e $found_pos $p HIGHLIGHT_SELECTED");
	   $p++;
	   $count++;
       }
       if ($count) {
	   &infomsg("Found $count occurances.") if /find/;
	   &infomsg("Made $count replacements.") if /replace/;
	   return;
       }
   }
   &errmsg("Pattern not found.");
}

sub editcb {
   local($_) = @_;
   local($result);
   if (/Clear/) {
       &wafe_cmd("XmTextClearSelection e");
       &errmsg("");
   } else {
       &errmsg( &wafe_cmd("XmText$_ e")?"":"There is no selection" );
   }
}

# calling the xt event loop
&wafe_process_events();
