--- wiki2.cgi Sun Nov 24 17:59:25 2002
+++ stonehengewiki.backup Sun Nov 24 18:16:19 2002
@@ -45,7 +45,7 @@
$UrlProtocols $UrlPattern $ImageExtensions $RFCPattern $ISBNPattern
$FS $FS1 $FS2 $FS3 $CookieName $SiteBase $StyleSheet $NotFoundPg
$FooterNote $EditNote $MaxPost $NewText $NotifyDefault $HttpCharset
- $UserGotoBar);
+ $UserGotoBar $ListDicts $AllowDictAdds $SCHelpUrl $speller);
# Note: $NotifyDefault is kept because it was a config variable in 0.90
# Other global variables:
use vars qw(%Page %Section %Text %InterSite %SaveUrl %SaveNumUrl
@@ -120,6 +120,11 @@
$FreeUpper = 0; # 1 = force upper case, 0 = do not force case
$FastGlob = 1; # 1 = new faster code, 0 = old compatible code
+# Spellchecker Opts:
+$ListDicts = 0; # 1 = Dynamic dictionary list
+$AllowDictAdds = 1; # 1 = Allow users to add to dictionary
+$SCHelpUrl = "http://stonehengeirc.dyndns.org/stonehenge/wiki/help.html";
+
# HTML tag lists, enabled if $HtmlTags is set.
# Scripting is currently possible with these tags,
# so they are *not* particularly "safe".
@@ -298,9 +303,12 @@
# == Normal page-browsing and RecentChanges code =======================
$BrowseCode = ""; # Comment next line to always compile (slower)
#$BrowseCode = <<'#END_OF_BROWSE_CODE';
+use Text::Aspell;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
+$speller = Text::Aspell->new || die "No SpellChecker";
+
sub InitRequest {
my @ScriptPath = split('/', "$ENV{SCRIPT_NAME}");
@@ -1223,7 +1231,7 @@
s/$ISBNPattern/&StoreISBN($1)/geo;
if ($ThinLine) {
s/----+/
/g;
- s/====+/ /g;
+ s/====+/ /g;
} else {
s/----+/ /g;
}
@@ -2468,6 +2476,8 @@
&DoEditBanned();
} elsif ($action eq "editlinks") {
&DoEditLinks();
+ } elsif ($action eq "research") {
+ &DoResearchIt();
} elsif ($action eq "login") {
&DoEnterLogin();
} elsif ($action eq "newlogin") {
@@ -2512,12 +2522,265 @@
&ReportError(T('Invalid URL.'));
}
+
+sub DoSpellCheck {
+ my ($text) = @_;
+ my ($myurl,$title,$header,$userName,@dicts);
+
+ $title = $q->param('title');
+ $header = Ts('SpellCheck %s');
+ print &GetHeader($q->param('id') || '' ,&QuoteHtml("$header $title"), '');
+ print &GetFormStart(), "\n";
+ print &GetHiddenValue("title", $title), "\n",
+ &GetHiddenValue("id", $q->param('id') || $title), "\n",
+ &GetHiddenValue("oldtime", $q->param('oldtime')), "\n",
+ &GetHiddenValue("oldconflict", $q->param('oldconflict')), "\n";
+
+ if ($q->param('revision') ne '') {
+ print &GetHiddenValue("revision", $q->param('revision')), "\n";
+ }
+
+ &SCspellcheck($text,$speller);
+
+ print " escapeHTML(&SChtml2cr($text)),"\">\n";
+
+ $myurl = $q->url(-full=>1,-query=>1);
+
+ if ($ListDicts == 1) {
+ @dicts = $speller->list_dictionaries;
+ }
+ else {
+ @dicts = ('American','British','Canadian');
+ }
+ print "
",
+ "Spelling: ",
+ $q->popup_menu(-name=>'spelling',
+ -values=>[@dicts],
+ -default=>$q->param('spelling') || 'American'),
+ " Mode: ",
+ $q->popup_menu(-name=>'mode',
+ -values=>['normal','bad-spellers'],
+ -default=>$q->param('mode') || 'Normal'),
+ " ",
+ "Help \n",
+ $q->submit(-name=>'action',-value=>'Edit'),
+ " \n",
+ $q->submit(-name=>'SpellCheck',-value=>'SpellCheck'),
+ " \n",
+ $q->submit(-name=>'Save', -value=>'Save'), "\n",
+ $q->endform;
+
+ &SCextrabar();
+
+ $userName = &GetParam("username", "");
+ if ($userName ne "") {
+ print ' (', T('Your user name is'), ' ',
+ &GetPageLink($userName) . ') ';
+ } else {
+ print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink()), ') ';
+ }
+ print "
\n";
+ print &GetHistoryLink($title, T('View other revisions')) . " \n";
+ print &GetGotoBar($title);
+ print &GetMinimumFooter();
+}
+
+
+sub SCsubtext {
+ my ($text) = @_;
+ my ($word) = "WORD000";
+ my ($sw,$out,@sw,@text);
+
+ @text = map {
+ $word++; $out='';
+ @sw = &SCbreakwords($_);
+ foreach $sw (0 .. $#sw) {
+ if ($q->param(&SCsubword($word,$sw)) and
+ $q->param(&SCsubword($word,$sw)) ne '--edit--' and
+ $q->param(&SCsubword($word,$sw)) ne '--add--') {
+ $out .= $q->param(&SCsubword($word,$sw));
+ } else {
+ $out .= $sw[$sw];
+ }
+ }
+ $_ = $out;
+ }
+ split /\s+/, &SCcr2html($text);
+ $text = join(' ', @text);
+ return &SChtml2cr($text);
+}
+
+
+sub SCcr2html {
+ my ($text) = @_;
+ $text =~ s/\n/ \n/g;
+ return $text;
+}
+
+
+sub SCescapeSpaces {
+ my ($text) = @_;
+ $text =~ s/ /%20/g;
+ return $text;
+}
+
+
+sub SChtml2cr {
+ my ($text) = @_;
+ $text =~ s/\s* \s*/\n/g;
+ return $text;
+}
+
+sub SCbreakwords {
+ my ($word) = @_;
+
+# FIXME: Anyone got something better? - EKL
+ return $word if $word =~ /^[A-Z]+$/; # All upper-case
+ return split /(\w+'\w+)/,$word
+ if $word =~ /\w+'\w+/; # contractions
+ return split /([A-Z]\w*?)(?=[A-Z]|\W)+|(\W+)/,$word; # WikiWords?
+}
+
+
+sub SCsubword {
+ my ($word,$sw) = @_;
+ return "${word}S${sw}";
+}
+
+
+sub SCspellcheck {
+ my ($text,$speller) = @_;
+ my ($changed);
+
+ if (!$speller) {
+ print "Error: Cannot spell-check \n";
+ print "$text\n";
+ }
+ else {
+ my ($changed,$orgword,@words,@special);
+ my ($word) = 'WORD000';
+
+ if ($ListDicts == 1) {
+ $speller->set_option('lang',$q->param('spelling'));
+ }
+ else {
+ my (%dicts) = (
+ 'American'=>'en_US',
+ 'British'=>'en_GB',
+ 'Canadian'=>'en_CA'
+ );
+ $speller->set_option('lang',$dicts{$q->param('spelling')})
+ if ($q->param('spelling'));
+ }
+
+ if ($AllowDictAdds == 1) {
+ @special = ('--edit--','--add--');
+ }
+ else {
+ @special = ('--edit--');
+ }
+
+ $speller->set_option('sug-mode',$q->param('mode'))
+ if ($q->param('mode'));
+ $speller->set_option('home-dir',$DataDir);
+
+ @words = map {
+ $word++;
+
+ if ((/<.*?>/) or (/(http|mailto):/i) or (/^HREF=/i) or (/target=/i)) {
+ $_;
+ }
+ else {
+ my ($out,$sw,@subwords);
+ @subwords = &SCbreakwords($_);
+ $out = '';
+
+ foreach $sw (0 .. $#subwords) {
+ if (($subwords[$sw] !~ /\w/) or ($subwords[$sw] =~ /^\d+$/)) {
+ $out .= "$subwords[$sw]";
+ }
+ elsif ($q->param(&SCsubword($word,$sw)) and
+ $q->param(&SCsubword($word,$sw)) eq '--edit--') {
+ $out .= " ";
+ }
+ elsif ($q->param(&SCsubword($word,$sw)) and
+ $q->param(&SCsubword($word,$sw)) eq '--add--') {
+ $speller->add_to_personal($subwords[$sw]);
+ $changed = 1;
+ $out .= "$subwords[$sw] ";
+ }
+ else {
+ if ($speller->check($subwords[$sw])) {
+ $out .= "$subwords[$sw]";
+ }
+ else {
+ $out .= $q->popup_menu(-name=>&SCsubword($word,$sw),
+ -values=>[
+ $subwords[$sw],
+ @special,
+ $speller->suggest($subwords[$sw])
+ ],
+ -default=>$subwords[$sw]
+ );
+ }
+ }
+ }
+ $_ = $out;
+ }
+ }
+ split /\s+/, &SCcr2html($text);
+ print join(' ',@words),"\n";
+ $speller->save_all_word_lists if ($changed == 1);
+ }
+}
+
+
+sub SCextrabar {
+ print " \n",
+ $q->start_form (-TARGET=>'_blank',-METHOD=>'GET'),
+ "Lookup info on: ",
+ $q->textfield (-name=>'lookup', -value=>$q->param('lookup') || ''),
+ " in: ".
+ $q->popup_menu( -name=>'ResearchOn',
+ -values=>[
+ 'Dictionary',
+ 'Thesaurus',
+ 'WikiPedia',
+ 'MetaWiki',
+ 'Google'
+ ],
+ -default=>'Dictionary'
+ ), " ",
+ $q->submit (-name=>'action',-value=>'Research'),
+ $q->end_form,"\n";
+}
+
+
+sub DoResearchIt {
+ my ($selfurl,$closeurl);
+ my (%searchurl) = (
+ 'Dictionary'=>'http://dictionary.reference.com/search?q=',
+ 'Thesaurus'=>'http://thesaurus.reference.com/search?q=',
+ 'WikiPedia'=>'http://www.wikipedia.org/w/wiki.phtml?search=',
+ 'MetaWiki'=>'http://sunir.org/apps/meta.pl?',
+ 'Google'=>'http://www.google.org/search?q='
+ );
+ my ($topurl) = &SCescapeSpaces($searchurl{$q->param('ResearchOn')} .
+ $q->param('lookup'));
+ print $q->redirect($topurl),"\n";
+ exit;
+}
+
+
sub DoEdit {
my ($id, $isConflict, $oldTime, $newText, $preview) = @_;
my ($header, $editRows, $editCols, $userName, $revision, $oldText);
my ($summary, $isEdit, $pageTime);
- if (!&UserCanEdit($id, 1)) {
+ if (!&UserCanEdit($id, 1)) {
print &GetHeader("", T('Editing Denied'), "");
if (&UserIsBanned()) {
print T('Editing not allowed: user, ip, or network is blocked.');
@@ -2547,7 +2810,11 @@
$header = Ts('Editing revision %s of', $revision) . " $id";
}
}
- $oldText = $Text{'text'};
+ if ($q->param('text')) {
+ $oldText = &SCsubtext($q->param('text'));
+ } else {
+ $oldText = $Text{'text'};
+ }
if ($preview && !$isConflict) {
$oldText = $newText;
}
@@ -2614,7 +2881,8 @@
} else {
print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink()), ') ';
}
- print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n";
+ print $q->submit(-name=>'Preview', -value=>T('Preview')), " ",
+ $q->submit(-name=>'SpellCheck', -value=>T('SpellCheck')), "\n";
if ($isConflict) {
print "\n", T('This is the text you submitted:'),
@@ -2622,6 +2890,7 @@
&GetTextArea('newtext', $newText, $editRows, $editCols),
"\n";
}
+ &SCextrabar();
print "
\n";
if ($preview) {
print "", T('Preview:'), " \n";
@@ -2662,7 +2931,7 @@
&DoNewLogin() if ($UserID < 400);
print &GetHeader('', T('Editing Preferences'), "");
print &GetFormStart();
- print GetHiddenValue("edit_prefs", 1), "\n";
+ print &GetHiddenValue("edit_prefs", 1), "\n";
print '' . T('User Information:') . " \n";
print ' ' . Ts('Your User ID number: %s', $UserID) . "\n";
print ' ' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50);
@@ -3190,7 +3459,7 @@
sub DoPost {
my ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
- my $string = &GetParam("text", undef);
+ my $string = &SCsubtext(&GetParam("text", undef));
my $id = &GetParam("title", "");
my $summary = &GetParam("summary", "");
my $oldtime = &GetParam("oldtime", "");
@@ -3220,6 +3489,10 @@
# Add a newline to the end of the string (if it doesn't have one)
$string .= "\n" if (!($string =~ /\n$/));
+ # Enhanced Editor add-on - EKL
+ # Hold existing lock instead of grab and release, BUG? - EKL
+ return &DoSpellCheck($string) if (&GetParam("SpellCheck","") ne "");
+
# Lock before getting old page to prevent races
&RequestLock() or die(T('Could not get editing lock'));
# Consider extracting lock section into sub, and eval-wrap it?
@@ -3237,6 +3510,7 @@
&ReBrowsePage($id, "", 1);
return;
}
+
# Later extract comparison?
if (($UserID > 399) || ($Section{'id'} > 399)) {
$newAuthor = ($UserID ne $Section{'id'}); # known user(s)