blob: f68f5fb99c1d2f8fcf2ac3bf3c25a0b12475a84a (
plain) (
tree)
|
|
#!/usr/local/bin/perl
$QUERY = $ENV{'QUERY_STRING'};
$KEYMAP = "$ENV{'HOME'}/.w3m/keymap";
if ($QUERY) {
# &write_keymap($QUERY);
print <<EOF;
Content-Type: text/html
w3m-control: DELETE_PREVBUF
w3m-control: BACK
EOF
exit;
}
&init_func();
@key = ();
@func = ();
@data = ();
open(KEYMAP, $KEYMAP);
while (<KEYMAP>) {
s/^keymap\s+// || next;
(($k, $_) = &getQWord($_)) || next;
(($f, $_) = &getWord($_)) || next;
$FUNC_EXIST{$f} || next;
($d, $_) = &getQWord($_);
push(@key, $k);
push(@func, $f);
push(@data, $d);
}
close(KEYMAP);
$N = @key;
print <<EOF;
Content-Type: text/html
<head><title>Keymap Setting</title></head>
<h1>Keymap Setting</h1>
<form action="file:///\$LIB/keymap.cgi">
<table>
<tr><td> Key<td> Command<td> Argument
<tr><td><input name=k_$N size=6>
<td><select name=f_$N>
EOF
&print_func();
print <<EOF;
</select>
<td><input name=d_$N>
<td><input type=submit name=ok value=Ok>
<tr><td colspan=4><hr>
EOF
$i = 0;
while(@key) {
$k = &Q(shift @key);
$f = shift @func;
$d = &Q(shift @data);
print <<EOF;
<tr><td><input type=hidden name=k_$i value=\"$k\"> $k
<td><select name=f_$i>
EOF
&print_func($f);
print <<EOF;
</select>
<td><input name=d_$i value=\"$d\">
<td><input type=checkbox name=del_$i>Delete
EOF
$i++;
}
print <<EOF;
</table>
</form>
EOF
sub write_keymap {
local($query) = @_;
@key = ();
@func = ();
@data = ();
for $q (split('&', $query)) {
($_, $d) = split('=', $q);
if (s/^k_//) {
$key[$_] = $d;
} elsif (s/^f_//) {
$func[$_] = $d;
} elsif (s/^d_//) {
$data[$_] = $d;
} elsif (s/^del_//) {
$del[$_] = 1;
}
}
open(KEYMAP, "> ${KEYMAP}") || next;
while(@key) {
$k = &UQ(shift @key);
$f = shift @func;
$d = &UQ(shift @data);
($f =~ /^\w/) || next;
(shift @del) && next;
print KEYMAP "keymap\t$k\t$f";
if ($d ne '') {
if ($d =~ /[\"\'\\\s]/) {
$d =~ s/([\"\\])/\\$1/g;
print KEYMAP "\t\t\"$d\"";
} else {
$d =~ s/([\"\\])/\\$1/g;
print KEYMAP "\t\t$d";
}
}
print KEYMAP "\n";
}
close(KEYMAP);
}
sub UQ {
local($_) = @_;
s/\+/ /g;
s/%([\da-f][\da-f])/pack('c', hex($1))/egi;
return $_;
}
sub Q {
local($_) = @_;
s/\&/\&/g;
s/\</\</g;
s/\>/\>/g;
s/\"/\"/g;
return $_;
}
sub getQWord {
local($_) = @_;
local($x) = '';
s/^\s+//;
while($_ ne '') {
if (s/^\'(([^\'\\]|\\.)*)\'// ||
s/^\"(([^\"\\]|\\.)*)\"// ||
s/^([^\'\"\\\s]+)// || s/^\\(.)//) {
$x .= $1;
} else {
last;
}
}
return ($x, $_);
}
sub getWord {
local($_) = @_;
s/^\s+//;
s/^(\S+)// || return ();
return ($1, $_);
}
sub print_func {
local($f) = @_;
for(@FUNC_LIST) {
if ($f eq $_) {
print "<option selected>$_\n";
} else {
print "<option>$_\n";
}
}
}
sub init_func {
@FUNC_LIST = ();
%FUNC_EXIST = ();
while(<DATA>) {
chop;
push(@FUNC_LIST, $_);
$FUNC_EXIST{$_} = 1;
}
}
__END__
- - - - - - -
ABORT
ADD_BOOKMARK
BACK
BEGIN
BOOKMARK
CENTER_H
CENTER_V
COOKIE
DELETE_PREVBUF
DICT_WORD
DICT_WORD_AT
DOWN
DOWNLOAD
EDIT
EDIT_SCREEN
END
ESCBMAP
ESCMAP
EXEC_SHELL
EXIT
EXTERN
EXTERN_LINK
FRAME
GOTO
GOTO_LINE
GOTO_LINK
HELP
HISTORY
INFO
INIT_MAILCAP
INTERRUPT
LEFT
LINE_BEGIN
LINE_END
LINE_INFO
LINK_BEGIN
LINK_END
LOAD
MAIN_MENU
MARK
MARK_MID
MARK_URL
MENU
MOUSE
MOUSE_TOGGLE
MOVE_DOWN
MOVE_LEFT
MOVE_RIGHT
MOVE_UP
NEXT_LINK
NEXT_MARK
NEXT_PAGE
NEXT_WORD
NOTHING
NULL
OPTIONS
PCMAP
PEEK
PEEK_LINK
PIPE_SHELL
PREV_LINK
PREV_MARK
PREV_PAGE
PREV_WORD
PRINT
QUIT
READ_SHELL
REDRAW
REG_MARK
RELOAD
RIGHT
SAVE
SAVE_IMAGE
SAVE_LINK
SAVE_SCREEN
SEARCH
SEARCH_BACK
SEARCH_FORE
SEARCH_NEXT
SEARCH_PREV
SELECT
SHELL
SHIFT_LEFT
SHIFT_RIGHT
SOURCE
SUSPEND
UP
VIEW
VIEW_BOOKMARK
VIEW_IMAGE
WHEREIS
WRAP_TOGGLE
|
