#!/usr/bin/perl -w
#
#  Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#  $Id: editor.pl,v 1.13 2005/04/20 08:12:22 dk Exp $
#

=pod 
=item NAME

A basic text editor

=item FEATURES

Demonstrates usage of Prima::Edit class,
and, in lesser extent, of standard find/replace dialogs.

=cut

use Prima;
use Prima::Edit;
use Prima::Application;
use Prima::MsgBox;
use Prima::StdDlg;

eval "use Encode;";
my $can_utf8 = $@ ? 0 : 1;

package Indicator;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

sub profile_default
{
   my %def = %{$_[ 0]-> SUPER::profile_default};
   return {
      %def,
      editor   => undef,
      text     => '',
      growMode => gm::Floor,
      left     => 0,
      bottom   => 0,
      height   => 21,
   }
}

sub init
{
   my $self = shift;
   my %profile = $self-> SUPER::init(@_);
   $self->{editor} = $profile{editor};
   $self-> reset;
   return %profile;
}

sub on_paint
{
   my ($self,$canvas) = @_;
   $canvas-> rect3d( 0, 0, $self-> width - 1, $self-> height - 1, 1, $self-> dark3DColor, $self-> light3DColor, $self-> backColor);
   $canvas-> text_out( $self-> text, 4, ( $self-> height - $canvas-> font-> height) / 2);
}

sub reset
{
   my $self    = $_[0];
   my $editor  = $self-> {editor};
   my @c = $editor-> cursorLog;
   $self-> text( sprintf("%s %d:%d", ($editor-> modified ? '*' : ' '), $c[0]+1,$c[1]+1));
   $self-> repaint;
}


package Editor;
use vars qw(@ISA);
@ISA = qw(Prima::Edit);

sub profile_default
{
   my %def = %{$_[ 0]-> SUPER::profile_default};
   my @accelItems = @{$def{accelItems}};
   my @acc = (
      [ PushMark  => 0, 0, km::Ctrl|kb::Down, q(push_mark)],
      [ PopMark   => 0, 0, km::Ctrl|kb::Up,   q(pop_mark)],
   );
   splice( @accelItems, -1, 0, @acc);
   return {
      %def,
      accelItems => \@accelItems,
   }
}

sub set_cursor
{
   my $self = shift;
   my @c = $self-> cursor;
   $self-> SUPER::set_cursor(@_);
   return if $c[0] == $_[0] && $c[1] == $_[1];
   $self-> owner-> {status}-> reset if $self-> owner-> {status} && !$self->change_locked;
}

sub push_mark
{
   my $self = $_[0];
   $self-> add_marker( $self-> cursor);
}

sub pop_mark
{
   my $self = $_[0];
   my $m = $self-> markers;
   return if scalar @{$m} == 0;
   $self-> cursor( @{$$m[-1]});
   $self-> delete_marker( -1);
}

package EditorWindow;
use vars qw(@ISA);
@ISA = qw(Prima::Window);

sub profile_default
{
   my %def = %{$_[ 0]-> SUPER::profile_default};
   return {
      %def,
      fileName => undef,
      utf8     => $can_utf8,
      menuItems => [
         [ '~File' => [
            [ '~New'        => q(new_window)],
            [ '~Open...'    => 'F3' => kb::F3, q(open_file)],
            [ '~Save'       => 'F2' => kb::F2, q(save_file)],
            [ 'Save ~as...' => q(save_as)],
            [],
             ['E~xit'        => 'Alt+X' => '@X' => sub {$::application-> close}]
         ]],
        [ '~Edit' => [
            ['~Cut'   => 'Ctrl+Del'   => kb::NoKey, sub{$_[0]->{editor}->cut}],
            ['C~opy'  => 'Ctrl+Ins'   => kb::NoKey, sub{$_[0]->{editor}->copy}],
            ['~Paste' => 'Shift+Ins'  => kb::NoKey, sub{$_[0]->{editor}->paste}],
            ['~Delete' => 'Shift+Del' => kb::NoKey, sub{$_[0]->{editor}->delete_block}],
            [],
            ['~Find...' => 'Esc'      => kb::Esc   , q(find)],
            ['~Replace...'=> 'Ctrl+S' => '^S'      , q(replace)],
            ['Find ~next' => 'Ctrl+L' => '^L'      , q(find_next)],
            [],
            ['~Undo' => 'Alt+Backspace' => kb::NoKey   , sub {$_[0]->{editor}->undo}],
            ['~Redo' => 'Ctrl+R'        => kb::NoKey   , sub {$_[0]->{editor}->redo}],
        ]],
        ['~Options' => [
            [ 'syx' => '~Syntax hilite' => sub{ $_[0]->{editor}-> syntaxHilite( $_[0]->menu-> syx-> toggle)}],
            [ '*aid' => '~Auto indent' => sub{ $_[0]->{editor}-> autoIndent( $_[0]->menu-> aid-> toggle)}],
            [ 'wwp' => '~Word wrap' => sub{ $_[0]->{editor}-> wordWrap( $_[0]->menu-> wwp-> toggle)}],
            [ 'psb' => '~Presistent blocks' => sub{ $_[0]->{editor}-> persistentBlock( $_[0]->menu-> psb-> toggle)}],
            [],
            [ '*hsc' => '~Horizontal scrollbar' => sub{ $_[0]->{editor}-> hScroll( $_[0]->menu-> hsc-> toggle)}],
            [ '*vsc' => '~Vertical scrollbar'   => sub{ $_[0]->{editor}-> vScroll( $_[0]->menu-> vsc-> toggle)}],
            [],
	    (
	       $can_utf8 ? 
	       ['utf'  => 'UTF-8 mode' => sub { $_[0]-> {utf8} = $_[0]-> menu-> utf-> toggle }] :
	       ()
	    ),
            [ 'Set ~font' => q(setfont)],
        ]]
      ],
   }
}

