KiwiScript

MeatballWiki | RecentChanges | Random Page | Indices | Categories
Just posting this here for now to see if people are interested. If they are, I'll put it on SourceForge. Try it! -- TarQuin
I tested it. Very simple, but works fine as a WikiAsNotepad. I'd like to see it on SourceForge offcially. HelgeMeier
Thanks :) I've improved it some more lately. I'm looking into putting it on SF. "kiwi" is, as expected, already taken. I'm pondering "Apteryx". -- TarQuin
You got to be kidding about the name! That name would kill the project in its childhood. I like your script because I am looking for a WikiAsNotepad for my PocketPC. There is a perl-TK implementation at perl.org. But to use it, the menus in KiwiScript would have to go away. They are not supported. I could also use EmacsWiki, but probably your script is better because EmacsWiki will probably not have support for clicking on links with the PDA-pen. At least for me one feature would be very important for KiwiScript: Square-bracket wiki links. HelgeMeier
button2 runs emacs-wiki-follow-name-at-mouse -- merriam
: Well.... I could just call it "Wikipad"... except it's taken :( any ideas for a name? I've implemented a "-nomenu" command-line switch. It now also remembers which file you were editing when you exited, and wiki-link making is more automatic. I've added FreeLinks to my list of future enhancements. I'll request space on SourceForge, as soon as I have a name, so I'll hopefully not be squatting here for long. - t PS how about "SoloWiki?"?
#!/usr/bin/perl
# kiwi - a wiki notepad application
# by tarquin
use warnings;
use strict;

use Tk;
use Tk::Text;
use Tk::Dialog;
use Tk::Font;

# use File::Spec::Functions; # see Camel p 624
use File::Basename; # see Camel p 624

use Data::Dumper;

################################ variables
my $configFile = 'kiwiconfig.txt';
my $fileExtension = '.txt';
my $linkpattern = '[[:upper:]]+[[:lower:]]+[[:upper:]][[:alpha:]]*';

my $currentLongFile; # better version

my $wikitext = <<'EOT';
Welcome to Kiwi.
Just clear this text and start typing. Then save this file into the directory where you want to store your wiki.
EOT

################################ main widgets
my $mw = new MainWindow -title => "kiwi";
my $font = $mw->Font(
  -family => 'Times',
  -size => '12',
  );
# Text widget
my $text = $mw->Scrolled( 'Text', 
  -scrollbars => 'osoe',
  -width      => 60,
  -height     => 30,
  -wrap       => 'word',
  -font       => $font
  );
# status bar widget
my $statustext;
my $statusbar = $mw->Label(
  -textvariable => \$statustext, 
  -anchor     => 'w',
  #-background => '#aaaaaa',
  -relief     => 'groove',
  -padx       => '4',
  -font       => $mw->Font(
    -family => 'Helvetica',
    -size   => '12',
    -weight  => 'bold',
    )
  );
# geometry setup
=pod
$statusbar->pack( -side => 'top' );
$text->pack(
  -fill => 'both', -expand => 1
  ); 
=cut

$statusbar->grid(-sticky => 'new');
$text->     grid(-sticky => 'nsew');

$mw->gridRowconfigure(   1, -weight => 1); 
$mw->gridColumnconfigure(0, -weight => 1);

  
  

################################ configuration
if ( -f $configFile ) {
  print "found config\n";
  open CONFIG, "<$configFile";
  while (<CONFIG>) {
    /^(File=)/ and do {
      s/$1//;
      chomp;
      $currentLongFile = $_;
      print "Current file: >$currentLongFile<\n";
    };
  }
  close CONFIG;
}

sub storeConfig {
  open CONFIG, ">>$configFile"; # create if doesn't exist
  open CONFIG, "+<$configFile";
  
  my %config;
  while (<CONFIG>) {
    print "read: $_";
    chomp;
    %config = (%config, split /=/);
  }
  
  # now put in the current config
  $config{File}=$currentLongFile;
  
  open CONFIG, ">$configFile"; # why won't +< work?
  
  foreach (keys %config) {
    print CONFIG "$_=$config{$_}\n";
    print "storing: $_=$config{$_}\n";
  }
  close CONFIG;
}

sub setCurrentFileFromName {
  my $name = shift;
  # obsolete
  
}

