w3m-doc/sample/keymap.cgi

   1 #!/usr/local/bin/perl
   2
   3 $QUERY = $ENV{'QUERY_STRING'};
   4 $KEYMAP = "$ENV{'HOME'}/.w3m/keymap";
   5
   6 if ($QUERY) {
   7         # &write_keymap($QUERY);
   8         print <<EOF;
   9 Content-Type: text/html
  10 w3m-control: DELETE_PREVBUF
  11 w3m-control: BACK
  12
  13 EOF
  14         exit;
  15 }
  16 &init_func();
  17 @key = ();
  18 @func = ();
  19 @data = ();
  20 open(KEYMAP, $KEYMAP);
  21 while (<KEYMAP>) {
  22         s/^keymap\s+// || next;
  23         (($k, $_) = &getQWord($_)) || next;
  24         (($f, $_) = &getWord($_)) || next;
  25         $FUNC_EXIST{$f} || next;
  26         ($d, $_) = &getQWord($_);
  27         push(@key, $k);
  28         push(@func, $f);
  29         push(@data, $d);
  30 }
  31 close(KEYMAP);
  32
  33 $N = @key;
  34
  35 print <<EOF;
  36 Content-Type: text/html
  37
  38 <head><title>Keymap Setting</title></head>
  39 <h1>Keymap Setting</h1>
  40 <form action="file:///\$LIB/keymap.cgi">
  41 <table>
  42 <tr><td>&nbsp;Key<td>&nbsp;Command<td>&nbsp;Argument
  43 <tr><td><input name=k_$N size=6>
  44 <td><select name=f_$N>
  45 EOF
  46 &print_func();
  47 print <<EOF;
  48 </select>
  49 <td><input name=d_$N>
  50 <td><input type=submit name=ok value=Ok>
  51 <tr><td colspan=4><hr>
  52 EOF
  53 $i = 0;
  54 while(@key) {
  55         $k = &Q(shift @key);
  56         $f = shift @func;
  57         $d = &Q(shift @data);
  58         print <<EOF;
  59 <tr><td><input type=hidden name=k_$i value=\"$k\">&nbsp;$k
  60 <td><select name=f_$i>
  61 EOF
  62         &print_func($f);
  63         print <<EOF;
  64 </select>
  65 <td><input name=d_$i value=\"$d\">
  66 <td><input type=checkbox name=del_$i>Delete
  67 EOF
  68         $i++;
  69 }
  70 print <<EOF;
  71 </table>
  72 </form>
  73 EOF
  74
  75 sub write_keymap {
  76         local($query) = @_;
  77         @key = ();
  78         @func = ();
  79         @data = ();
  80
  81         for $q (split('&', $query)) {
  82                 ($_, $d) = split('=', $q);
  83                 if (s/^k_//) {
  84                         $key[$_] = $d;
  85                 } elsif (s/^f_//) {
  86                         $func[$_] = $d;
  87                 } elsif (s/^d_//) {
  88                         $data[$_] = $d;
  89                 } elsif (s/^del_//) {
  90                         $del[$_] = 1;
  91                 }
  92         }
  93         open(KEYMAP, "> ${KEYMAP}") || next;
  94         while(@key) {
  95                 $k = &UQ(shift @key);
  96                 $f = shift @func;
  97                 $d = &UQ(shift @data);
  98                 ($f =~ /^\w/) || next;
  99                 (shift @del) && next;
 100                 print KEYMAP "keymap\t$k\t$f";
 101                 if ($d ne '') {
 102                         if ($d =~ /[\"\'\\\s]/) {
 103                                 $d =~ s/([\"\\])/\\$1/g;
 104                                 print KEYMAP "\t\t\"$d\"";
 105                         } else {
 106                                 $d =~ s/([\"\\])/\\$1/g;
 107                                 print KEYMAP "\t\t$d";
 108                         }
 109                 }
 110                 print KEYMAP "\n";
 111         }
 112         close(KEYMAP);
 113 }
 114
 115 sub UQ {
 116         local($_) = @_;
 117         s/\+/ /g;
 118         s/%([\da-f][\da-f])/pack('c', hex($1))/egi;
 119         return $_;
 120 }
 121
 122 sub Q {
 123         local($_) = @_;
 124         s/\&/\&amp;/g;
 125         s/\</\&lt;/g;
 126         s/\>/\&gt;/g;
 127         s/\"/\&quot;/g;
 128         return $_;
 129 }
 130
 131 sub getQWord {
 132         local($_) = @_;
 133         local($x) = '';
 134         s/^\s+//;
 135         while($_ ne '') {
 136                 if (s/^\'(([^\'\\]|\\.)*)\'// ||
 137                     s/^\"(([^\"\\]|\\.)*)\"// ||
 138                     s/^([^\'\"\\\s]+)// || s/^\\(.)//) {
 139                         $x .= $1;
 140                 } else {
 141                         last;
 142                 }
 143         }
 144         return ($x, $_);
 145 }
 146
 147 sub getWord {
 148         local($_) = @_;
 149         s/^\s+//;
 150         s/^(\S+)// || return ();
 151         return ($1, $_);
 152 }
 153
 154 sub print_func {
 155         local($f) = @_;
 156         for(@FUNC_LIST) {
 157                 if ($f eq $_) {
 158                         print "<option selected>$_\n";
 159                 } else {
 160                         print "<option>$_\n";
 161                 }
 162         }
 163 }
 164
 165 sub init_func {
 166         @FUNC_LIST = ();
 167         %FUNC_EXIST = ();
 168         while(<DATA>) {
 169                 chop;
 170                 push(@FUNC_LIST, $_);
 171                 $FUNC_EXIST{$_} = 1;
 172         }
 173 }
 174
 175 __END__
 176 - - - - - - -
 177 ABORT
 178 ADD_BOOKMARK
 179 BACK
 180 BEGIN
 181 BOOKMARK
 182 CENTER_H
 183 CENTER_V
 184 COOKIE
 185 DELETE_PREVBUF
 186 DICT_WORD
 187 DICT_WORD_AT
 188 DOWN
 189 DOWNLOAD
 190 EDIT
 191 EDIT_SCREEN
 192 END
 193 ESCBMAP
 194 ESCMAP
 195 EXEC_SHELL
 196 EXIT
 197 EXTERN
 198 EXTERN_LINK
 199 FRAME
 200 GOTO
 201 GOTO_LINE
 202 GOTO_LINK
 203 HELP
 204 HISTORY
 205 INFO
 206 INIT_MAILCAP
 207 INTERRUPT
 208 LEFT
 209 LINE_BEGIN
 210 LINE_END
 211 LINE_INFO
 212 LINK_BEGIN
 213 LINK_END
 214 LOAD
 215 MAIN_MENU
 216 MARK
 217 MARK_MID
 218 MARK_URL
 219 MENU
 220 MOUSE
 221 MOUSE_TOGGLE
 222 MOVE_DOWN
 223 MOVE_LEFT
 224 MOVE_RIGHT
 225 MOVE_UP
 226 NEXT_LINK
 227 NEXT_MARK
 228 NEXT_PAGE
 229 NEXT_WORD
 230 NOTHING
 231 NULL
 232 OPTIONS
 233 PCMAP
 234 PEEK
 235 PEEK_LINK
 236 PIPE_SHELL
 237 PREV_LINK
 238 PREV_MARK
 239 PREV_PAGE
 240 PREV_WORD
 241 PRINT
 242 QUIT
 243 READ_SHELL
 244 REDRAW
 245 REG_MARK
 246 RELOAD
 247 RIGHT
 248 SAVE
 249 SAVE_IMAGE
 250 SAVE_LINK
 251 SAVE_SCREEN
 252 SEARCH
 253 SEARCH_BACK
 254 SEARCH_FORE
 255 SEARCH_NEXT
 256 SEARCH_PREV
 257 SELECT
 258 SHELL
 259 SHIFT_LEFT
 260 SHIFT_RIGHT
 261 SOURCE
 262 SUSPEND
 263 UP
 264 VIEW
 265 VIEW_BOOKMARK
 266 VIEW_IMAGE
 267 WHEREIS
 268 WRAP_TOGGLE