my $windows = 0;

sub init
{
   my $self = shift;
   my %profile = $self-> SUPER::init(@_);
   my $fn = $profile{fileName};
   my $cap = '';
   $self-> menu-> utf-> check if $self-> {utf8} = $profile{utf8};
   if ( defined $fn) {
      if ( open FILE, '<'.($profile{utf8} ? 'utf8' : ''), $fn) {
         if ( ! defined read( FILE, $cap, -s $fn)) {
            Prima::MsgBox::message("Cannot read file $fn:$!");
            $fn = undef;
         }
         close FILE;
      } else {
         Prima::MsgBox::message("Cannot open file $fn:$!");
         $fn = undef;
      }
   }
   $fn = '.Untitled' unless defined $fn;
   $self-> {editor} = $self-> insert( Editor =>
      name      => 'Edit',
      textRef   => \$cap,
      origin    => [ 0, 22],
      size      => [ $self-> width, $self-> height - 22],
      hScroll   => 1,
      vScroll   => 1,
      growMode  => gm::Client,
   );
   undef $cap;
   $self-> text( $fn);
   $self-> {status} = $self-> insert( Indicator =>
      name    => 'StatusBar',
      width   => $self-> width,
      editor  => $self-> {editor},
   );
   $self-> {editor}-> focus;
   $self-> {findData} = undef;
   $windows++;
   return %profile;
}


sub on_close
{
   my $self = $_[0];
   if ( $self-> {editor}-> modified) {
      my $r =  Prima::MsgBox::message_box(
          $self-> text,
          'File '.$self-> text. ' has been modified.  Save?',
          mb::YesNoCancel|mb::Warning);
      return if mb::No == $r;
      $self-> clear_event, return if mb::Cancel == $r;
      $self-> clear_event, return unless $self-> save_file;
   }
}

sub on_destroy
{
   $::application-> close unless --$windows;
}

sub new_window
{
   my $self = $_[0];
   my $ww = EditorWindow-> create(
      size   => [$self-> size],
      left   => $self-> left + 10,
      bottom => $self-> bottom - 10,
      font   => $self-> font,
      utf8   => $self-> {utf8},
   );
   $ww-> {editor}-> focus;
   return $ww;
}

sub open_file
{
   my $self = $_[0];
   my $f = Prima::open_file;
   if ( defined $f) {
      my $ww = EditorWindow-> create(
         size     => [$self-> size],
         left     => $self-> left + 10,
         bottom   => $self-> bottom - 10,
         fileName => $f,
         font     => $self-> font,
	 utf8     => $self-> {utf8},
      );
      $ww-> {editor}->focus;
   }
}

sub save_file
{
   my $self = $_[0];
   return $self-> save_as if $self-> text eq '.Untitled';
   my $fn = $self-> text;
   if ( open FILE, '>'.($self->{utf8} ? 'utf8' : ''), $fn) {
      my $cap = $self->{editor}->text;
      Encode::_utf8_off($cap) if $can_utf8 and !$self->{utf8};
      my $swr = syswrite(FILE,$cap,length($cap));
      close FILE;
      unless (defined $swr && $swr==length($cap)) {
          undef $cap;
          unlink $fn;
          Prima::MsgBox::message_box( $self-> text, "Cannot save to $fn", mb::Error|mb::OK);
          return 0;
      }
      undef $cap;
      $self-> {editor}-> modified(0);
      $self-> {status}-> reset;
      return 1;
   } else {
      Prima::MsgBox::message_box( $self-> text, "Cannot save to $fn", mb::Error|mb::OK);
   }
   return 0;
}

