PerlMonks Editor

[GrandFather]

This is the first cut of a PerlMonks offline wysiwyg editor. It may be used to wysiwig edit material for posting on PerlMonks and generates the common HTML and PerlMonks special tags used in PerlMonks node markup.

The code uses Tk and should be reasonably cross platform.

This first cut is missing a lot of functionality but is being posted to garner initial reactions and make it available to the curious (I'm off on holiday for a few days and won't be able to work on it for another week).

Important missing stuff includes - no readmore handling, save/open partially implemented (and disabled), keyboard accelerators not working (and disabled), much markup not hooked up.

Basic use entails using the editor to generate the material to be posted, then using File|Render to render the marked up material to the clipboard so that it can be pasted into the edit field of the node being written or edited.

Update: brief use description added

use strict;
use warnings;
use diagnostics;

use Tk;
#use Tk::TextUndo;
use Tk::Balloon;
use Tk::Clipboard;
use Tk::FBox;
use Clone qw(clone);

=head Todo

Provide file open and save
Manage B, F, I, P, R and U flags
Translate entities (note U flag)
Handle accelerator keys
Support snippet text (with formatting)
Disallow relink
Checkmarks for menus
handle tables
hook up keys
Add Edit menu to access find and replace etc

=cut

use constant kParaSpace => 4;

my $currentFile = '';
my %tagTypes;       # Style tag data
my %formatFonts;    # Fonts used in style tags. Keyed by tag
my %bindings;       # Key, menu and toolbar bindings. Tag is value
my %menuItems;      # Child menu widgets keyed by menu label path
my %entities =      # Entities we need to use outside code blocks
    (
    '&', '&',
    '<', '&lt;',
    '>', '&gt;',
    '[', '&#91;',
    ']', '&#93;',
    );
my @stdFlags = (
    'B', # Block level element
    'C', # Clear all or specified tags: C or Ctag (note lower case)
    'F', # Format tag (inline element)
    'I', # Item in a list. Implies B
    'L', # Link
    'P', # Applies to whole paragraph
    'R', # Readmore text
    'S', # Single spaced text
    'U', # Untranslated - don't translate entities
    'X', # Exclude all or specified tags: X or Xtag (note lower case)
    );

while (<DATA>) {
    # Load the default configuration stuff
    chomp;
    next if ! length;
    last if /^#key /;
    next if /^#/;
    
    my ($tag, $htmlTag, $name, $flagsField, @options) = split /\s*,\s*
+/;

    (print "Missing entries in tag line ($.): $_"), next if ! defined 
+$flagsField;

    # pull out flags and handle X and C special case flags
    my %flags;
    @flags{@stdFlags} = (0) x @stdFlags; # Preset flags off
    $flags{'C'} = {};
    $flags{'X'} = {};

    for (split /(?=[A-Z][a-z]*)/, $flagsField) {
        my ($flag, $value) = split /(?<=[A-Z])/, $_;
        
        print "Unhandled flag '$flag' used\n" if ! exists $flags{$flag
+};
        if (-1 != index 'XC', $flag) {
            $flags{$flag}{$value || 'ALL'} = 1;
            $flags{'C'}{$value || 'ALL'} = 1 if $flag eq 'X'; # X impl
+ies C
        } else {
            $flags{$flag} = $value || 1;
            $flags{'B'} = $value || 1 if $flag eq 'I';
        }
    }

    #Fix up options
    my $optionStr = join ', ', @options;
    my %optionHash;
    
    while ($optionStr =~ /\G,?\s*((?:(?!=>).)*)=>\s*(\[[^\]]*\]|[^,]*)
+,?\s*/g) {
        my ($option, $value) = ($1, $2);
        
        trim (\$option, \$value);
        
        if ($value =~ s/\[|\]//g) {
            # Nested options. Turn them into a hash
            my @options = split ',', $value;
            my %optionHash;
            
            for (@options) {
                my ($suboption, $subvalue) = split /\s*=>\s*/;
                
                last if ! defined $subvalue;
                trim (\$suboption, \$subvalue);
                $optionHash{$suboption} = $subvalue;
            }
            
            $value = \%optionHash;
        }
        
        $optionHash{$option} = $value;
    }
    
    $tagTypes{$tag} = [$htmlTag, $name, \%flags, \%optionHash];
}

while (<DATA>) {
    # Load key binding information
    next if /^#/;
    chomp;
    next if ! length;
    
    my ($tag, $key, $menuItem, $toolbarItem, $rightClickItem) = split 
+/\s*,\s*/;
    (print "Missing tag in binding line ($.): $_"), next if ! defined 
+$tag;
    $bindings{$tag} = [$key, $menuItem, $toolbarItem, $rightClickItem]
+;
}

my $mw = MainWindow->new (-title => "PerlMonks node editor");
my $text = $mw->Scrolled
    ('Text', -font => 'normal', -wrap => 'word', -scrollbars => 'e',);

