--- pollen.el.orig 2003-02-01 06:36:35.389504000 +0900 +++ pollen.el 2004-02-03 22:12:28.651390400 +0900 @@ -1,4 +1,4 @@ -;;; pollen.el --- Pollen Report -*- coding: iso-2022-jp -*- +;;; pollen.el --- Pollen Report -*- coding: iso-2022-jp -*- ;; Copyright (C) 1999-2002 Junichiro KITA @@ -39,7 +39,8 @@ (defvar pollen-message "%sの%sの杉花粉は%sです" "* Message format. -First `%s' is replaced with DATE, second `%s' with WHERE, third `%s' with QUANTITY.") +First `%s' is replaced with DATE, second `%s' with WHERE, +third `%s' with QUANTITY.") (defvar pollen-message-off-season "もう%sには杉花粉は飛んでいません" "* Message format for off season. First %s is replaced with WHERE") @@ -48,7 +49,8 @@ (defvar pollen-season-end 4) (defvar pollen-url-template "http://www.wni.co.jp/cww/docs/kafun/%s.html") (defvar pollen-get-func 'pollen-get) -(defvar pollen-coding-system (static-if (boundp 'MULE) '*euc-japan* 'euc-japan)) +(defvar pollen-coding-system + (static-if (boundp 'MULE) '*euc-japan* 'euc-japan)) (defvar pollen-fetch-interval (* 60 60 3) "* Default life time for cached data.") (defvar pollen-cache nil @@ -58,7 +60,7 @@ (defvar pollen-region-alist '( ;; 東北日本海側 - ("青森県津軽" . "yoho3110") ("青森県津軽" . "yoho3120") + ("青森県津軽" . "yoho3110") ("青森県下北" . "yoho3120") ("青森県三八上北" . "yoho3130") ("秋田県沿岸" . "yoho3210") ("秋田県内陸" . "yoho3220") ("山形県村山" . "yoho3510") ("山形県置賜" . "yoho3520") @@ -66,7 +68,7 @@ ;; 東北太平洋側 ("岩手県内陸" . "yoho3310") ("岩手県沿岸北部" . "yoho3320") ("岩手県沿岸南部" . "yoho3330") - ("宮城県平野" . "yoho3410") ("宮城県山沿い" . "yoho3420") + ("宮城県東部" . "yoho3410") ("宮城県西部" . "yoho3420") ("福島県中通り" . "yoho3610") ("福島県浜通り" . "yoho3620") ("福島県会津" . "yoho3630") ;; 北陸 @@ -98,11 +100,11 @@ ("滋賀県南部" . "yoho6010") ("滋賀県北部" . "yoho6010") ("京都府北部" . "yoho400") ("京都府南部" . "yoho6100") ("奈良県北部" . "yoho6410") ("奈良県南部" . "yoho6420") - ("大阪府全県" . "yoho6200") + ("大阪府全域" . "yoho6200") ("大阪府" . "yoho6200") ("和歌山県北部" . "yoho6510") ("和歌山県南部" . "yoho6520") ("兵庫県北部" . "yoho500") ("兵庫県南部" . "yoho6300") ;; 山陰 - ("鳥取県東部" . "yoho6910") ("鳥取県西部" . "yoho6920") + ("鳥取県東部" . "yoho6910") ("鳥取県中・西部" . "yoho6920") ("島根県隠岐" . "yoho600") ("島根県東部" . "yoho6810") ("島根県西部" . "yoho6820") ;; 山陽 @@ -111,7 +113,7 @@ ("山口県西部" . "yoho8110") ("山口県中部" . "yoho8120") ("山口県東部" . "yoho8130") ("山口県北部" . "yoho8140") ;; 四国 - ("香川県全県" . "yoho7200") + ("香川県全域" . "yoho7200") ("香川県" . "yoho7200") ("徳島県北部" . "yoho7110") ("徳島県南部" . "yoho7120") ("愛媛県中予" . "yoho7310") ("愛媛県東予" . "yoho7320") ("愛媛県南予" . "yoho7330") @@ -130,62 +132,43 @@ ;; 九州南部 ("宮崎県南部平野部" . "yoho8710") ("宮崎県北部平野部" . "yoho8720") ("宮崎県南部山沿い" . "yoho8730") ("宮崎県北部山沿い" . "yoho8740") - ("鹿児島県薩摩" . "yoho8810") - ("鹿児島県大隈" . "yoho8820") - ("鹿児島県屋久島種子島" . "yoho900") - ("鹿児島県奄美" . "yoho1000") + ("鹿児島県薩摩" . "yoho8810") ("鹿児島県大隈" . "yoho8820") + ("鹿児島県種子島屋久島" . "yoho900") ("鹿児島県奄美" . "yoho1000") )) -(defsubst pollen-today-p () - (> 11 (string-to-int (format-time-string "%k" (current-time))))) - (defun pollen-get (buf &optional args) (let (date quantity from to) (save-excursion (set-buffer buf) - ;; 予報情報だけを切り出し + ;; 予報情報だけを切り出し (シーズン毎に書き換える) (goto-char (point-min)) - (search-forward "yoho_hisan.gif") - (forward-line 1) - (setq from (point)) - (search-forward "時発表") - (forward-line -1) - (setq to (point)) - (narrow-to-region from to) + (when (search-forward "ctitle_scattering.gif" nil t) + (forward-line 1) + (setq from (point)) + (when (search-forward "凡例" nil t) + (forward-line -1) + (setq to (point)))) + (if to + (narrow-to-region from to) + (error "Pollen: 予報情報を切り出せません．")) + ;; 日付・花粉情報の取得 (シーズン毎に書き換える) (goto-char (point-min)) - - ;; 日付を探す - (re-search-forward "\\([0-9]+/[0-9]+\\)" nil t) - (if (re-search-forward "\\([0-9]+/[0-9]+\\)" nil t) - ;; こういう形式だったら - ;; +-----+--------+ - ;; |mm/dd| mm/dd | - ;; +-----+--------+ - ;; |today|tommorow| - ;; +-----+--------+ - (progn - (setq date (match-string 1)) - (re-search-forward "alt=\"\\(.*\\)\"") - (or (pollen-today-p) - (re-search-forward "alt=\"\\(.*\\)\""))) ; 今日の分は要らんのよ - ;; でなければこういう形式のはずなのよ - ;; +-----+ - ;; |mm/dd| - ;; +-----+ - ;; |today| - ;; +-----+ - (setq date (match-string 1)) - (re-search-forward "alt=\"\\(.*\\)\"")) - (setq quantity (match-string 1)) - (list date quantity)))) + (while (re-search-forward "\\([1-6]/[1-3]?[0-9]\\)" nil t) + (setq date (match-string 1))) + (if (re-search-forward "alt=\"\\(.*\\)\"" nil t) + (setq quantity (match-string 1))) + (if (and date quantity) + (list date quantity) + (error "Pollen: 日付・花粉情報を見付けられません．"))))) (defsubst pollen-current-second () (string-to-int (format-time-string "%s" (current-time)))) (defun pollen-set-cache (where date quantity) (setq pollen-cache - (put-alist where (list (pollen-current-second) date quantity) pollen-cache))) + (put-alist where + (list (pollen-current-second) date quantity) pollen-cache))) (defun pollen-get-cache (where) (let (current cache ret) @@ -197,8 +180,10 @@ (setq ret (cddr cache)))) ret)) -(defsubst pollen-compose (where date quantity) - (format pollen-message date where quantity)) +(if (fboundp 'pollen-compose) + nil + (defun pollen-compose (where date quantity) + (format pollen-message date where quantity))) (defsubst pollen-off-season-p () (let ((month (string-to-int (format-time-string "%m" (current-time))))) @@ -246,24 +231,29 @@ (narrow-to-region (goto-char (point-min)) (goto-char (if (re-search-forward - (format "^$\\|^%s$" - (regexp-quote mail-header-separator)) - nil t) - (match-beginning 0) - (point-max)))))) + (format "^$\\|^%s$" + (regexp-quote mail-header-separator)) + nil t) + (match-beginning 0) + (point-max)))))) (defun pollen-insert-header (&optional where offline) "Insert X-Pollen: header. If WHERE is nil, the default value `pollen-where' is used instead. If OFFLINE is nil, don't fetch pollen report from WEB, only use cache." - (interactive) - (let ((pollen (pollen-from-http where offline))) - (if pollen - (save-excursion - (save-restriction - (pollen-narrow-to-header) - (goto-char (point-max)) - (insert "X-Pollen: " pollen "\n")))))) + (interactive (if (or current-prefix-arg + (null pollen-where)) + (list (read-from-minibuffer "Where: " + pollen-where)))) + (setq where (or where pollen-where)) + (let (current-prefix-arg) + (let ((pollen (pollen-from-http where offline))) + (if pollen + (save-excursion + (save-restriction + (pollen-narrow-to-header) + (goto-char (point-max)) + (insert "X-Pollen: " pollen "\n"))))))) @@ -286,7 +276,7 @@ (setq buf (generate-new-buffer "*HTTP Fetch*"))) (setq connection (as-binary-process - (open-network-stream "*Fetch from HTTP*" + (open-network-stream "*Fetch from HTTP*" buf server port))) @@ -322,7 +312,7 @@ (interactive) (let ((product-info (product-string-1 "Pollen" t))) (if (interactive-p) - (message "%s" product-info) + (message "%s" product-info) product-info))) (provide 'pollen)