sub save_as
{
   my $self = $_[0];
   my $fn = Prima::save_file;
   my $ret = 0;
   if ( defined $fn) {
SAVE: while(1){
         next SAVE unless open FILE, '>'.($self->{utf8} ? 'utf8' : ''), $fn;
         my $cap = $self->{editor}->text;
         Encode::_utf8_off($cap) if $can_utf8 and !$self->{utf8};
         my $swr = syswrite(FILE,$cap,length($cap));
         close FILE;
         unless (defined $swr && $swr==length($cap)) {
            undef $cap;
            unlink $fn;
            next SAVE;
         }
         undef $cap;
         $self-> {editor}-> modified(0);
         $self-> {status}-> reset;
         $self-> text( $fn);
         $ret = 1;
         last;
      } continue {
          last SAVE unless mb::Retry == Prima::MsgBox::message_box( $self-> text, "Cannot save to $fn",
                       mb::Error|mb::Retry|mb::Cancel);
      }
   }
   return $ret;
}

my $findDialog;

sub find_dialog
{
   my ( $self, $findStyle) = @_;
   my %prf;
   %{$self->{findData}} = (
      replaceText  => '',
      findText     => '',
      replaceItems => [],
      findItems    => [],
      options      => 0,
      scope        => fds::Cursor,
   ) unless defined $self-> {findData};
   my $fd = $self-> {findData};
   my @props = qw(findText options scope);
   push( @props, q(replaceText)) unless $findStyle;
   if ( $fd) { for( @props) { $prf{$_} = $fd->{$_}}}
   $findDialog = Prima::FindDialog-> create unless $findDialog;
   $findDialog-> set( %prf, findStyle => $findStyle);
   $findDialog-> Find-> items($fd->{findItems});
   $findDialog-> Replace-> items($fd->{replaceItems}) unless $findStyle;
   my $ret = 0;
   my $rf  = $findDialog-> execute;
   if ( $rf != mb::Cancel) {
      { for( @props) { $self->{findData}->{$_} = $findDialog->$_()}}
      $self->{findData}->{result} = $rf;
      $self->{findData}->{asFind} = $findStyle;
      @{$self->{findData}->{findItems}} = @{$findDialog-> Find-> items};
      @{$self->{findData}->{replaceItems}} = @{$findDialog-> Replace-> items} unless $findStyle;
      $ret = 1;
   }
   return $ret;
}

sub do_find
{
   my $self = $_[0];
   my $e = $self-> {editor};
   my $p = $self-> {findData};
   my @scope;
   FIND:{
      if ( $$p{scope} != fds::Cursor) {
         if ( $e-> has_selection) {
           my @sel = $e-> selection;
           @scope = ($$p{scope} == fds::Top) ? ($sel[0],$sel[1]) : ($sel[2], $sel[3]);
         } else {
           @scope = ($$p{scope} == fds::Top) ? (0,0) : (-1,-1);
         }
      } else {
         @scope = $e-> cursor;
      }
      my @n = $e-> find( $$p{findText}, @scope, $$p{replaceText}, $$p{options});
      if ( !defined $n[0]) {
         Prima::MsgBox::message("No matches found");
         return;
      }
      $e-> cursor(($$p{options} & fdo::BackwardSearch) ? $n[0] : $n[0] + $n[2], $n[1]);
      $e-> selection( $n[0], $n[1], $n[0] + $n[2], $n[1]);
      unless ( $$p{asFind}) {
         if ( $$p{options} & fdo::ReplacePrompt) {
            my $r = Prima::MsgBox::message_box( $self-> text,
             "Replace this text?",
             mb::YesNoCancel|mb::Information|mb::NoSound);
            redo FIND if ($r == mb::No) && ($$p{result} == mb::ChangeAll);
            last FIND if $r == mb::Cancel;
         }
         $e-> set_line( $n[1], $n[3]);
         redo FIND if $$p{result} == mb::ChangeAll;
      }
   }
}

sub find
{
   my $self = $_[0];
   return unless $self-> find_dialog(1);
   $self-> do_find;
}

sub replace
{
   my $self = $_[0];
   return unless $self-> find_dialog(0);
   $self-> do_find;
}


sub find_next
{
   my $self = $_[0];
   return unless $self->{findData};
   $self-> do_find;
}

my $fontDialog;

sub setfont
{
   my $self = $_[0];
   $fontDialog = Prima::FontDialog-> create() unless $fontDialog;
   $fontDialog-> logFont( $self-> font);
   return unless $fontDialog-> execute;
   $self-> font( $fontDialog-> logFont);
}

package Generic;

my @fn = @ARGV;
@fn = (undef) unless scalar @fn;

for ( @fn) {
my $w = EditorWindow-> create(
   origin => [ 10, 100],
   size   => [ $::application-> width - 820, $::application-> height - 150],
   fileName => $_,
);
}

run Prima;