my $status = $mw->Label(-width => 60, -relief => "sunken", -bd => 1, -
+anchor => 'w');
my $balloon = $mw->Balloon(-statusbar => $status);
my $msg = '';
my $balloonCharIndex = '';
my $balloonLastIndex = '';

$status->pack(-side => "bottom", -fill => "both", -padx => 2, -pady =>
+ 1);
#$balloon->attach
#    (
#    $text, -msg => \$msg,
#    -balloonposition => 'mouse',  # Not really used since the postcom
+mand returns the real position.
#    -postcommand => \&balloonPostCommand,
#    -motioncommand => \&balloonMotionCommand,
#    );

my $menuBar = $mw->Menu (-type => 'menubar');

$mw->configure(-menu => $menuBar);
$text->pack (-expand => 'yes', -fill => 'both');

# Build file menu
$menuItems{'~File'} = $menuBar->cascade(-label => '~File', -tearoff =>
+ 0);
$menuItems{'~File'}->command (-label => '~Render', -command => \&fileR
+ender);
#$menuItems{'~File'}->command (-label => '~Open...', -command => \&fil
+eOpen);
#$menuItems{'~File'}->command (-label => '~Save', -command => \&fileSa
+ve);
#$menuItems{'~File'}->command (-label => 'Save ~As...', -command => \&
+fileSaveAs);
$menuItems{'~File'}->command (-label => 'E~xit', -command => \&fileExi
+t);

# Build menus and bind keys
for my $tag (keys %bindings) {
    my $menuPath = $bindings{$tag}[1];

    next if ! defined $menuPath;

    my ($top, $item) = split '/', $menuPath;
    
    next if ! defined $item;
    if (! defined $menuItems{$top}) {
        $menuItems{$top} = $menuBar->cascade(-label => $top, -tearoff 
+=> 0);
    }
    
    my $newItem = $menuItems{$top}->command
        (-label => $item, -command => [\&doCommand, $tag]);
    
    if (defined $bindings{$tag}[0]) {
        #Set up accelerator bindings
        
        #my $key = $bindings{$tag}[0];
        #
        #$mw->bind ("<$key>" => [\&keyCommand, $tag]);
        #
        #$key =~ s/^Control/ctrl/;
        #$newItem->configure (-accelerator => $key);
    }
}

$menuItems{'~Help'} = $menuBar->cascade(-label => '~Help', -tearoff =>
+ 0);
$menuItems{'~Help'}->command (-label => '~PerlMonks Editor Help', -com
+mand => \&help);
$menuItems{'~Help'}->command (-label => '~About', -command => \&about)
+;

# A couple of phantom paragraph spacing tags to ease calculating parag
+raph spacing
$text->tagConfigure("!para_start", -spacing1 => 0, -spacing3 => -(kPar
+aSpace));
$text->tagConfigure("!para_end", -spacing1 => -(kParaSpace), -spacing3
+ => 0);

