code.delx.au - gnu-emacs/blob - share/emacs/site-lisp/w3m/w3m-weather.el

   1 ;;; w3m-weather.el --- Look weather forecast -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2005
   4 ;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   5
   6 ;; Authors: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   7 ;; Keywords: w3m, WWW, hypermedia
   8
   9 ;; This file is a part of emacs-w3m.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26
  27 ;;; Commentary:
  28
  29 ;; w3m-weather.el is the add-on program of emacs-w3m to look weather
  30 ;; foracast.  For more detail about emacs-w3m, see:
  31 ;;
  32 ;;    http://emacs-w3m.namazu.org/
  33
  34
  35 ;;; How to install:
  36
  37 ;; Please put this file to appropriate directory, and if you want
  38 ;; byte-compile it.  And add following lisp expressions to your
  39 ;; ~/.emacs.
  40 ;;
  41 ;;     (autoload 'w3m-weather "w3m-weather" "Display weather report." t)
  42
  43
  44 ;;; Code:
  45
  46 (eval-when-compile (require 'cl))
  47 (require 'w3m)
  48
  49 (defconst w3m-weather-completion-table
  50   (eval-when-compile
  51     (let* ((format "http://weather.yahoo.co.jp/weather/jp/%s.html")
  52            (alist
  53             '(;; URL\e$B$N0lIt\e(B, \e$B4A;zI=5-\e(B, \e$B%m!<%^;zI=5-\e(B, \e$BJLL>\e(B
  54               ;; (\e$B%m!<%^;zI=5-$G$OD92;$r>JN,$7$J$$$3$H\e(B)
  55               ("1a/1100" "\e$BF;KL!&=!C+\e(B" "douhokusouya" "souya")
  56               ("1a/1200" "\e$BF;KL!&>e@n\e(B" "douhokukamikawa" "kamikawa")
  57               ("1a/1300" "\e$BF;KL!&N1K(\e(B" "douhokurumoi" "rumoi")
  58               ("1c/1710" "\e$BF;El!&LVAv\e(B" "doutouabashiri" "abashiri")
  59               ("1c/1720" "\e$BF;El!&KL8+\e(B" "doutoukitami" "kitami")
  60               ("1c/1730" "\e$BF;El!&LfJL\e(B" "doutoumonbetsu" "monbetsu")
  61               ("1c/1800" "\e$BF;El!&:,<<\e(B" "doutounemuro" "nemuro")
  62               ("1c/1900" "\e$BF;El!&6|O)\e(B" "doutoukushiro" "kushiro")
  63               ("1c/2000" "\e$BF;El!&==>!\e(B" "doutoutokachi" "tokachi")
  64               ("1b/1400" "\e$BF;1{!&@P<m\e(B" "dououishikari" "ishikari")
  65               ("1b/1500" "\e$BF;1{!&6uCN\e(B" "douousorachi" "sorachi")
  66               ("1b/1600" "\e$BF;1{!&8e;V\e(B" "dououshiribeshi" "shiribeshi")
  67               ("1d/2400" "\e$BF;Fn!&I0;3\e(B" "dounanhiyama" "hiyama")
  68               ("1d/2100" "\e$BF;Fn!&C@?6\e(B" "dounaniburi" "iburi")
  69               ("1d/2200" "\e$BF;Fn!&F|9b\e(B" "dounanhidaka" "hidaka")
  70               ("1d/2300" "\e$BF;Fn!&EOEg\e(B" "dounanoshima" "oshima")
  71               ("1d/2400" "\e$BF;Fn!&[X;3\e(B" "dounanhiyama" "hiyama")
  72               ("2/3110" "\e$B@D?98)!&DE7Z\e(B" "aomorikentsugaru" "tsugaru")
  73               ("2/3120" "\e$B@D?98)!&2<KL\e(B" "aomorikenshimokita" "shimokita")
  74               ("2/3130" "\e$B@D?98)!&;0H,>eKL\e(B"
  75                "aomorikensanpachikamikita" "sanpachikamikita")
  76               ("3/3310" "\e$B4d<j8)!&FbN&It\e(B" "iwatekennairikubu")
  77               ("3/3320" "\e$B4d<j8)!&1h4_KLIt\e(B" "iwatekenenganhokubu")
  78               ("3/3330" "\e$B4d<j8)!&1h4_FnIt\e(B" "iwatekenengannanbu")
  79               ("5/3210" "\e$B=)ED8)!&1h4_It\e(B" "akitakenenganbu")
  80               ("5/3220" "\e$B=)ED8)!&FbN&It\e(B" "akitakennairikubu")
  81               ("4/3410" "\e$B5\>k8)!&ElIt\e(B" "miyagikentoubu")
  82               ("4/3420" "\e$B5\>k8)!&@>It\e(B" "miyagikenseibu")
  83               ("6/3510" "\e$B;37A8)!&B<;3\e(B" "yamagatakenmurayama" "murayama")
  84               ("6/3520" "\e$B;37A8)!&CV;r\e(B" "yamagatakenokitama" "okitama")
  85               ("6/3530" "\e$B;37A8)!&>1Fb\e(B" "yamagatakenshonai" "shounai")
  86               ("6/3540" "\e$B;37A8)!&:G>e\e(B" "yamagatakenmogami" "mogami")
  87               ("7/3610" "\e$BJ!Eg8)!&CfDL$j\e(B" "hukushimakennakadoori" "nakadoori")
  88               ("7/3620" "\e$BJ!Eg8)!&IMDL$j\e(B" "hukushimakenhamadoori" "hamadoori")
  89               ("7/3630" "\e$BJ!Eg8)!&2qDE\e(B" "hukushimakenaidu" "aidu")
  90               ("8/4010" "\e$B0q>k8)!&KLIt\e(B" "ibaragikenhokubu")
  91               ("8/4020" "\e$B0q>k8)!&FnIt\e(B" "ibaragikennanbu")
  92               ("9/4110" "\e$BFJLZ8)!&FnIt\e(B" "tochigikennanbu")
  93               ("9/4120" "\e$BFJLZ8)!&KLIt\e(B" "tochigikenhokubu")
  94               ("10/4210" "\e$B72GO8)!&FnIt\e(B" "gunmakennanbu")
  95               ("10/4220" "\e$B72GO8)!&KLIt\e(B" "gunmakenhokubu")
  96               ("11/4310" "\e$B:k6L8)!&FnIt\e(B" "saitamakennanbu")
  97               ("11/4320" "\e$B:k6L8)!&KLIt\e(B" "saitamakenhokubu")
  98               ("11/4330" "\e$B:k6L8)!&CaIc\e(B" "saitamakenchichibu")
  99               ("12/4510" "\e$B@iMU8)!&KL@>It\e(B" "chibakenhokuseibu")
 100               ("12/4520" "\e$B@iMU8)!&KLElIt\e(B" "chibakenhokutoubu")
 101               ("12/4530" "\e$B@iMU8)!&FnIt\e(B" "chibakennanbu")
 102               ("13/4410" "\e$BEl5~ET!&El5~\e(B" "toukyoutotoukyou" "toukyou")
 103               ("13/4420" "\e$BEl5~ET!&0KF&=tEgKLIt\e(B"
 104                "toukyoutoizushotouhokubu" "izushotouhokubu")
 105               ("13/100" "\e$BEl5~ET!&0KF&=tEgFnIt\e(B"
 106                "toukyoutoizushotounanbu" "izushotounanbu")
 107               ("13/9600" "\e$BEl5~ET!&>.3^86=tEg\e(B"
 108                "toukyoutoogasawarashotou" "ogasawarashotou")
 109               ("14/4610" "\e$B?@F`@n8)!&ElIt\e(B" "kanagawakentoubu")
 110               ("14/4620" "\e$B?@F`@n8)!&@>It\e(B" "kanagawakenseibu")
 111               ("15/5410" "\e$B?73c8)!&2<1[\e(B" "niigatakenkaetsu" "kaetsu")
 112               ("15/5420" "\e$B?73c8)!&Cf1[\e(B" "niigatakenchuuetsu" "chuuetsu")
 113               ("15/5430" "\e$B?73c8)!&>e1[\e(B" "niigatakenjouetsu" "jouetsu")
 114               ("15/5440" "\e$B?73c8)!&:4EO\e(B" "niigatakensado" "sado")
 115               ("16/5510" "\e$BIY;38)!&ElIt\e(B" "toyamakentoubu")
 116               ("16/5520" "\e$BIY;38)!&@>It\e(B" "toyamakenseibu")
 117               ("17/5610" "\e$B@P@n8)!&2C2l\e(B" "ishikawakenkaga" "kaga")
 118               ("17/5620" "\e$B@P@n8)!&G=EP\e(B" "ishikawakennoto" "noto")
 119               ("18/5710" "\e$BJ!0f8)!&NfKL\e(B" "hukuikenreihoku" "reihoku")
 120               ("18/5720" "\e$BJ!0f8)!&NfFn\e(B" "hukuikenreinan" "reinan")
 121               ("19/4910" "\e$B;3M|8)!&Cf@>It\e(B" "yamanashikenchuuseibu")
 122               ("19/4920" "\e$B;3M|8)!&IY;N8^8P\e(B" "yamanashikenhujigoko" "hujigoko")
 123               ("20/4810" "\e$BD9Ln8)!&KLIt\e(B" "naganokenhokubu")
 124               ("20/4820" "\e$BD9Ln8)!&CfIt\e(B" "naganokenchuubu")
 125               ("20/4830" "\e$BD9Ln8)!&FnIt\e(B" "naganokennanbu")
 126               ("21/5210" "\e$B4tIl8)!&H~G;\e(B" "gihukenmino" "mino")
 127               ("21/5220" "\e$B4tIl8)!&HtBM\e(B" "gihukenhida" "hida")
 128               ("22/5010" "\e$B@E2,8)!&CfIt\e(B" "shizuokakenchuubu")
 129               ("22/5020" "\e$B@E2,8)!&0KF&\e(B" "shizuokakenizu" "izu")
 130               ("22/5030" "\e$B@E2,8)!&ElIt\e(B" "shizuokakentoubu")
 131               ("22/5040" "\e$B@E2,8)!&@>It\e(B" "shizuokakenseibu")
 132               ("23/5110" "\e$B0&CN8)!&@>It\e(B" "aichikenseibu")
 133               ("23/5120" "\e$B0&CN8)!&ElIt\e(B" "aichikentoubu")
 134               ("24/5310" "\e$B;0=E8)!&KLCfIt\e(B" "miekenhokuchuubu")
 135               ("24/5320" "\e$B;0=E8)!&FnIt\e(B" "miekennanbu")
 136               ("25/6010" "\e$B<"2l8)!&FnIt\e(B" "shigakennanbu")
 137               ("25/6020" "\e$B<"2l8)!&KLIt\e(B" "shigakenhokubu")
 138               ("26/400" "\e$B5~ETI\!&KLIt\e(B" "kyoutohuhokubu")
 139               ("26/6100" "\e$B5~ETI\!&FnIt\e(B" "kyoutohunanbu")
 140               ("27/6200" "\e$BBg:eI\\e(B" "oosakahu" "oosaka")
 141               ("28/500" "\e$BJ<8K8)!&KLIt\e(B" "hyougokenhokubu")
 142               ("28/6300" "\e$BJ<8K8)!&FnIt\e(B" "hyougokennanbu")
 143               ("29/6410" "\e$BF`NI8)!&KLIt\e(B" "narakenhokubu")
 144               ("29/6420" "\e$BF`NI8)!&FnIt\e(B" "narakennanbu")
 145               ("30/6510" "\e$BOB2N;38)!&KLIt\e(B" "wakayamakenhokubu")
 146               ("30/6520" "\e$BOB2N;38)!&FnIt\e(B" "wakayamakennanbu")
 147               ("31/6910" "\e$BD;<h8)!&ElIt\e(B" "tottorikentoubu")
 148               ("31/6920" "\e$BD;<h8)!&@>It\e(B" "tottorikenseibu")
 149               ("32/600" "\e$BEg:,8)!&1#4t\e(B" "shimanekenoki" "oki")
 150               ("32/6810" "\e$BEg:,8)!&ElIt\e(B" "shimanekentoubu")
 151               ("32/6820" "\e$BEg:,8)!&@>It\e(B" "shimanekenseibu")
 152               ("33/6610" "\e$B2,;38)!&FnIt\e(B" "okayamakennanbu")
 153               ("33/6620" "\e$B2,;38)!&KLIt\e(B" "okayamakenhokubu")
 154               ("34/6710" "\e$B9-Eg8)!&FnIt\e(B" "hiroshimakennanbu")
 155               ("34/6720" "\e$B9-Eg8)!&KLIt\e(B" "hiroshimakenhokubu")
 156               ("35/8110" "\e$B;38}8)!&@>It\e(B" "yamaguchikenseibu")
 157               ("35/8120" "\e$B;38}8)!&CfIt\e(B" "yamaguchikenchuubu")
 158               ("35/8140" "\e$B;38}8)!&KLIt\e(B" "yamaguchikenhokubu")
 159               ("35/8130" "\e$B;38}8)!&ElIt\e(B" "yamaguchikentoubu")
 160               ("36/7110" "\e$BFAEg8)!&KLIt\e(B" "tokushimakenhokubu")
 161               ("36/7120" "\e$BFAEg8)!&FnIt\e(B" "tokushimakennanbu")
 162               ("37/7200" "\e$B9a@n8)\e(B" "kagawaken" "kagawa")
 163               ("38/7320" "\e$B0&I28)!&ElM=\e(B" "ehimekentouyo" "touyo")
 164               ("38/7330" "\e$B0&I28)!&FnM=\e(B" "ehimekennanyo" "nanyo")
 165               ("38/7310" "\e$B0&I28)!&CfM=\e(B" "ehimekenchuuyo" "chuuyo")
 166               ("39/7410" "\e$B9bCN8)!&CfIt\e(B" "kouchikenchuubu")
 167               ("39/7420" "\e$B9bCN8)!&ElIt\e(B" "kouchikentoubu")
 168               ("39/7430" "\e$B9bCN8)!&@>It\e(B" "kouchikenseibu")
 169               ("40/8210" "\e$BJ!2,8)!&J!2,\e(B" "hukuokakenhukuoka" "hukuoka")
 170               ("40/8220" "\e$BJ!2,8)!&KL6e=#\e(B" "hukuokakenkitakyushu" "kitakyuushu")
 171               ("40/8230" "\e$BJ!2,8)!&C^K-\e(B" "hukuokakenchikuhou" "chikuhou")
 172               ("40/8240" "\e$BJ!2,8)!&C^8e\e(B" "hukuokakenchikugo" "chikugo")
 173               ("41/8510" "\e$B:42l8)!&FnIt\e(B" "sagakennanbu")
 174               ("41/8520" "\e$B:42l8)!&KLIt\e(B" "sagakenhokubu")
 175               ("42/700" "\e$BD9:j8)!&0m4tBPGO\e(B"
 176                "nagasakikenikitsushima" "iki" "tsushima" "ikitsushima")
 177               ("42/800" "\e$BD9:j8)!&8^Eg\e(B" "nagasakikengotou" "gotou")
 178               ("42/8410" "\e$BD9:j8)!&FnIt\e(B" "nagasakikennanbu")
 179               ("42/8420" "\e$BD9:j8)!&KLIt\e(B" "nagasakikenhokubu")
 180               ("43/8610" "\e$B7'K\8)!&7'K\\e(B" "kumamotokenkumamoto" "kumamoto")
 181               ("43/8620" "\e$B7'K\8)!&0$AI\e(B" "kumamotokenaso" "aso")
 182               ("43/8630" "\e$B7'K\8)!&E7Ap02KL\e(B"
 183                "kumamotokenamakusaashikita" "amakusa" "ashikita" "amakusaashikita")
 184               ("43/8640" "\e$B7'K\8)!&5eKa\e(B" "kumamotokenkuma" "kuma")
 185               ("44/8310" "\e$BBgJ,8)!&CfIt\e(B" "ooitakenchuubu")
 186               ("44/8320" "\e$BBgJ,8)!&KLIt\e(B" "ooitakenhokubu")
 187               ("44/8330" "\e$BBgJ,8)!&@>It\e(B" "ooitakenseibu")
 188               ("44/8340" "\e$BBgJ,8)!&FnIt\e(B" "ooitakennanbu")
 189               ("45/8710" "\e$B5\:j8)!&FnItJ?LnIt\e(B" "miyazakikennanbuheiyabu")
 190               ("45/8720" "\e$B5\:j8)!&KLItJ?LnIt\e(B" "miyazakikenhokubuheiyabu")
 191               ("45/8730" "\e$B5\:j8)!&FnIt;31h$$\e(B" "miyazakikennanbuyamazoi")
 192               ("45/8740" "\e$B5\:j8)!&KLIt;31h$$\e(B" "miyazakikenhokubuyamazoi")
 193               ("46/8810" "\e$B</;yEg8)!&;'K`\e(B" "kagoshimakensatsuma" "satsuma")
 194               ("46/8820" "\e$B</;yEg8)!&Bg6y\e(B" "kagoshimakenoosumi" "oosumi")
 195               ("46/900" "\e$B</;yEg8)!&<o;REg!&205WEg\e(B"
 196                "kagoshimakentanegashimayakushima" "tanegashima" "yakushima" "tanegashimayakushima")
 197               ("46/1000" "\e$B</;yEg8)!&1bH~\e(B" "kagoshimakenamami" "amami")
 198               ("47/9110" "\e$B2-Fl8)!&K\EgCfFnIt\e(B"
 199                "okinawakenhontouchuunanbu" "hontouchuunanbu")
 200               ("47/9120" "\e$B2-Fl8)!&K\EgKLIt\e(B"
 201                "okinawakenhontouhokubu" "hontouhokubu")
 202               ("47/9130" "\e$B2-Fl8)!&5WJFEg\e(B" "okinawakenkumejima" "kumejima")
 203               ("47/9200" "\e$B2-Fl8)!&BgElEg\e(B" "okinawakendaitoujima" "daitoujima")
 204               ("47/9300" "\e$B2-Fl8)!&5\8EEg\e(B" "okinawakenmiyakojima" "miyakojima")
 205               ("47/9400" "\e$B2-Fl8)!&@P3@Eg\e(B"
 206                "okinawakenishigakijima" "ishigakijima")
 207               ("47/9500" "\e$B2-Fl8)!&M?Fa9qEg\e(B"
 208                "okinawakenyonagunijima" "yonagunijima")))
 209            (table)
 210            ;; \e$B%X%\%s<0$H71Na<0$NBP1~I=\e(B
 211            (hepburn-table
 212             (let (table)
 213               (dolist (x '(("si" "shi")
 214                            ("zi" "ji")
 215                            ("zu" "du")
 216                            ("ti" "chi")
 217                            ("tu" "tsu")
 218                            ("hu" "fu")))
 219                 (push x table)
 220                 (push (reverse x)table))
 221               (dolist (x '(("sy" . "sh")
 222                            ("zy" . "j")
 223                            ("ty" . "ch")))
 224                 (dolist (y '("a" "u" "o"))
 225                   (push (list (concat (car x) y) (concat (cdr x) y)) table)
 226                   (push (list (concat (cdr x) y) (concat (car x) y)) table)))
 227               table))
 228            ;; \e$BBP1~I=$K>h$C$F$$$kJ8;zNs$rC5$9@55,I=8=\e(B
 229            (hepburn-regexp
 230             (format "\\(?:\\`\\|[aiueo]\\)\\(n\\([^aiueoy]\\)\\|%s\\)"
 231                     (regexp-opt (mapcar (function car) hepburn-table))))
 232            ;; \e$BD92;$NM-L5$K$h$kGI@87A$NI=\e(B
 233            (prolonged-table
 234             (let (table)
 235               (dolist (x '("k" "ky"
 236                            "s" "sy" "sh"
 237                            "t" "ty" "ch"
 238                            "n" "ny"
 239                            "h" "hy"
 240                            "m" "my"
 241                            "y"
 242                            "r" "ry"
 243                            "w"
 244                            "g" "gy"
 245                            "z" "zy" "j"
 246                            "d" "dy"
 247                            "b" "by"
 248                            "p" "py"))
 249                 (let ((long-vowels '("ou" "oo" "o-")))
 250                   (dolist (y long-vowels)
 251                     (push (cons (concat x y)
 252                                 (append
 253                                  (mapcar
 254                                   (lambda (z) (concat x z))
 255                                   (delete y (copy-sequence long-vowels)))
 256                                  (list (concat x "o"))))
 257                           table)))
 258                 (push (list (concat x "uu") (concat x "u"))
 259                       table))
 260               table))
 261            ;; \e$BGI@87A$NI=$K>h$C$F$$$kJ8;zNs$rC5$9@55,I=8=\e(B
 262            (prolonged-regexp (format "\\(?:\\`\\|[aiueo]\\)\\(%s\\)"
 263                                      (regexp-opt (mapcar (function car)
 264                                                          prolonged-table)))))
 265       (labels ((hepburn-candidates
 266                 (str)
 267                 "\e$B%X%\%s<0$H71Na<0$N:9$K$h$C$F@8$8$kGI@87A$rF@$k\e(B"
 268                 (if (string-match hepburn-regexp str)
 269                     (let ((prefix (substring str 0 (match-beginning 1)))
 270                           (candidates (if (match-beginning 2)
 271                                           '("n" "nn")
 272                                         (assoc (match-string 1 str)
 273                                                hepburn-table)))
 274                           (suffixes
 275                            (hepburn-candidates
 276                             (substring str (or (match-beginning 2)
 277                                                (match-end 0)))))
 278                           (buf))
 279                       (dolist (x candidates)
 280                         (dolist (y suffixes)
 281                           (push (concat prefix x y) buf)))
 282                       buf)
 283                   (list str)))
 284                (prolonged-candidates
 285                 (str)
 286                 "\e$BD92;$NM-L5$K$h$C$F@8$8$kGI@87A$rF@$k\e(B"
 287                 (let (buf)
 288                   (if (string-match prolonged-regexp str)
 289                       (let ((prefix (substring str 0 (match-beginning 1)))
 290                             (candidates (assoc (match-string 1 str)
 291                                                prolonged-table))
 292                             (suffixes (prolonged-candidates
 293                                        (substring str (match-end 0)))))
 294                         (dolist (x candidates)
 295                           (dolist (y suffixes)
 296                             (push (concat prefix x y) buf))))
 297                     (setq buf (list str)))
 298                   (dolist (x buf)
 299                     (when (string-match "\\(\\`\\|[aiue]\\)oo" x)
 300                       (let ((prefix (substring x 0 (match-end 1)))
 301                             (suffix (substring x (match-end 0))))
 302                         (dolist (y '("o" "oh" "o-"))
 303                           (push (concat prefix y suffix) buf)))))
 304                   buf))
 305                (romaji-candidates
 306                 (str)
 307                 "\e$BA4$F$NGI@87A$rF@$k\e(B"
 308                 (let (buf)
 309                   (dolist (x (hepburn-candidates str))
 310                     (dolist (y (prolonged-candidates x))
 311                       (push y buf)))
 312                   buf)))
 313         (dolist (area alist)
 314           (let ((url (format format (car area)))
 315                 (kanji (cadr area)))
 316             (push (list kanji (nth 2 area) url) table)
 317             (dolist (romaji (cddr area))
 318               (dolist (x (romaji-candidates romaji))
 319                 (push (list x kanji) table)))))
 320         (nreverse table))))
 321   "Completion table of areas and urls.")
 322
 323 (defcustom w3m-weather-default-area
 324   "\e$B5~ETI\!&FnIt\e(B"
 325   "Default region to check weather."
 326   :group 'w3m
 327   :type (cons 'radio
 328               (delq nil
 329                     (mapcar (lambda (area)
 330                               (when (nth 2 area)
 331                                 (list 'const (car area))))
 332                             w3m-weather-completion-table))))
 333
 334 (defcustom w3m-weather-filter-functions
 335   '(w3m-weather-extract-contents
 336     w3m-weather-adjust-contents
 337     w3m-weather-expand-anchors
 338     w3m-weather-insert-title)
 339   "Filter functions to remove useless tags."
 340   :group 'w3m
 341   :type 'hook)
 342
 343 (defvar w3m-weather-input-history nil)
 344
 345 (defun w3m-weather-input-area ()
 346   (let* ((str
 347           (completing-read (format "Input area (default %s): "
 348                                    w3m-weather-default-area)
 349                            'w3m-weather-area-completion nil t nil
 350                            'w3m-weather-input-history))
 351          (area
 352           (cond
 353            ((string= "" str) w3m-weather-default-area)
 354            ((string-match "[^-a-zA-Z]" str) str)
 355            (t (cadr (assoc str w3m-weather-completion-table))))))
 356     (setq w3m-weather-input-history
 357           (cons area
 358                 (delete area
 359                         (delete str w3m-weather-input-history))))
 360     area))
 361
 362 (defun w3m-weather-area-completion (partial predicate flag)
 363   (if (eq flag 'lambda)
 364       (and (assoc partial w3m-weather-completion-table)
 365            (or (not predicate)
 366                (funcall predicate partial))
 367            t)
 368     (let ((kanji "")
 369           (romaji "")
 370           (romaji-partial partial))
 371       (when (string-match "\\`\\(?:[^-a-zA-Z]+\\)" partial)
 372         (let ((suffix (substring partial (match-end 0))))
 373           (setq kanji (substring partial 0 (match-end 0))
 374                 romaji (try-completion
 375                         ""
 376                         (mapcar
 377                          (lambda (x)
 378                            (list (cadr (assoc x w3m-weather-completion-table))))
 379                          (all-completions kanji w3m-weather-completion-table)))
 380                 romaji-partial (concat romaji suffix))))
 381       (let ((collection)
 382             (regexp
 383              (and (string-match "\e$B!&\e(B\\'" kanji)
 384                   (string-match "[aiueo]n\\'" romaji)
 385                   (concat "\\`" romaji "n[^aiueoy]"))))
 386         (dolist (x (all-completions romaji-partial w3m-weather-completion-table))
 387           (unless (and regexp (string-match regexp x))
 388             (setq x (assoc x w3m-weather-completion-table))
 389             (unless (assoc (cadr x) collection)
 390               (push (cons (cadr x) (car x)) collection))))
 391         (cond
 392          ((not flag)
 393           (let ((s (try-completion kanji collection predicate)))
 394             (if (and (stringp s) (string< s partial))
 395                 (when (setq s (try-completion romaji-partial
 396                                               (mapcar (lambda (x) (list (cdr x)))
 397                                                       collection)
 398                                               predicate))
 399                   (concat kanji (substring s (if romaji (length romaji) 0))))
 400               s)))
 401          ((eq flag t)
 402           (all-completions kanji collection predicate)))))))
 403
 404 ;;;###autoload
 405 (defun w3m-weather (area)
 406   "Display weather report."
 407   (interactive
 408    (list (if current-prefix-arg
 409              (w3m-weather-input-area)
 410            w3m-weather-default-area)))
 411   (w3m-goto-url (format "about://weather/%s" area)))
 412
 413 ;;;###autoload
 414 (defun w3m-about-weather (url no-decode no-cache post-data referer handler)
 415   (if (string-match "\\`about://weather/" url)
 416       (lexical-let* ((url url)
 417                      (no-cache no-cache)
 418                      (area (substring url (match-end 0)))
 419                      (furl (nth 2 (assoc area w3m-weather-completion-table))))
 420         (w3m-process-do
 421             (type (w3m-retrieve furl nil no-cache nil nil handler))
 422           (when type
 423             (w3m-decode-buffer furl)
 424             (w3m-weather-run-filter-functions w3m-weather-filter-functions
 425                                               area furl no-cache handler))))
 426     (w3m-message "Unknown URL: %s" url)
 427     nil))
 428
 429 (defun w3m-weather-run-filter-functions (functions area url no-cache handler)
 430   (if functions
 431       (lexical-let ((functions functions)
 432                     (area area)
 433                     (url url)
 434                     (no-cache no-cache))
 435         (w3m-process-do
 436             (nil (funcall (pop functions) area url no-cache handler))
 437           (w3m-weather-run-filter-functions functions area url
 438                                             no-cache handler)))
 439     "text/html"))
 440
 441 (defun w3m-weather-extract-contents (&rest args)
 442   "Remove both header and footer in the weather forecast pages."
 443   (goto-char (point-min))
 444   (when (search-forward "<!---MAIN_CONTENTS_table--->" nil t)
 445     (delete-region (point-min) (match-beginning 0)))
 446   (goto-char (point-max))
 447   (when (search-backward "<!---Local_Link--->" nil t)
 448     (delete-region (match-beginning 0) (point-max))))
 449
 450 (defun w3m-weather-adjust-contents (&rest args)
 451   ;; Remove spacers.
 452   (goto-char (point-min))
 453   (while (search-forward "<tr><td>\
 454 <img src=\"http://img.yahoo.co.jp/images/clear.gif\" width=1>\
 455 </td></tr>" nil t)
 456     (delete-region (match-beginning 0) (match-end 0)))
 457   ;; Remove execessive tables.
 458   (goto-char (point-min))
 459   (while (re-search-forward "<table[^>]*>[ \t\r\f\n]*</table>" nil t)
 460     (delete-region (match-beginning 0) (match-end 0)))
 461   (goto-char (point-min))
 462   ;; Remove too narrow width parameters.
 463   (while (re-search-forward "<td[^>]*\\(width=1%\\)" nil t)
 464     (delete-region (match-beginning 1) (match-end 1)))
 465   ;; Display border lines.
 466   (goto-char (point-min))
 467   (while (re-search-forward "\
 468 <table border=\\(0\\) cellpadding=[1-9][0-9]* cellspacing=[1-9][0-9]*" nil t)
 469     (goto-char (match-beginning 1))
 470     (delete-char 1)
 471     (insert "1"))
 472   (goto-char (point-min))
 473   (while (re-search-forward
 474           "<td align=center width=25%>[ \t\r\f\n]*<table border=1" nil t)
 475     (delete-char -1)
 476     (insert "0")))
 477
 478 (defun w3m-weather-insert-title (area url &rest args)
 479   "Insert title."
 480   (goto-char (point-min))
 481   (insert "<head><title>Weather forecast of "
 482           area
 483           "</title></head>\n"
 484           "<body><p align=left><a href=\""
 485           url
 486           "\">[Yahoo!]</a></p>\n")
 487   (goto-char (point-max))
 488   (insert "</body>"))
 489
 490 (defun w3m-weather-expand-anchors (area url &rest args)
 491   ;; FIXME: \e$BE75$M=Js%Z!<%8$K4^$^$l$F$$$kAjBP%j%s%/$r@dBP%j%s%/$K=q$-49\e(B
 492   ;; \e$B$($k$?$a$N4X?t!%$3$l$i$NAjBP%j%s%/$r0BA4$K<h$j07$&$?$a$K$O!$\e(Bbase
 493   ;; URL \e$B$rJV$;$k$h$&$K!$\e(Babout:// \e$B$N9=B$$r=q$-D>$9I,MW$,$"$k$H9M$($i$l\e(B
 494   ;; \e$B$k$,!$$H$j$"$($:8e2s$7!%\e(B
 495   (goto-char (point-min))
 496   (while (re-search-forward
 497           (eval-when-compile
 498             (concat "<a[ \t\r\f\n]+href=" w3m-html-string-regexp))
 499           nil t)
 500     (replace-match (format
 501                     "<a href=\"%s\""
 502                     (w3m-expand-url (w3m-remove-redundant-spaces
 503                                      (or (match-string-no-properties 2)
 504                                          (match-string-no-properties 3)
 505                                          (match-string-no-properties 1)))
 506                                     url)))))
 507
 508 (provide 'w3m-weather)
 509
 510 ;;; w3m-weather.el ends here.