forked from github/kensanata.oddmuse
f230a64e7d
There were some modules that did not offer "or (at your option) any later version" in their license and these had to be left alone. This should solve the incorrect FSF address issue #4 on GitHub.
106 lines
3.4 KiB
Perl
106 lines
3.4 KiB
Perl
# Copyright (C) 2004, 2005 Alex Schroeder <alex@emacswiki.org>
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
use strict;
|
|
use v5.10;
|
|
|
|
AddModuleDescription('page-type.pl', 'Page Type Extension');
|
|
|
|
our ($q, %AdminPages, @MyInitVariables, $LinkPattern, $FreeLinks, $FreeLinkPattern, $WikiLinks);
|
|
our ($PageTypesName);
|
|
|
|
# You need to define the available types on the following page.
|
|
|
|
$PageTypesName = 'PageTypes';
|
|
|
|
# do this later so that the user can customize $SidebarName
|
|
push(@MyInitVariables, \&PageTypeInit);
|
|
|
|
sub PageTypeInit {
|
|
$PageTypesName = FreeToNormal($PageTypesName); # spaces to underscores
|
|
$AdminPages{$PageTypesName} = 1; # mod_perl!
|
|
}
|
|
|
|
# A page type has to appear as a bullet list item on the page.
|
|
#
|
|
# Example list defining three types:
|
|
#
|
|
# * foo
|
|
# * bar
|
|
# * quux baz
|
|
|
|
# The page type will be prepended to the beginning of a page. If you
|
|
# have page clustering enabled (see the manual), then the page type
|
|
# will automatically act as a cluster.
|
|
|
|
*OldPageTypeDoPost = \&DoPost;
|
|
*DoPost = \&NewPageTypeDoPost;
|
|
|
|
sub NewPageTypeDoPost {
|
|
my $id = shift;
|
|
my $type = GetParam('types', '');
|
|
if ($type and $type ne T('None')) {
|
|
$type = "[[$type]]" unless $WikiLinks and $type =~ /^$LinkPattern$/;
|
|
my $text = $type . "\n\n" . GetParam('text','');
|
|
# We can't use SetParam(), because we're trying to override a
|
|
# parameter used by the script. GetParam prefers the actual
|
|
# script parameters to parameters set by the cookie (which is what
|
|
# SetParam manipulates). We also need to unquote, because
|
|
# GetParam automatically unquotes.
|
|
$q->param(-name=>'text', -value=>UnquoteHtml($text));
|
|
}
|
|
OldPageTypeDoPost($id);
|
|
}
|
|
|
|
*OldPageTypeGetTextArea = \&GetTextArea;
|
|
*GetTextArea = \&NewPageTypeGetTextArea;
|
|
|
|
sub NewPageTypeGetTextArea {
|
|
my ($name, $text) = @_;
|
|
return OldPageTypeGetTextArea(@_) if ($name ne 'text'); # comment box!
|
|
my @types = (T('None'),);
|
|
# read categories
|
|
foreach (split ('\n', GetPageContent($PageTypesName))) {
|
|
if ($WikiLinks and (m/^\*[ \t]($LinkPattern)/)) {
|
|
push (@types, $1);
|
|
} elsif ($FreeLinks and (m/^\*[ \t]\[\[($FreeLinkPattern)\]\]/)) {
|
|
push (@types, $1);
|
|
}
|
|
}
|
|
my $cluster;
|
|
# This duplicates GetCluster code so that this works even when
|
|
# $PageCluster==0.
|
|
$cluster = $1 if ($WikiLinks && $text =~ /^$LinkPattern\n/)
|
|
or ($FreeLinks && $text =~ /^\[\[$FreeLinkPattern\]\]\n/);
|
|
if (grep(/^$cluster$/, @types)) {
|
|
$text =~ s/^.*\n+//; # delete cluster line, and clean up further empty lines
|
|
} else {
|
|
$cluster = T('None');
|
|
}
|
|
#build the new input
|
|
my $html = OldPageTypeGetTextArea($name, $text);
|
|
my $list = T('Type') . ': <select name="types">';
|
|
foreach my $type (@types) {
|
|
if ($type eq $cluster) {
|
|
$list .= "<option value=\"$type\" selected>$type";
|
|
} else {
|
|
$list .= "<option value=\"$type\">$type";
|
|
}
|
|
}
|
|
$list .= "</select>";
|
|
$html .= $q->p($list);
|
|
return $html;
|
|
}
|