$text->insert ('end', "Some text to play with.\n", '!para');
$text->insert ('end', "Some more text to play with. Some more text to 
+play with.\n", '!para');
#$mw->bind ("<$key>" => [\&keyCommand, $tag]);

MainLoop ();

sub balloonPostCommand {
    return 0 if ! length $balloonCharIndex;
    
    my %balloonCharTags;
    my  $charIndex = $text->index ("$balloonCharIndex +1 char");
    
    @balloonCharTags{$text->tagNames()} = ($balloonCharIndex);
    
    # If no tags under mouse don't post the balloon.
    return 0 if ! %balloonCharTags;
    
    if (exists $balloonCharTags{name}) {
        my ($start, $end) = $text->tagPrevrange ('name', $balloonCharI
+ndex);
        my $name = $text->get($start, $end);
        
        $name =~ s/\|.*//;
        $msg = "link to [${name}]'s home node";
    } elsif (exists $balloonCharTags{node}) {
        my ($start, $end) = $text->tagPrevrange ('node', $balloonCharI
+ndex);
        my $node = $text->get($start, $end);
        
        $node =~ s/\|.*//;
        $msg = "link to node id $node";
        $msg .= ' (badly formed - digits only allowed)' if $node !~ /^
+\d+$/;
    } else {
        return 0;
    }
    
    my @p = $text->bbox($balloonCharIndex);
    my $x = $text->rootx + $p[0] + $p[2] - 4;
    my $y = $text->rooty + $p[1] + $p[3] + 2;
    print "-$x,$y-\n";
    return "$x,$y";
}

sub balloonMotionCommand {
    my $x = $text->pointerx - $text->rootx;
    my $y = $text->pointery - $text->rooty;
    
    $balloonCharIndex = $text->index ("\@$x,$y");

    # If the same char don't cancel the balloon.
    return 0 if $balloonLastIndex eq $balloonCharIndex;
    
    # New char under mouse - cancel it so a new balloon will be posted
+.
    $balloonLastIndex = $balloonCharIndex;
    print ">$balloonLastIndex<\n";
    return 1;
}

sub fileRender {
    $text->clipboardClear ();
    $text->clipboardAppend (render ());
}

sub fileOpen {
    $currentFile = $text->FBox(-type => 'open', -filter => '*.PMEdit')
+->Show;
    
    open inFile, '<', $currentFile or
        $text->messageBox
            (
            -title => 'Save failed', -icon => 'error',
            -type => 'Ok',
            -message => "Unable to open '$currentFile' - $!"
            );
    my ($html, $name, $mode, $params);
           
    while (<inFile>) {
        my ($type, $index, $item) = /(\S+)\s(\S+)\s(.*)/;
        
        if ($type =~ /^tago(?:n|ff)$/) {
            next if $item =~ /^_/;
            ($html, $name, $mode, $params) = @{$tagTypes{$item}};
        }

        if ($type eq '-tagon') {
            print outFile "-tagon $item $index\n";
        } elsif ($type eq '-tagoff') {
            print outFile "-tagoff $item $index\n";
        } elsif ($type eq '-text') {
            print outFile "-text $item\n";
        } else {
            print "Token type $type at $index not handled.\n";
        }
    }
    
    close inFile;
}

sub fileSave {
    if (defined $currentFile and length $currentFile) {
        doSave ($currentFile);
    } else {
        fileSaveAs ();
    }
}

sub fileSaveAs {
    my $filename = $text->FBox(-type => 'save', -filter => '*.PMEdit')
+->Show;
    doSave ($filename);
}

sub doSave {
    my $filename = shift;
    
    return if ! defined $filename or ! length $filename;
    
    open outFile, '>', $filename or
        $text->messageBox
            (
            -title => 'Save failed', -icon => 'error',
            -type => 'Ok',
            -message => "Unable to create '$filename' - $!"
            );
    my @dumpText = $text->dump ('-tag', '-text', 'start', 'end');
    my ($html, $name, $mode, $params);
    
    while (@dumpText) {
        my ($type, $item, $index) = splice @dumpText, 0, 3;
        
        my $segEnd = exists $dumpText[2] ? $dumpText[2] : 'end';

        if ($type =~ /^tago(?:n|ff)$/) {
            next if $item =~ /^_/;
            ($html, $name, $mode, $params) = @{$tagTypes{$item}};
        }

        if ($type eq 'tagon') {
            print outFile "-tagon $index $item\n";
        } elsif ($type eq 'tagoff') {
            print outFile "-tagoff $index $item\n";
        } elsif ($type eq 'text') {
            print outFile "-text - $item\n";
        } else {
            print "Token type $type at $index not handled.\n";
        }
    }
    
    close outFile;
    $currentFile = $filename;
}

sub fileExit {
    exit 1;
}

sub render {
    my $result;
    my $paragraph;
    my $inCode = 0;
    my @dumpText = $text->dump ('-tag', '-text', '1.0', 'end');
    my ($html, $name, $mode, $params);
    
    while (@dumpText) {
        my ($type, $item, $index) = splice @dumpText, 0, 3;
        
        next if $item =~ m'^(?:sel|para)';
        
        my $segEnd = exists $dumpText[2] ? $dumpText[2] : 'end';

        if ($type =~ /^tago(?:n|ff)$/) {
            next if $item =~ /^(?:_|!)/;
            ($html, $name, $mode, $params) = @{$tagTypes{$item}};
        }
            
        if ($type eq 'tagon') {
            if ($mode->{'L'}) {
                my ($linkCode) = $html =~ /^\S*\s*(.*)/;
                $paragraph .= "[$linkCode";
                next;
            }

            $inCode = 1 if $item eq 'code';
            $paragraph .= "<$tagTypes{$item}[0]>";
        } elsif ($type eq 'tagoff') {
            if ($mode->{'L'}) {
                $paragraph .= ']';
                next;
            }
            
            $paragraph .= "</$tagTypes{$item}[0]>";
            if ($item eq 'code') {
                $inCode = 0;
            } else {
            }
        } elsif ($type eq 'text') {
            $paragraph .= $item;

            if ($paragraph =~ /\n/) {
                if ($inCode) {
                    $result .= $paragraph;
                } else {
                    $paragraph =~ tr/\n//d;
                    if ($paragraph eq '</code>') {
                        $result .= $paragraph;
                        $paragraph = '';
                    }
                    
                    $result .= "<p>$paragraph</p>\n";
                }
                
                $paragraph = '';
            }
        } else {
            print "Token type $type at $index not handled.\n";
        }
    }
    
    $result =~ s|<p></p>|<br>|g;
    return $result;
}

sub keyCommand {
    &doCommand ();
}

sub doCommand {
    my %newTag = (tag => shift);
    my @selections = $text->tagRanges('sel');
    @newTag{'name', 'html', 'flags', 'params'} = @{$tagTypes{$newTag{t
+ag}}};
        
    do {
        if (@selections) {
            my %tags;
            @tags{$text->tagNames($selections[0])} = (); # Preset curr
+ent tags

            $newTag{isOn} = ! exists $tags{$newTag{tag}}; # Complement
+ new tag's curr state
            $tags{$newTag{tag}} ||= $newTag{isOn};
            
            @newTag{'start', 'end'} = splice @selections, 0, 2;
        } else {
            my %activeTags;
            @activeTags{$text->tagNames('insert')} = ();
            return if ! exists $activeTags{$newTag{tag}};
            @newTag{'start', 'end'} = $text->tagPrevrange ($newTag{tag
+}, 'insert');
            $newTag{isOn} = 0;
        }
        
        return if ! defined $newTag{end};
        
        my $msg = $newTag{flags}{L} ? manageLink (%newTag) : updateTex
+tTags (%newTag);

        if (length $msg) {
            $status->configure (-text => $msg);
            return;
        }

        
    } while (@selections);
}

sub updateTextTags {
    my %newTag = @_;
    my @dumpText = $text->dump ('-tag', '-text', $newTag{start}, $newT
+ag{end});
    my @activeTags = $text->tagNames($newTag{start});
    my %tags;
    
    @tags{@activeTags} = (1) x @activeTags; # Preset current tags
    $tags{$newTag{tag}} = $newTag{isOn};

    TOKEN: while (@dumpText) {
        my ($type, $item, $index) = splice @dumpText, 0, 3;
        my $segEnd = exists $dumpText[2] ? $dumpText[2] : $newTag{end}
+;

        if ($type eq 'tagon') {
            $tags{$item} = 1 if $item ne $newTag{tag};
        } elsif ($type eq 'tagoff') {
            $tags{$item} = 0 if $item ne $newTag{tag};
        } elsif ($type eq 'text') {
            my @tagList = grep {! /^_|^sel$/ && $tags{$_}} keys %tags;
            my @removeList = grep {! $tags{$_} || /^_/} keys %tags;

            # Bail if current tags preclude new tag
            for (@tagList) {
                next if ! exists $tagTypes{$_} or $newTag{tag} eq $_;
                my ($Ihtml, $Iname, $Iflags, $Iparams) = @{$tagTypes{$
+_}};
                
                # Check for existing tag that precludes all new tags
                if ($Iflags->{'X'}{'ALL'}) {
                    next TOKEN
                }
                
                # Check for existing tag that precludes $newTag
                if ($Iflags->{'X'}{$newTag{tag}}) {
                    next TOKEN;
                }
            }

            if ($newTag{isOn}) {
                if ($newTag{flags}->{'C'}{'ALL'}) {
                    # Strip all other tags
                    push @removeList, @tagList;
                } elsif (%{$newTag{flags}->{'C'}}) {
                    # Clear specific tags
                    push @removeList, keys %{$newTag{flags}->{'C'}};
                }
                push @tagList, $newTag{tag};
            }

            $text->tagRemove ($_, $index, $segEnd) for @removeList;
            
            @tagList = buildTag (@tagList);
            $text->tagAdd ($_, $index, $segEnd) for @tagList;
            fixParaSpacing ($index);
        } else {
            print "Token type $type at $index not handled.\n";
        }
    }
    
    return '';
}

sub manageLink {
    my %newTag = @_;
    my @activeTags = $text->tagNames($newTag{start});
    my %tags;
    
    if (! $newTag{isOn}) {
        # Remove the link
        $text->tagRemove ($newTag{tag}, $newTag{start}, $newTag{end});
        updateTextTags (%newTag);
        return '';
    }
    
    @tags{@activeTags} = (1) x @activeTags; # Preset current tags
    for (keys %tags) {
        next if ! exists $tagTypes{$_};
        return 1 if $newTag{tag} eq $_ and $newTag{isOn}; # Link alrea
+dy
        
        my ($Ihtml, $Iname, $Iflags, $Iparams) = @{$tagTypes{$_}};
        return "Can't link inside $Iname" if $Iflags->{'X'}{'ALL'};
        return "Can't link inside $Iname" if $Iflags->{'X'}{'link'};
    }
    
    return 'Links must not span line ends.'
        if int ($newTag{start}) != int ($newTag{end});
        
    # Get the link text
    my $orgLinkText = $text->get($newTag{start}, $newTag{end});
    my ($linkStr, $textStr) = $orgLinkText =~ /^([~|]*\|?)(.*)/;
    my $indexStr = "$newTag{start} +" . length ($linkStr) . 'chars';
    my $linkEnd = $text->index ($indexStr);
    my %linkTag = %{clone (\%newTag)};
    my %textTag = %{clone (\%newTag)};

    $linkTag{end} = $linkEnd;
    $textTag{start} = $linkEnd;
    
    updateTextTags (%linkTag);
    updateTextTags (%textTag);
    return '';
}

sub buildTag {
    my %tags;
    
    @tags{@_} = ();
    
    my @tagList = sort keys %tags;
    my $newFormatTag = '_' . join '_', @tagList;
    my %options;
    my %fontParams;
    
    for (@tagList) {
        next if ! exists $tagTypes{$_} || ! ref $tagTypes{$_};

        my ($html, $name, $mode, $params) = @{$tagTypes{$_}};
        next if ! ref $params;
        
        for my $type (keys %$params) {
            if ($type =~ /-font/) {
                for my $subType (keys %{$params->{$type}}) {
                    $fontParams{$subType} = $params->{$type}{$subType}
+;
                }
            } else {
                $options{$type} = $params->{$type};
            }
        }
    }
    
    $options{-font} = buildFont (%fontParams) if %fontParams;
    $text->tagConfigure ($newFormatTag, %options);

    push @tagList, $newFormatTag;
    return @tagList;
}

sub buildFont {
    my %options = @_;
    my $fontName = '';
    
    $fontName .= "$_|$options{$_}," for sort keys %options;
    $fontName =~ tr/-+/mp/;
    $fontName =~ tr/a-zA-Z0-9/mp_/c;
    $mw->fontCreate($fontName, %options) if ! $formatFonts{$fontName}+
++;
    return $fontName;
}

sub fixParaSpacing {
    my $lastLine = ($text->index ('end') =~ /(\d+)/)[0];
    my $lastTailSpace = -(kParaSpace);
    my @paraTags;
    
    push @paraTags, "!para_$_" for (1..$lastLine);
    $text->tagDelete (@paraTags); # Clear current spacing tags
    
    for my $line (1..$lastLine) {
        my $headSpace = kParaSpace;
        my $tailSpace = kParaSpace;
        my @activeTags = $text->tagNames("$line.0");
        
        # Note that this is currently broken if the first character ha
+ppens to be a
        # part of a single spaced style applied to a partial line
        for (@activeTags) {
            next if ! exists $tagTypes{$_} || ! ref $tagTypes{$_};
    
            my ($html, $name, $mode, $params) = @{$tagTypes{$_}};
            next if ! ref $params;
    
            for my $type (keys %$params) {
                $headSpace = $params->{$type} if $headSpace && $type =
+~ /-spacing1/;
                $tailSpace = $params->{$type} if $tailSpace && $type =
+~ /-spacing3/;
            }
        }

        if ($lastTailSpace == -(kParaSpace)) {
            $headSpace = 0;
        } elsif ($lastTailSpace == 0 && $headSpace > 0) {
            $headSpace += kParaSpace;
        } elsif ($lastTailSpace > 0 && $headSpace == 0) {
            $headSpace += kParaSpace;
        }

        $text->tagConfigure("!para_$line", -spacing1 => $headSpace, -s
+pacing3 => $tailSpace);
        $text->tagAdd ("!para_$line", "$line.0");
        $text->tagRaise ("!para_$line");
        $lastTailSpace = $tailSpace;
    }
}

sub trim {
    for (@_) {
        $$_ =~ s/^\s+//;
        $$_ =~ s/\s+$//;
    }
}

sub help {
    my $msg = <<MSG;
This editor is designed to provide wysiwyg editing for PerlMonks.org n
+odes. The
contents of the node is edited off-line and rendered (File|Render) to 
+the
clipboard for pasting into a node's text edit field.

Feedback can be /msged to GrandFather in the first instance. If you pr
+ovide an
email address in your /msg, GrandFather will most likely reply to the 
+email
address.
MSG

    $mw->messageBox (
        -icon => 'info',
        -message => $msg, -title => 'PerlMonks Editor Help',
        -type => 'Ok',
        );
}

sub about {
    my $msg = <<MSG;
PerlMonks Editor

Written by GrandFather for the assistance, pleasure and edification of
+ other
monks.
MSG

    $mw->messageBox (
        -icon => 'info',
        -message => $msg, -title => 'About PerlMonks Editor',
        -type => 'Ok',
        );
}

__DATA__
#tag style definitions
#tag name,HTML tag, UI text, flags, modifiers as key value pairs
big,big,Big font,F,-font => [-size => 16]
bold,b,Bold,F,-font => [-weight => bold]
center,center,Centered text,P,
code,code,Code block,BFXCU,-spacing1 => 0,-spacing3 => 0,-background =
+> #e0e0ff,-font => [-family => courier, -weight => bold]
cpan,link id://,CPAN link,L, -background => #c0c0c0, -foreground => #4
+0e040,
dd,dd,Definition Description,B,
del,del,Deleted Text,F,
dl,dl,Definition List,B,-lmargin1 => 20m, -lmargin2 => 20m, -rmargin =
+> 20m
dt,dt,Definition Term,B,-lmargin1 => 10m, -lmargin2 => 10m, -rmargin =
+> 10m, -font => [-weight => bold]
emphasis,em,Emphasis,F,-font => [-weight => bold]
h3,h3,Header level 3,B,-font => [-size => 24], -background => #c0c0c0,
+-spacing1 => 14
h4,h4,Header level 4,B,-font => [-size => 24], -background => #8080c0,
+-spacing1 => 10
h5,h5,Header level 5,B,-font => [-size => 16], -background => #c0c0c0,
+-spacing1 => 10
h6,h6,Header level 6,B,-font => [-size => 16], -background => #8080c0,
+-spacing1 => 8
hrule,hr,Horizontal rule,BX,
inserted,ins,ins,BF, -background => #ffffc0,
italic,i,Italic,F,-font => [-slant => italic]
item,li,List item,I,
olist,ol,Ordered list,B,-lmargin1 => 20m, -lmargin2 => 20m, -rmargin =
+> 20m
quote,blockquote,Quoted block,P,-lmargin1 => 15m,-lmargin2 => 15m,-rma
+rgin => 15m
readmore,readmore,Read more block,BR,-background => #a0b7ce
small,small,small,F,-font => [-size => 8]
spoiler,spoiler,Spoiler,F, -background => #000000, -foreground => #404
+040,
strike,strike,Strike Out,F,-overstrike => on
strong,strong,Strong emphasis,F,
sub,sub,Sub script,FCsuper,-offset => -2p,-font => [-size => 8]
super,sup,Super script,FCsub,-offset => 4p,-font => [-size => 8]
teletype,Teletype text,tt,F,-font => [-family => courier], -background
+ => #FFFFc0
ulist,ul,Unordered list,B,-lmargin1 => 20m, -lmargin2 => 20m, -rmargin
+ => 20m
underline,u,Underline,F,[-underline => on]],

