cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-weather.el

   1 ;;; xwem-weather.el --- Display weather information in XWEM dock.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Steve Youngs <steve@youngs.au.com>
   6 ;; Created: 2004-06-22
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-weather.el,v 1.5 2005-04-04 19:54:17 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; Display weather information (current local temp) in the dock area.
  32 ;; Optionally display a frame with more detailed weather information.
  33
  34 ;; Set this up by adding the following code to your ~/.xwem/xwemrc.el
  35
  36 ;; (require 'xwem-weather)
  37 ;; (customize-set-variable 'xwem-weather-update-frequency 3600)
  38 ;; (add-hook 'xwem-after-init-hook 'xwem-weather-init)
  39
  40 ;;; Code:
  41 \f
  42
  43 (require 'itimer)
  44
  45 (require 'xwem-osd)
  46 (require 'xwem-interactive)
  47 (require 'xwem-help)
  48 (require 'xwem-compat)
  49
  50 (defgroup xwem-weather nil
  51   "XWEM Weather options."
  52   :prefix "xwem-weather-"
  53   :group 'xwem)
  54
  55 (defcustom xwem-weather-station-id "ybbn"
  56   "*The four letter weather station ID.
  57
  58 The default setting is the author's local station, Brisbane,
  59 Australia.  So you can all be jealous of the wonderful weather we
  60 have in Australia. :-P
  61
  62 You should be able to find out what the code is for your nearest
  63 weather station at http://weather.noaa.gov/"
  64   :type 'string
  65   :link '(url-link "http://weather.noaa.gov/")
  66   :group 'xwem-weather)
  67
  68 (defcustom xwem-weather-data-directory xwem-dir
  69   "*The directory to story weather data files."
  70   :type '(directory :must-match t)
  71   :group 'xwem-weather)
  72
  73 (defcustom xwem-weather-data-file
  74   (expand-file-name xwem-weather-station-id xwem-weather-data-directory)
  75   "*File to hold the weather data."
  76   :type 'file
  77   :group 'xwem-weather)
  78
  79 (defcustom xwem-weather-temperature-format 'celsius
  80   "*Display temperature in Celsius or Fahrenheit."
  81   :type '(choice
  82           (const :tag "Celsius" celsius)
  83           (const :tag "Fahrenheit" fahrenheit))
  84   :group 'xwem-weather)
  85
  86 (defface xwem-weather-osd-face
  87   '((((class color))
  88      (:foreground "cyan" :family "fixed" :size "12pt"))
  89     (t
  90      (:family "fixed" :size "12pt")))
  91   "*Face for the weather OSD."
  92   :group 'xwem-weather)
  93
  94 (defvar xwem-weather-menu
  95   '(["Show details" xwem-weather-show-details]
  96     ["Update" xwem-weather-update]
  97     "---"
  98     ["Destroy" xwem-weather-remove])
  99   "Menu to popup on `xwem-weather-popup-menu' command.
 100 NOTE: title for this menu is formated dynamically.")
 101
 102 ;;;###autoload(autoload 'xwem-weather-prefix "xwem-weather" nil nil 'keymap)
 103 (xwem-define-prefix-command 'xwem-weather-prefix t)
 104 (defvar xwem-weather-keymap (symbol-function 'xwem-weather-prefix)
 105   "Keymap for weather commands.
 106 Bindings:
 107 \\{xwem-weather-keymap}")
 108
 109 (define-key xwem-weather-keymap ?d 'xwem-weather-show-details)
 110 (define-key xwem-weather-keymap ?u 'xwem-weather-update)
 111
 112 ;;; Internal variables
 113
 114 (defvar xwem-weather-osd nil)
 115
 116 (defvar xwem-weather-frequency 0)
 117
 118 (defun xwem-weather-alter-update-frequency (value)
 119   "Alters the update frequency of the weather updates.
 120
 121 DO NOT CALL THIS FUNCTION DIRECTLY.  Change the update frequency
 122 by customising `xwem-weather-update-frequency'.  You MUST use
 123 `customize-set-variable' to do so.
 124
 125 Argument SYM is the symbol name of what is changing the frequency.  It
 126 will always be `xwem-weather-update-frequency'.
 127
 128 Argument VALUE is an integer determining how often, in seconds, to
 129 update the weather data."
 130   (let ((itimer (get-itimer "xwem-weather-itimer")))
 131     (cond ((and (xwem-osd-p xwem-weather-osd)
 132                 value
 133                 itimer)
 134            (set-itimer-value itimer value)
 135            (set-itimer-restart itimer value))
 136           ((and (xwem-osd-p xwem-weather-osd)
 137                 (eq value 0)
 138                 itimer)
 139            (delete-itimer itimer))
 140           ((and (xwem-osd-p xwem-weather-osd)
 141                 (> value 0)
 142                 (not itimer))
 143            (start-itimer "xwem-weather-itimer"
 144                          'xwem-weather-update
 145                          value value))
 146           (t nil))
 147     (setq xwem-weather-frequency value)
 148     (xwem-message 'info "Weather update frequency set to: %d seconds" value)))
 149
 150 ;; This is below the internal variable marker so bug reports aren't
 151 ;; gigabytes long.  I think we can live without this var being in bug
 152 ;; reports. --SY.
 153 (defcustom xwem-weather-update-frequency 0
 154   "*The number of seconds between updates of the weather info.
 155
 156 Most weather stations only update once/hour so it might not be very
 157 beneficial to set this to lower than an hour.
 158
 159 If this is set to 0 updates will not happen.
 160
 161 If you want to set this outside of the custom interface, you MUST use
 162 `customize-set-variable'."
 163   :type '(choice
 164           (integer :tag "Do not update" 0)
 165           (integer :tag "Every 10 minutes" 600)
 166           (integer :tag "Every 15 minutes" 900)
 167           (integer :tag "Every 30 minutes" 1800)
 168           (integer :tag "Every 60 minutes" 3600)
 169           (integer :tag "Every 2 hours" 7200)
 170           (integer :tag "Every 4 hours" 14400)
 171           (integer :tag "Every 12 hours" 43200)
 172           (integer :tag "Every 24 hours" 86400)
 173           (integer :tag "Other"))
 174   :set '(lambda (sym value)
 175           (xwem-weather-alter-update-frequency value))
 176   :initialize 'custom-initialize-default
 177   :group 'xwem-weather)
 178
 179 (defconst xwem-weather-url-fqdn "weather.noaa.gov"
 180   "FQDN part of the weather URL.")
 181
 182 (defconst xwem-weather-url-dir "pub/data/observations/metar/decoded"
 183   "Directory part of the weather URL.")
 184
 185 (defun xwem-weather-retrieve-update ()
 186   "Retrieve weather info."
 187   (let* ((host xwem-weather-url-fqdn)
 188          (dir xwem-weather-url-dir)
 189          (file (upcase (concat xwem-weather-station-id ".txt")))
 190          (path (concat dir "/" file))
 191          (user-agent (concat "XEmacs " emacs-program-version))
 192          (http (open-network-stream "xwem-weather-update"
 193                                     " *xwem-weather-update-buf*"
 194                                     host 80))
 195          (pbuf (process-buffer http)))
 196     (process-send-string
 197      http
 198      (concat "GET /" path " HTTP/1.1\r\n"
 199              "MIME-Version: 1.0\r\n"
 200              "Connection: close\r\n"
 201              "Extension: Security/Digest Security/SSL\r\n"
 202              "Host: " host "\r\n"
 203              "Accept: */*\r\n"
 204              "User-Agent: " user-agent "\r\n\r\n"))
 205     (while (eq (process-status http) 'open)
 206       (dispatch-event (next-event)))
 207     (with-temp-buffer
 208       (erase-buffer)
 209       (insert-buffer pbuf)
 210       (goto-char (point-min))
 211       (re-search-forward "^Content-Length: \\([0-9]+.*$\\)" nil t)
 212       (let* ((file-length (string-to-int (match-string 1)))
 213              (file-begin (progn
 214                            (goto-char (point-min))
 215                            (re-search-forward "^Content-Type:" nil t)
 216                            (forward-line 2)
 217                            (point-at-bol))))
 218         (goto-char file-begin)
 219         (forward-char file-length)
 220         (narrow-to-region file-begin (point))
 221         (write-region (point-min) (point-max) xwem-weather-data-file)))
 222     (kill-buffer pbuf)))
 223
 224 (defun xwem-weather-get-temp ()
 225   "Return the temperature as a string from the weather data file."
 226   (with-temp-buffer
 227     (erase-buffer)
 228     (insert-file-contents-literally xwem-weather-data-file)
 229     (goto-char (point-min))
 230     (when (re-search-forward
 231            "^Temperature: \\(-?[0-9]+ F\\) (\\(-?[0-9]+ C\\))" nil t)
 232       (let ((temp-f (match-string 1))
 233             (temp-c (match-string 2)))
 234         (if (eq xwem-weather-temperature-format 'celsius)
 235             temp-c
 236           temp-f)))))
 237
 238 (defun xwem-weather-osd-text-width (text)
 239   "Return TEXT width."
 240   (X-Text-width
 241    (xwem-dpy)
 242    (or (and (xwem-osd-p xwem-weather-osd)
 243             (X-Gc-font (xwem-osd-mask-gc xwem-weather-osd)))
 244        (X-Font-get (xwem-dpy) (face-font-name 'xwem-weather-osd-face)))
 245    text))
 246
 247 (defun xwem-weather-osd-text-height (text)
 248   "Return TEXT width."
 249   (X-Text-height
 250    (xwem-dpy)
 251    (or (and (xwem-osd-p xwem-weather-osd)
 252             (X-Gc-font (xwem-osd-mask-gc xwem-weather-osd)))
 253        (X-Font-get (xwem-dpy) (face-font-name 'xwem-weather-osd-face)))
 254    text))
 255
 256 (defun xwem-weather-display-text (text)
 257   "Display TEXT in weather dockapp."
 258   (let ((we-width (xwem-weather-osd-text-width text))
 259         (height (xwem-weather-osd-text-height text))
 260         (goff (xwem-weather-osd-text-width
 261                (substring text 0 (- (length text) 2)))))
 262     (xwem-osd-set-width xwem-weather-osd we-width)
 263     (xwem-osd-set-height xwem-weather-osd height)
 264     (xwem-osd-text xwem-weather-osd text)
 265
 266     ;; Display degree
 267     (xwem-osd-arc-add xwem-weather-osd
 268                       (make-X-Arc :x goff :y 0
 269                                   :width 3 :height 3
 270                                   :angle1 0 :angle2 360))))
 271
 272 ;;;###autoload(autoload 'xwem-weather-update "xwem-weather" nil t)
 273 (define-xwem-command xwem-weather-update ()
 274   "*Update the weather OSD."
 275   (xwem-interactive "_")
 276
 277   (xwem-weather-retrieve-update)
 278   (when (xwem-osd-p xwem-weather-osd)
 279     (xwem-weather-display-text (xwem-weather-get-temp))))
 280
 281 ;;;###autoload(autoload 'xwem-weather-show-details "xwem-weather" nil t)
 282 (define-xwem-command xwem-weather-show-details ()
 283   "*Show the details of the current weather information."
 284   (xwem-interactive)
 285   (xwem-help-display "weather"
 286    (insert-file-contents xwem-weather-data-file)))
 287
 288 ;;;###autoload(autoload 'xwem-weather-popup-remove "xwem-weather" nil t)
 289 (define-xwem-command xwem-weather-remove ()
 290   "*Remove the weather OSD."
 291   (xwem-interactive)
 292   (when (xwem-osd-p xwem-weather-osd)
 293     (xwem-osd-destroy xwem-weather-osd))
 294   (when (itimerp (get-itimer "xwem-weather-itimer"))
 295     (delete-itimer (get-itimer "xwem-weather-itimer"))))
 296
 297 ;;;###autoload(autoload 'xwem-weather-popup-menu "xwem-weather" nil t)
 298 (define-xwem-command xwem-weather-popup-menu (ev)
 299   "Popup weather menu."
 300   (xwem-interactive (list xwem-last-event))
 301   (unless (button-event-p ev)
 302     (error 'xwem-error
 303            "`xwem-weather-popup-menu' must be bound to mouse event"))
 304   (xwem-popup-menu
 305    (cons (format "Weather (%s)" (upcase xwem-weather-station-id))
 306          xwem-weather-menu)))
 307
 308 (defvar xwem-weather-osd-keymap
 309   (let ((map (make-sparse-keymap 'xwem-weather-osd-keymap)))
 310     (define-key map [button1] 'xwem-weather-show-details)
 311     (define-key map [button2] 'xwem-weather-update)
 312     (define-key map [button3] 'xwem-weather-popup-menu)
 313     map)
 314   "Keymap for weather OSD.")
 315
 316 (define-xwem-command xwem-weather-display-temp (&optional force)
 317   "*Display the current temperature using OSD."
 318   (xwem-interactive "P")
 319   (when force
 320     (xwem-weather-retrieve-update))
 321
 322   (if (xwem-osd-p xwem-weather-osd)
 323       (xwem-weather-display-text (xwem-weather-get-temp))
 324
 325     ;; Create and setup weather osd than display current weather
 326     (let ((text (xwem-weather-get-temp)))
 327       (setq xwem-weather-osd
 328             (xwem-osd-create-dock
 329              (xwem-dpy)
 330              (xwem-weather-osd-text-width text)
 331              (xwem-weather-osd-text-height text)
 332              (list 'keymap xwem-weather-osd-keymap)))
 333       (xwem-osd-set-color xwem-weather-osd
 334                           (face-foreground-name 'xwem-weather-osd-face))
 335       (xwem-osd-set-font xwem-weather-osd
 336                          (face-font-name 'xwem-weather-osd-face))
 337
 338       ;; Do it so, `xwem-weather-osd-text-height' and
 339       ;; `xwem-weather-osd-text-height' will use mask's gc.
 340       (xwem-osd-create-mask xwem-weather-osd)
 341       (xwem-weather-display-text text))))
 342
 343 ;;;###autoload
 344 (defun xwem-weather-init (&optional dockid dockgroup dockalign)
 345   "Initialise the weather dock."
 346   (when (xwem-osd-p xwem-weather-osd)
 347     (xwem-osd-destroy xwem-weather-osd))
 348   (when (itimerp (get-itimer "xwem-weather-itimer"))
 349     (delete-itimer (get-itimer "xwem-weather-itimer")))
 350   (xwem-weather-display-temp 'force)
 351   (unless (zerop xwem-weather-frequency)
 352     (start-itimer "xwem-weather-itimer"
 353                   'xwem-weather-update
 354                   xwem-weather-frequency
 355                   xwem-weather-frequency)))
 356
 357 \f
 358 (provide 'xwem-weather)
 359
 360 ;;; On-load actions
 361 (xwem-global-set-key (xwem-kbd "H-c W") 'xwem-weather-prefix)
 362
 363 ;;; xwem-weather.el ends here