add google weather mode

diff --git a/emacs_el/google-weather.el b/emacs_el/google-weather.el
new file mode 100644 (file)
index 0000000..d86165d
--- /dev/null
+++ b/emacs_el/google-weather.el
@@ -0,0 +1,179 @@
+;;; google-weather.el --- Fetch Google Weather forecasts.
+
+;; Copyright (C) 2010 Julien Danjou
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: comm
+
+;; This file is NOT part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This module allows you to fetch Google Weather forecast from the
+;; Internet.
+;;
+;;; Code:
+
+(require 'url)
+(require 'url-cache)
+(require 'xml)
+(require 'time-date)
+
+(defgroup google-weather nil
+  "Google Weather."
+  :group 'comm)
+
+(defconst google-weather-url
+  "http://www.google.com/ig/api"
+  "URL used to access the Google Weather API.")
+
+(defconst google-weather-image-url
+  "http://www.google.com"
+  "URL prefix for images.")
+
+(defcustom google-weather-unit-system-temperature-assoc
+  '(("SI" . "℃")
+    ("US" . "℉"))
+  "Find temperature symbol from unit system."
+  :group 'google-weather)
+
+(defun google-weather-cache-expired (url expire-time)
+  "Check if URL is cached for more than EXPIRE-TIME."
+  (cond (url-standalone-mode
+         (not (file-exists-p (url-cache-create-filename url))))
+        (t (let ((cache-time (url-is-cached url)))
+             (if cache-time
+                 (time-less-p
+                  (time-add
+                   (url-is-cached url)
+                   (seconds-to-time expire-time))
+                  (current-time))
+               t)))))
+
+(defun google-weather-cache-fetch (url)
+  "Fetch URL from the cache."
+  (with-current-buffer (generate-new-buffer " *temp*")
+    (url-cache-extract (url-cache-create-filename url))
+    (current-buffer)))
+
+(defun google-weather-retrieve-data (url &optional expire-time)
+  "Retrieve URL and return its data as string.
+If EXPIRE-TIME is set, the data will be fetched from the cache if
+their are not older than EXPIRE-TIME seconds. Otherwise, they
+will be fetched and then cached. Therefore, setting EXPIRE-TIME
+to 0 force a cache renewal."
+  (let* ((expired (if expire-time
+                      (google-weather-cache-expired url expire-time)
+                    t))
+         (buffer (if expired
+                     (url-retrieve-synchronously url)
+                   (google-weather-cache-fetch url)))
+         data)
+    (with-current-buffer buffer
+      (goto-char (point-min))
+      (search-forward "\n\n")
+      (decode-coding-region
+       (point) (point-max)
+       (detect-coding-region (point) (point-max) t))
+      (set-buffer-multibyte t)
+      (setq data (xml-parse-region (point) (point-max)))
+      (when (and expired expire-time)
+        (url-store-in-cache (current-buffer)))
+      (kill-buffer (current-buffer))
+      data)))
+
+(defun google-weather-build-url (location &optional language)
+  "Build URL to retrieve weather for LOCATION in LANGUAGE."
+  (concat google-weather-url "?weather=" (url-hexify-string location)
+          (when language
+            (concat "&hl=" language))))
+
+(defun google-weather-get-data (location &optional language expire-time)
+  "Get weather data for LOCATION in LANGUAGE.
+See `google-weather-retrieve-data' for the use of EXPIRE-TIME."
+  (google-weather-retrieve-data
+   (google-weather-build-url location language) expire-time))
+
+(defun google-weather-data->weather (data)
+  "Return all weather information from DATA."
+  (cddr (assoc 'weather (cdr (assoc 'xml_api_reply data)))))
+
+(defun google-weather-data->forecast-information (data)
+  "Return the forecast information of DATA."
+  (cddr (assoc 'forecast_information (google-weather-data->weather data))))
+
+(defun google-weather-assoc (key data)
+  "Do some sort of magic 'assoc to find fields in DATA."
+  (cdr (assoc 'data (cadr (assoc key data)))))
+
+(defun google-weather-data->city (data)
+  "Return the city where the DATA come from."
+  (google-weather-assoc
+   'city
+   (google-weather-data->forecast-information data)))
+
+(defun google-weather-data->postal-code (data)
+  "Return the postal code where the data come from."
+  (google-weather-assoc
+   'postal_code
+   (google-weather-data->forecast-information data)))
+
+(defun google-weather-data->unit-system (data)
+  "Return the unit system used for data."
+  (google-weather-assoc
+   'unit_system
+   (google-weather-data->forecast-information data)))
+
+(defun google-weather-data->forecast-date (data)
+  "Return the unit system used for data."
+  (google-weather-assoc
+   'forecast_date
+   (google-weather-data->forecast-information data)))
+
+(defun google-weather-data->forecast (data)
+  "Get forecast list from DATA."
+  ;; Compute date of the forecast in the same format as `current-time'
+  (let ((date (apply 'encode-time
+                     (parse-time-string
+                      (concat (google-weather-data->forecast-date data) " 00:00:00")))))
+    (mapcar
+     (lambda (forecast)
+       (let* ((forecast-date (decode-time date))
+              (forecast-encoded-date (list (nth 4 forecast-date)
+                                           (nth 3 forecast-date)
+                                           (nth 5 forecast-date))))
+         ;; Add one day to `date'
+         (setq date (time-add date (days-to-time 1)))
+         `(,forecast-encoded-date
+           (low ,(google-weather-assoc 'low forecast))
+           (high ,(google-weather-assoc 'high forecast))
+           (icon ,(concat google-weather-image-url
+                          (google-weather-assoc 'icon forecast)))
+           (condition ,(google-weather-assoc 'condition forecast)))))
+     (loop for entry in (google-weather-data->weather data)
+           when (eq (car entry) 'forecast_conditions)
+           collect entry))))
+
+(defun google-weather-data->forecast-for-date (data date)
+  "Return forecast for DATE from DATA.
+DATE should be in the same format used by calendar i.e. (MONTH DAY YEAR)."
+  (cdr (assoc date
+              (google-weather-data->forecast data))))
+
+(defun google-weather-data->temperature-symbol (data)
+  "Return the temperature to be used according to `google-weather-unit-system-temperature-assoc' in DATA."
+  (cdr (assoc (google-weather-data->unit-system data) google-weather-unit-system-temperature-assoc)))
+
+(provide 'google-weather)

diff --git a/emacs_el/org-google-weather.el b/emacs_el/org-google-weather.el
new file mode 100644 (file)
index 0000000..9961601
--- /dev/null
+++ b/emacs_el/org-google-weather.el
@@ -0,0 +1,117 @@
+;;; org-google-weather.el --- Show Google Weather forecasts in Org agenda.
+
+;; Copyright (C) 2010 Julien Danjou
+
+;; Author: Julien Danjou <julien@danjou.info>
+;; Keywords: comm
+
+;; This file is NOT part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; This module allows to display the weather forecast fetched from Google in
+;; your Org agenda.
+;;
+;;     Wednesday   8 September 2010
+;;       Weather:    Pluie, 12/18 ℃
+;;     Thursday    9 September 2010
+;;       Weather:    Couverture nuageuse partielle, 11/21 ℃
+;;
+;; Just add the following in an Org buffer:
+;; %%(org-google-weather)
+;;
+;;; Code:
+
+(require 'google-weather)
+(require 'image)
+
+(defgroup org-google-weather nil
+  "Google Weather for Org mode."
+  :group 'comm)
+
+;; Org mode support
+(defcustom org-google-weather-location
+  "Paris"
+  "Default location for org-google-weather."
+  :group 'org-google-weather)
+
+(defcustom org-google-weather-cache-time 43200
+  "Define for how many seconds we should cache the weather."
+  :group 'org-google-weather)
+
+(defcustom org-google-weather-display-icon-p t
+  "Display icons."
+  :group 'org-google-weather)
+
+(defcustom org-google-weather-icon-directory "/usr/share/icons/gnome/16x16/status"
+  "Directory where to find icon listed in `org-google-weather-icon-alist'."
+  :group 'org-google-weather)
+
+(defcustom org-google-weather-icon-alist
+  '((chance_of_rain . "weather-showers-scattered.png")
+    (chance_of_snow . "weather-snow.png")
+    (chance_of_storm "weather-storm.png")
+    (cloudy . "weather-overcast.png")
+    (dust . "weather-fog.png")
+    (flurries . "weather-storm.png")
+    (fog . "weather-fog.png")
+    (haze . "weather-fog.png")
+    (icy . "weather-snow.png")
+    (mist . "weather-storm.png")
+    (mostly_cloudy . "weather-overcast.png")
+    (mostly_sunny . "weather-clear.png")
+    (partly_cloudy . "weather-few-clouds.png")
+    (rain . "weather-showers.png")
+    (sleet . "weather-snow.png")
+    (smoke . "weather-fog.png")
+    (snow . "weather-snow.png")
+    (storm . "weather-storm.png")
+    (thunderstorm . "weather-storm.png")
+    (sunny . "weather-clear.png"))
+  "Icons to used to illustrate the weather.")
+
+(defun org-google-weather (&optional location language)
+  "Return Org entry with the weather for LOCATION in LANGUAGE.
+If LOCATION is not set, use org-google-weather-location."
+  (let* ((data (google-weather-get-data (or location
+                                            org-google-weather-location)
+                                        language
+                                        org-google-weather-cache-time))
+         (forecast (google-weather-data->forecast-for-date data date)))
+    (when forecast
+      (let ((condition (cadr (assoc 'condition forecast)))
+            (low (cadr (assoc 'low forecast)))
+            (high (cadr (assoc 'high forecast)))
+            ;; But *they* told me it's just about calling functions!
+            (icon (cdr
+                   (assoc
+                    (intern
+                     (file-name-sans-extension
+                      (file-name-nondirectory
+                       (cadr (assoc 'icon forecast)))))
+                    org-google-weather-icon-alist)))
+            (temp-symbol (google-weather-data->temperature-symbol data)))
+        (concat
+         (if org-google-weather-display-icon-p
+             (concat (propertize "icon"
+                                 'display
+                                 (create-image
+                                  (concat org-google-weather-icon-directory "/" icon))
+                                 'rear-nonsticky '(display))
+                     " ")
+           "")
+         condition ", " low "-" high " " temp-symbol)))))
+
+(provide 'org-google-weather)