#links - still tag style definitions
acronym,link acronym://,Acronym link,L, -background => #f0f0f0, -foreg
+round => #0060c0,
cpan,link cpan://,Cpan link,L, -background => #f0f0f0, -foreground => 
+#00a0a0,
dict,link dict://,Dictionary link,L, -background => #f0f0f0, -foregrou
+nd => #00a0a0,
dist,link dist://,CPAN Distro link,L, -background => #f0f0f0, -foregro
+und => #00a0a0,
doc,link doc://,perldoc link,L, -background => #f0f0f0, -foreground =>
+ #00a0a0,
ftp,link ftp://,Ftp link,L, -background => #f0f0f0, -foreground => #00
+a0a0,
google,link google://,Google link,L, -background => #f0f0f0, -foregrou
+nd => #00a0a0,
href,link href://,Href link,L, -background => #f0f0f0, -foreground => 
+#00a0a0,
http,link http://,Http link,L, -background => #f0f0f0, -foreground => 
+#00a0a0,
https,link https://,Https link,L, -background => #f0f0f0, -foreground 
+=> #00a0a0,
id,link id://,Node id link,L, -background => #f0f0f0, -foreground => #
+00a0a0,
isbn,link isbn://,Isbn link,L, -background => #f0f0f0, -foreground => 
+#00a0a0,
jargon,link jargon://,Jargon link,L, -background => #f0f0f0, -foregrou
+nd => #00a0a0,
kobes,link kobes://,Kobes link,L, -background => #f0f0f0, -foreground 
+=> #00a0a0,
lj,link lj://,Live journal link,L, -background => #f0f0f0, -foreground
+ => #00a0a0,
lucky,link lucky://,Google lucky link,L, -background => #f0f0f0, -fore
+ground => #00a0a0,
mod,link mod://,Mod link,L, -background => #f0f0f0, -foreground => #00
+a0a0,
module,link module://,Module link,L, -background => #f0f0f0, -foregrou
+nd => #00a0a0,
name,link,Node name link,L, -background => #f0f0f0, -foreground => #00
+60c0,
pad,link pad://,Scratchpad link,L, -background => #f0f0f0, -foreground
+ => #00a0a0,
perldoc,link perldoc://,Perldoc link,L, -background => #f0f0f0, -foreg
+round => #00a0a0,
pmdev,link pmdev://,Pmdev link,L, -background => #f0f0f0, -foreground 
+=> #00a0a0,
wp,link wp://,Wp link,L, -background => #f0f0f0, -foreground => #00a0a
+0,