################################ dialogs
my $helpdialog = $mw->Dialog(
  -title   => 'Kiwi help',
  -text    => qq[Just start typing. You'll need to save your current page before you go any further. This will set the working directory for your current wiki.\n\n
  You can move to a new wiki at any time by opening a new file in another directory.\n\n
  Make links to pages by typing words in CamelCase. Click on them to either go to the existing page, or create a new page with this title.\n\n
  Links will be made automatically as you type, but in case they're not, you can select Wiki->Refresh links to update them.\n\n
  THINGS TO AVOID: don't type within links.],
  -buttons => ['OK'],
  -font => $mw->Font(
    -family => 'Helvetica',
    -size => '10',
  )
);

################################ menus
unless ( grep { $_ eq '-nomenu' } @ARGV ) {
  sub buildMainMenu {
    my $menu = $mw->Menu(-type => 'menubar');
    $mw->configure(-menu => $menu );

    # menu items
    my $file = $menu->cascade(-label => '~File', -tearoff => 0);
      $file->command(
        -label => '~New', 
        -command => \&newCommand,
        -accelerator =>"Ctrl+N"
      );
      $file->command(
        -label => '~Open ...', 
        -command => \&openCommand,
        -accelerator =>"Ctrl+O"
      );
      #$file->command(-label => 'New',         -command => [\&menus_error, 'New']);
      $file->command(
        -label => '~Save',
        -command => \&saveCommand,
        -accelerator =>"Ctrl+S"
      );
      $file->command(
        -label => 'Save ~As ...', 
        -command => \&saveAsFile,
        -accelerator =>"Ctrl+Shift+S"
      );
      $file->command(
        -label => 'E~xit', 
        -accelerator =>"Ctrl+Q",
        -command => \&exitCommand
      );
    #my $edit = $menu->cascade(-label => '~Edit', -tearoff => 0);
    #  $edit->command(-label => 'Find ...',      -command => \&testfind );
    my $wiki = $menu->cascade(-label => '~Wiki', -tearoff => 0);
      $wiki->command(
        -label => 'Refresh links',
        -command => \&makeWikiLinks,
        -accelerator =>"Ctrl+R"
      );
      $wiki->command(
        -label => 'Rebuild page list',
        -command => sub{ deletePageList(); buildPageList(); },
      );
      $wiki->separator();
    my $help = $menu->cascade(-label => '~Help', -tearoff => 0);
      $help->command(-label => 'Help ...',      -command => sub { $helpdialog->Show } );
      $help->command(-label => 'About ...',      -command => sub {
        $mw->messageBox(
          -title   => 'About Kiwi',
          -message    => 'Kiwi is a WikiWiki-style notepad application written in Perl/Tk.',
          -type => 'OK')
        } );
    my $debug = $menu->cascade(-label => '~Debug', -tearoff => 0);
      $debug->command(-label => 'Dump',      -command => \&DumpMenus );
      $debug->command(-label => 'Clear page list', -command => \&deletePageList );
      $debug->command(-label => 'Insert to page list', -command => \&insertinPageList );
      $debug->command(-label => 'Build here', -command => sub { print "building...\n"} );
    
    return $menu;
  }
  
  sub buildContextMenu {
    my $menu = $mw->Menu(-type => 'menubar');
    $menu->command(-label => 'Refresh links', -command => \&makeWikiLinks );
    $menu->command(-label => 'Open ...',      -command => \&openCommand );

    return $menu;
  }
  
  # menu widgets
  my $mainmenubar = buildMainMenu();
  #$mw->configure(-menu => buildMainMenu() );
  $text->menu( buildContextMenu() );
  
  
  # examining menu
  sub DumpMenus {
    #print $mw->menu, "\n";
    #print $mainmenubar, "\n";

    my $submenu = $mainmenubar->entrycget('Debug', -menu);
    print "$submenu\n";
    $submenu->add('command', -label => 'Added', -command => sub { print "cool...\n" } );
    
    print "menu from mw: ", $mw->cget('-menu'), "\n";
    print "menubar direct: $mainmenubar\n";
  }
  #DumpMenus();
  #exit;

} # end -nomenu conditional

sub buildPageList {
  # when should this be called?
    # app load if a file is loaded from config setting
    # open new page in new directory
    # save file into a new directory
    # user request

  return unless $currentLongFile;
  return if ( grep { $_ eq '-nomenu' } @ARGV ); # no menus - not relevant
  
  # we suppose the page list is currently empty

  my $submenu = $mw->cget('-menu')->entrycget('Wiki', -menu);
  my ($name,$path,$ext) = fileparse( $currentLongFile, $fileExtension);

  opendir THISDIR, $path;
  my @wikipages;
  foreach (readdir THISDIR) {
    /($linkpattern)$fileExtension/ and push @wikipages, $1;
  }
  closedir THISDIR;

  print "pages: @wikipages\n";

  for my $page (sort @wikipages) {
    $submenu->add('command', -label => $page, -command => [\&linkClick, '', $page] );
  }

}
sub deletePageList {
  my $submenu = $mw->cget('-menu')->entrycget('Wiki', -menu);
  
  $submenu->delete(3, 'end'); # remember to keep the 3 synchronized with the menu contents!
}
sub insertinPageList {
  my $newitem = shift;
  
  my $submenu = $mw->cget('-menu')->entrycget('Wiki', -menu);
  my @menuitems;
  for (3 .. $submenu->index('end') ) {
    # remember to keep the 3 synchronized with the menu contents!
    # print "got item ", $submenu->entrycget($_, -label), "\n";
    if ( $submenu->entrycget($_, -label) gt $newitem ) {
      # print "stopping at $_\n";
      $submenu->insert($_, 'command', 
        -label => $newitem, 
        -command => [\&linkClick, '', $newitem]);
      
      last;
    }
  }
}

################################ construction

######### bindings 
# menu shortcuts
$mw->bind("<Control-n>" => \&newCommand );
$mw->bind("<Control-o>" => \&openCommand );
$mw->bind("<Control-s>" => \&saveCommand );
$mw->bind("<Control-S>" => \&saveAsFile ); 
$mw->bind("<Control-r>" => \&makeWikiLinks ); # HELP! not good, inserts a control character

$mw->bind("<Control-q>" => \&exitCommand );
$mw->protocol('WM_DELETE_WINDOW', \&exitCommand);

# auto wiki-linking
$mw->bind("<space>"     => \&checkLatestLink );
$mw->bind("<Return>"    => \&checkLatestLink );

# insert document given in config or default text
if( $currentLongFile && -f $currentLongFile) {
  openFile(); # load the file (will also set status text and make links)
  buildPageList(); # built the page list in the menu
}
else {  
  $text->insert('0.0' , $wikitext);
  makeWikiLinks();
  $statustext = 'Welcome (no document)';
}


########## tag setup

# configure general tag
$text->tagConfigure('wikilink', 
  -relief     => 'raised', 
  -foreground => '#8888ff',
  -underline  => '1',
  );

$text->tagBind('wikilink', '<Key>', \&killLink );

############################### mark wiki links
{
  my %storedlinks; # stores the wikilinks we've already seen and bound

  sub makeWikiLinks {
    # scans entire text for links. tags them and registers new tags
    my($current, $length) = ('1.0', 0);
    my $linkpattern = '[[:upper:]]+[[:lower:]]+[[:upper:]][[:alpha:]]*';
    my @foundLinks;
    
    # find and tag
    # search routine from widget demo
    while (1) {
      $current = $text->search(
        -count => \$length, 
        -regexp => $linkpattern, $current, 'end');
      last if not $current;
      
      my $linktext = $text->get($current, "$current + $length char");
      print "$current - $current + $length char - $linktext\n";
      
      tagTextAsLink($linktext, $current, $length);
      push @foundLinks, $linktext; 
      
      $current = $text->index("$current + $length char");
    }
    bindTaggedLinks( grep !exists $storedlinks{$_}, @foundLinks );
      # check we've not already seen this link
    return;
  }
  sub checkLatestLink {
    # check if the last entered word is a link
    
    # insert method
    my $wordstart = $text->index('insert -2 chars wordstart');
    my $wordend   = $text->index('insert -2 chars wordend');
    
    print "worstart: ", $text->get('insert -1 chars wordstart'), "\n";
    my $lastword = $text->get('insert -2 chars wordstart', 'insert -2 chars wordend');
    print "Spacebar, got: >$lastword<\n";

    # search method
    my $length;
    my $index = $text->search( '-backwards',
      -count => \$length, 
      -regexp => '\b\w+\b',  # grab last word
      'insert', '0.0');
    my $found = $text->get($index, "$index + $length char");
    print "search found: >$found<\n";
    

    return unless $lastword =~ m/[[:upper:]]+[[:lower:]]+[[:upper:]][[:alpha:]]*/;
    
    tagTextAsLink($lastword, $wordstart, $wordend);
    bindTaggedLinks($lastword) unless exists $storedlinks{$lastword};
  }
  
  # helper subs
  
  sub tagTextAsLink {
    my ( $linktext, $start, $end ) = @_;
    unless ( $end =~ m/\./ ) {
      # if $end is not "line.char" then it's an offset
      $end = $text->index("$start + $end char");
    }
    # tag as general and specific
    $text->tag('add', 'wikilink', $start, $end);
    $text->tag('add', $linktext, $start, $end);
    print "Tagging $linktext\n";
  }
  sub bindTaggedLinks {
    for my $taggedlink (@_) {
      $text->tagBind($taggedlink, '<1>', [ \&linkClick, $taggedlink, Ev('x'), Ev('y'), Ev('@') ] );
      $text->tagBind($taggedlink, '<Any-Enter>' => 
        sub { 
          $text->tagConfigure($taggedlink, -background => '#ffff00');
          $text->configure(qw/-cursor hand2/);
        }
      );
      $text->tagBind($taggedlink, '<Any-Leave>' => 
        sub { 
          $text->tagConfigure($taggedlink, -background => undef);
          $text->configure(qw'-cursor xterm');
        }
      );
      $storedlinks{$taggedlink} = '';
      print "Binding $taggedlink\n";
    }
  }
  sub killLink {
    print "typing in link\n";
    

=pod
For typing within tags, need to:
get position of insert mark
$text->tagNames(?index?) # find the tag

@x,y wordstart and wordend to grab whole word

$text->tagRanges(tagName); # grab ranges
find which range is there


=cut
    
  }
  
} # end of scoped block for wiki link making subs  

############################### page navigation
sub linkClick {
  # user clicks a wiki link
  shift;
  my $link = shift;
  print "clicked link $link\n";
  print 'Ev: ', join ', ', @_, "\n"; # shift, ', ', shift;
  
  
  unless ( $currentLongFile ) {
    my $noDirDialog = $mw->Dialog(
      -title   => q[Can't follow wiki link!],
      -text    => q[Can't follow links until you've saved this page to set the working directory. Do you want to save this page now and then follow the link?)],
      -buttons => ['Save page', 'Cancel'], #  'Save and follow link',
      -bitmap  => 'info'
    );
    my $answer = $noDirDialog->Show;
    return if $answer eq 'Cancel';
    print "saving...\n";
    saveAsFile() or return; # in case of cancellation
    # return if $answer eq 'Save page';
    # now continue with clicking...
  }
  saveFile();
  
  # work out what to open
  my ($name,$path,$ext) = fileparse( $currentLongFile, $fileExtension);
  
  $currentLongFile = $path . $link . $ext;
  
  if (-f $currentLongFile) {
    # determine if file exists or not
    openFile();
    $statustext = $link;
  } 
  else {
    newFile();
    $statustext = $link . ' - unsaved';
    insertinPageList($link);
  }
  return;
}
sub newCommand {
  # ask to save first?
  $text->delete('1.0','end');
  $currentLongFile = '';
  $statustext = 'New file (untitled, unsaved)';
}
sub openCommand {
  # user selects 'Open' from a menu
  my $open = $mw->getOpenFile(-filetypes=>[['Wiki pages',"*$fileExtension"],['All Files','*.*']]) 
    or return; # for user cancelation
  
  my $needRefresh;
  if( $currentLongFile ) {
    saveFile(); # later ask user if they want to lose changes
    # delete page list if new path...
    if( [fileparse( $open, $fileExtension)]->[1] 
        ne 
        [fileparse( $currentLongFile, $fileExtension)]->[1]
      ) {
        print "changed dir!\n";
        deletePageList();
        $needRefresh = 1;
      }
  }
  
  $currentLongFile = $open;
  buildPageList() if $needRefresh;
  
  openFile(); 
}

sub openFile {
  # with $currentLongFile set, open it and present the text
  
  return unless $currentLongFile; # should never come here without it?
  print "opening $currentLongFile ...\n";
  
  $text->delete('1.0','end');
  open FILE, "<$currentLongFile";
  while (<FILE>) {
    $text->insert('end',$_);
  }
  close FILE;
  $statustext = [fileparse( $currentLongFile, $fileExtension)]->[0] ; #$link;
  makeWikiLinks();
}
sub saveCommand {
  if ( $currentLongFile ) {
    saveFile();
  }
  else {
    saveAsFile() or return;
  }
  $statustext = [fileparse( $currentLongFile, $fileExtension)]->[0] ; #$link;
  # makeWikiLinks(); # needed here?
}

sub saveFile {
  open FILE , ">$currentLongFile";
  my $wikitext = $text->get('1.0','end');
  chomp $wikitext; # otherwise we add a \n to every saved file - DIRTY HACK!
  print FILE $wikitext;
  
  print "saving: $currentLongFile\n";
  close FILE;
  
  # should determine if this is the first save of a file
  # if so, add to page list
}

sub saveAsFile {
  my $savedFile = $mw->getSaveFile(-defaultextension => 'txt');
    # messy! -defaultextension doesn't take the initial dot!
  return 0 unless $savedFile;
  
  if( $currentLongFile ) {
    # delete page list if new path...
    if( [fileparse( $savedFile, $fileExtension)]->[1] 
        ne 
        [fileparse( $currentLongFile, $fileExtension)]->[1]
      ) {
        print "changed dir!\n";
        deletePageList();
      }
    else {
      # same directory
      # should add this page to the menu list
    }
  }
  
  
  $currentLongFile = $savedFile;
  # need to set page name too
  
  print "save as $savedFile\n";
  saveFile();
  $statustext = [fileparse( $currentLongFile, $fileExtension)]->[0] ;
  
}

sub newFile {
  $text->delete('1.0','end');
  
}

sub exitCommand {
  storeConfig();
  if ( $currentLongFile ) {
    saveFile();
  }
  print "bye!\n";
  exit;
}

###############################
MainLoop;
KiwiScript

Discussion