#key bindings, menu items and tool bar items
#tag,key,menu item,toolbar item,right click item
big,Control 2,Format/Big,,Big
bold,Control Shift b,Format/Bold,,Bold
italic,Control i,Format/Italic,,Italic
strike,Control s,Format/Strike out,,Strike out
sub,Control u,Format/Subscript,,Subscript
super,Control s,Format/Superscript,,Superscript
code,Control c,Format/Code,,Code
id,,Links/Node,,Node id link
name,,Links/Name,,Name link

[McDarren]

Cool stuff++

After spending 15 minutes writing up a node this morning, and then managing to blow it away by mis-advertently closing the wrong browser tab - (UGH!) - this has come just at the right time :)

One minor asthetic request - the "Format" menu items are obviously toggles. It would be nice to have them "ticked" (or not) as they've been applied.

And one minor annoyance - it seems to convert any linebreak into </p><p>. Wouldn't it be more appropriate (and intuitive) if it only started a new paragraph where there was a blank line separating blocks of text, and convert all other line breaks into <br>?

Example:

This is a line, with a linebreak
And another line directly underneath

# Converts to:
<p>This is a line, with a linebreak<br>
And another line directly underneath</p>

# Where as:
Blah blah some text and random pontification that goes on for a few li
+nes.

Then a new paragraph starts here...

# Converts to:
<p>Blah blah some text and random pontification that goes on for a few
+ lines.</p>

<p>Then a new paragraph starts here...

Cheers,
Darren :)

[VSarkiss]

...blow it away by mis-advertently closing the wrong browser tab...

The coolness of this program notwithstanding, you do know about Undo close tab extension for Firefox, no?

[McDarren]

No, I didn't (obviously :p)
But I do now, thank you very much :)

[GrandFather]

Toward the top of the code is a todo list. Check item 7 in the list :).

I never use <br> when writing PM nodes so I guess I ignored it as a possibility. I find that between code tags and paragraphs I don't find much use for blocks of text that may be wrapped (like paragraphs), but which are single spaced (like code blocks).

For myself I prefer the current behaviour, but a configuration option (the first) could be added to control it.

[radiantmatrix]

Great idea, ++! In fact, it's something I've been toying around with trying as well, I'm glad you beat me to it (I'm not much of a GUI programmer).

I do have one feature suggestion/request. Either (a)include support for entering text in non-rich forms (like Markdown), or (b)provide a plugin text-processing architecture so other people can choose to provide Markdown/WikiText/etc. support. This would ideally be combined with the option to select a "plain text mode" for entry, then render appropriately.

[GrandFather]

Sounds entierly sensible. Have you any suggestions for how? I intend to sort out file save/open as a "next thing" and I guess that is where something would plug in. A "FileLoad" object, or something less formal than that?

[radiantmatrix]

Shooting from the hip here...

I'd be tempted to have such things in two places. First, a config file that maps file extensions to .pm plugins (with, of course, some well-defined interface). For example, I could have .mark map to FileLoad::Plugin::Markdown, then all .mark files would be loaded/saved with that plugin.

Second, I'd have an "Convert to PM tags" option. That might scan the space ContentExport::Plugin::* to create a dialog of options. If ContentExport::Plugin::Markdown existed, for example, there would be a 'from Markdown' option. From a user perspective this would be more of a "time to publish" function.

Again, this is sort of off the top of my head. I'm willing to lend a hand in this, too, as it's a cool project in an area where I need some skill development. My time is a little thin, but I'm happy to help where I can.

[ww]

First, ++ indeed! and...

      ...You betcha' I'd use it!

I'll use it not only for my own fatfingered tab closings or braintfart formatting, but also to speed up the pace of replies, where OP is sitting online hoping one of us will respond.

[jdporter]

That is nice, because it attempts to be PerlMonks markup aware. Here's the thing I use to edit nodes locally using any editor, whether vi, Netscape Composer, or whatever.

Read more... (4 kB)

[GrandFather]

This looks pertinent to version 2 of the editor - scrape the node being replied to (to allow quoted material from the OP) and post the reply directly. Thanks for the reply!

[Scott7477]

In your code the following line




use constant kParaSpace => 4;




appears to be the setting for the gap between paragraphs when the paragraph tags are used.




When I tested your editor the gap between paragraphs is rather wider than seems to be the norm in most PerlMonks posts. Perhaps kParaSpace should be set to 2?




This is a minor nitpick; otherwise this is very slick. Kudos to you...




Scott

PS: This node was written (mostly)using your editor:)

[jdporter]

scrape the node being replied to (to allow quoted material from the OP)

Yeah, that's a good idea. My code (above) is only useful for editing extant nodes.

[jakobi]

My thanx for the console offline editor (and also to GrandFather for this thread).

I've slightly modified it for Unix, which will hopefully be forgiven by jdporter. It should still support Windows, just as before. And until I find a willing victim, I'll keep this version working

For my personally, the main advantage of this solution over PMEdit is that the script wraps around your standard editor, and I thus can avoid TK and WYSIAYCEHTG.

It's also quite useful to take a peek at the PM-html source of a node, e.g. how the heck did that fellow monk manage a blue background (A: class=settings_key; grey is class=readmore)? Especially nice with vim highlighting and the original whitespace (alternatively follow the xml link or add ;displaytype=xml to the URL).

Changes include:

• .netrc-support for credentials plus use of $EDITOR (set e.g. to vi, gvim, or gvim.exe)
• skip upload if temporary file is unchanged
• allow use of http urls, perlmonks.org w/o protocol, and non-numerical 'node='-type id's
• 20091004: be a bit less obscure on a missing -id. Some better guesses for a windows _netrc, and a notion of shortcuts (e.g. self for this very node; short cut are builtin or in a user-defined file $0.short). For backup, both the original and the new editor buffer are kept in /tmp (un-versioned, un-dated). This pretty much implements the rest of what I perceived as missing features.

Possible Todos:

• add options to just read or write to allow use in vim autocommands (e.g. vimdiff or reading two or three nodes into the same buffer; and probably also very helpful for the everything-in-one-vim fraction, which I don't belong to -> very low pri)

Known Bugs:

• I don't see any way to use this script with the private scratchpad, as displaymode=private and viewmode=xml within an URL seem to clash (server side, not pm_vi).
• changes to home node or scratchpad are silently discarded by PM.
• no idea what the corresponding _netrc location on windows would be. Search for ZZZ to update my guesswork. Or change some profile for cmd to provide $ENV{HOME} and place a .netrc (or _netrc) file in this dir.
• AFAIK perlmonks.org has 64K limits on at least some of its nodes. Prod me if there's a need to replace the (.*) regex capture group with real code; but much to my enjoyment, the 64K regex pattern/capture-group 'stretch' limit seems to be ancient history (since at least 5.8, as tested with a simple ([\s\S]*)).
  Currently the script prints out a paranoid 20K reminder asking the user to double-check larger nodes (20K may well expand upto the 64K range with HTML entities).
• 20091009: title entity encoding issue fixed (I think)

A diff -u is a bit long compared to the script (given that I touched only 3 locations, excluding whitespace, comments and 2 variables...), so here's the script in full:

Read more... (12 kB)

[planetscape]

PMEdit is also on CPAN.

[QM]

Great! (Now, this node is also a candidate for nested <readmore> tags.)

[eric256]

What about code tags that just automaticaly hide code that is longer than X. Then you just click download to view it. It would be a user setting of course sense nothing on this site is allowed to change from standard behaviour ;)

[GrandFather]

Further development of this code has moved to CPAN. THe current version (as of writing this node) is here which is accessed from http://cpan.perl.org/scripts/ or http://cpan.perl.org/scripts/Web/index.html.

[GrandFather]

Update adds file save/load and shortcut keys. Cleans up paragraph spacing a little.

Read more... the code (34 kB)

Update: fixed nasty hack used to retreive the Text Subwidget.
Fixed file open error if you cancel out of the Open file dialog.

[Moriarty]

After much prodding by GrandFather, I finally got around to trying this out, on JavaJunkies. I can happily report that it works quite well, even with numbered links, although I don't know for how much longer as Yendor keeps promising a Java front end for that site.

[GrandFather]

Version 1.0 Beta 1 of PMEdit is now available at http://cpan.perl.org/authors/id/G/GR/GRANDPA/PMEdit/PMEdit-001.000201-1.pl which may be accessed through http://cpan.perl.org/scripts/ or http://cpan.perl.org/scripts/Web/index.html (these had not refreshed last time I looked, but should soon).

A swag of rendering bugs have been fixed and various editing related additions have been made with much valuable assistance from planetscape.

[parv]

Running it w/ Tk 804.027 (x11-toolkits/p5-Tk port) & perl 5.8.8 on FreeBSD 6.x, spews (nothing else happens) ...

Unhandled flag 'F' used
Unhandled flag 'F' used
Unhandled flag 'P' used
Unhandled flag 'B' used
Unhandled flag 'F' used
Unhandled flag 'U' used
Unhandled flag 'B' used
Unhandled flag 'F' used
Unhandled flag 'B' used
Unhandled flag 'B' used
Unhandled flag 'F' used
Unhandled flag 'B' used
Unhandled flag 'B' used
Unhandled flag 'B' used
Unhandled flag 'B' used
Unhandled flag 'B' used
Unhandled flag 'B' used
Unhandled flag 'F' used
Unhandled flag 'F' used
Unhandled flag 'I' used
Unhandled flag 'B' used
Unhandled flag 'P' used
Unhandled flag 'B' used
Unhandled flag 'R' used
Unhandled flag 'F' used
Unhandled flag 'B' used
Unhandled flag 'F' used
Unhandled flag 'F' used
Unhandled flag 'F' used
Unhandled flag 'F' used
Unhandled flag 'F' used
Unhandled flag 'B' used
Unhandled flag 'F' used
Unhandled flag 'L' usedline (32):
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'L' used
Unhandled flag 'R' used
Unhandled flag 'B' used
Unhandled flag 'L' used
Use of uninitialized value in string at PMEdit-001.000201-1.pl line 11
+46, <DATA> line 82.
bad event type or keysym "_" at PMEdit-001.000201-1.pl line 268, <DATA
+> line 82.

A few minutes later: Ok, the "uninitialized value" goes away if I delete the blank line at the end of __DATA__.

[GrandFather]

The line with whitespace on it (an empty line doesn't do it for me) is fairly trivial - but silly not to have found. Thanks for finding it for me!

The other issue I should have fixed before uploading, but I sort of forgot about it. On investigation it could be more important than I'd thought and has now been fixed in my current version. It probably doesn't affect current functionality, but my test suite runs against a module version of the code so I've not run the combined version against the test suite to check.

I'll upload an updated version to CPAN soon.

Thanks for the help!

Update: an updated version has been uploaded as http://cpan.perl.org/authors/id/G/GR/GRANDPA/PMEdit/PMEdit-001.000202-1.pl and should appear soonish at a mirror near you. ;)