code.delx.au - gnu-emacs-elpa/blob - packages/metar/metar.el

   1 ;;; metar.el --- Retrieve and decode METAR weather information
   2
   3 ;; Copyright (C) 2007, 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Version: 0.1
   7 ;; Package-Requires: ((cl-lib "0.5"))
   8 ;; Keywords: comm
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Run `M-x metar RET' to get a simple weather report from weather.noaa.gov.
  26 ;; The value of `calendar-latitude' and `calendar-longitude' will be used to
  27 ;; automatically determine a nearby station.  If these variables are not set,
  28 ;; you will be prompted to enter the location manually.
  29 ;;
  30 ;; With `C-u M-x metar RET', country and station name need to be entered.
  31 ;; `C-u C-u M-x metar RET' will prompt for the METAR station code (4 letters).
  32 ;;
  33 ;; Customize `metar-units' to change length, speed, temperature or pressure
  34 ;; units to your liking.
  35 ;;
  36 ;; For programmatic access to decoded weather reports, use:
  37 ;;
  38 ;;   (metar-decode (metar-get-record "CODE"))
  39
  40 ;;; Code:
  41
  42 (require 'calc-units)
  43 (require 'cl-lib)
  44 (require 'format-spec)
  45 (require 'rx)
  46 (require 'solar)
  47 (require 'url)
  48
  49 (defgroup metar ()
  50   "METAR weather reports."
  51   :group 'net-utils)
  52
  53 (defcustom metar-units '((length . m)
  54                          (pressure . hPa)
  55                          (speed . kph)
  56                          (temperature . degC))
  57   "Default measurement units to use when reporting weather information."
  58   :group 'metar
  59   :type '(list (cons :format "%v"
  60                      (const :tag "Length: " length)
  61                      (choice (const :tag "Meter" m)
  62                              (const :tag "Inch" in)
  63                              (const :tag "Foot" ft)
  64                              (const :tag "Yard" yd)
  65                              (const :tag "Mile" mi)))
  66                (cons :format "%v"
  67                      (const :tag "Pressure:" pressure)
  68                      (choice (const :tag "Pascal" Pa)
  69                              (const :tag "Hecto pascal" hPa)
  70                              (const :tag "Bar" bar)
  71                              (const :tag "Inch of mercury" inHg)
  72                              (const :tag "Standard atmosphere" atm)
  73                              (const :tag "Meter of mercury" mHg)
  74                              (const :tag "Punds per square inch" psi)))
  75                (cons :format "%v"
  76                      (const :tag "Speed:" speed)
  77                      (choice (const :tag "Kilometers per hour" kph)
  78                              (const :tag "Miles per hour" mph)
  79                              (const :tag "Knot" knot)))
  80                (cons :format "%v"
  81                      (const :tag "Temperature:" temperature)
  82                      (choice (const :tag "Degree Celsius" degC)
  83                              (const :tag "Degree Kelvin" degK)
  84                              (const :tag "Degree Fahrenheit" degF)))))
  85
  86 (defcustom metar-stations-info-url "http://weather.noaa.gov/data/nsd_bbsss.txt"
  87   "URL to use for retrieving station meta information."
  88   :group 'metar
  89   :type 'string)
  90
  91 (defvar metar-stations nil
  92   "Variable containing (cached) METAR station information.
  93 Use the function `metar-stations' to get the actual station list.")
  94
  95 (defun metar-station-convert-dms-to-deg (string)
  96   "Convert degrees, minutes and optional seconds, to degrees."
  97   (when (string-match (rx string-start
  98                           (group (1+ digit)) ?- (group (1+ digit))
  99                           (optional ?- (group (1+ digit)))
 100                           (group (char ?N ?E ?S ?W))
 101                           string-end) string)
 102     (funcall (if (memq (aref (match-string 4 string) 0) '(?N ?E)) #'+ #'-)
 103              (+ (string-to-number (match-string 1 string))
 104                 (/ (string-to-number (match-string 2 string)) 60.0)
 105                 (if (match-string 3 string)
 106                     (/ (string-to-number (match-string 3 string)) 3600.0)
 107                   0)))))
 108
 109 (defun metar-stations ()
 110   "Retrieve a list of METAR stations.
 111 Results are cached in variable `metar-stations'.
 112 If this variable is nil, the information is retrieved from the Internet."
 113   (or metar-stations
 114       (let ((data (with-temp-buffer
 115                     (url-insert-file-contents metar-stations-info-url)
 116                     (mapcar (lambda (entry)
 117                               (split-string entry ";"))
 118                             (split-string (buffer-string) "\n")))))
 119         (setq metar-stations nil)
 120         (while data
 121           (when (and (nth 7 (car data)) (nth 8 (car data))
 122                      (not (string= (nth 2 (car data)) "----")))
 123             (setq metar-stations
 124                   (append
 125                    (let ((item (car data)))
 126                      (list
 127                       (list (cons 'code (nth 2 item))
 128                             (cons 'name (nth 3 item))
 129                             (cons 'country (nth 5 item))
 130                             (cons 'latitude
 131                                   (metar-station-convert-dms-to-deg (nth 7 item)))
 132                             (cons 'longitude
 133                                   (metar-station-convert-dms-to-deg (nth 8 item)))
 134                             (cons 'altitude (string-to-number (nth 12 item))))))
 135                    metar-stations)))
 136           (setq data (cdr data)))
 137         ;; (unless metar-timer
 138         ;;   (setq metar-timer
 139         ;;      (run-with-timer 600 nil (lambda () (setq metar-stations nil)))))
 140         metar-stations)))
 141
 142 (defun metar-stations-get (station-code key)
 143   "Get meta information for station with STATION-CODE and KEY.
 144 KEY can be one of the symbols `code', `name', `country', `latitude',
 145 `longitude' or `altitude'."
 146   (let ((stations (metar-stations)) result)
 147     (while stations
 148       (when (string= (cdr (assoc 'code (car stations))) station-code)
 149         (setq result (cdr (assoc key (car stations)))
 150               stations nil))
 151       (setq stations (cdr stations)))
 152     result))
 153
 154 (defun metar-latitude-longitude-bearing (latitude1 longitude1
 155                                          latitude2 longitude2)
 156   "Calculate bearing from start point LATITUDE1/LONGITUDE1 to end point
 157 LATITUDE2/LONGITUDE2."
 158   (% (+ 360
 159         (truncate
 160          (radians-to-degrees
 161           (atan (* (sin (degrees-to-radians (- longitude2 longitude1)))
 162                    (cos (degrees-to-radians latitude2)))
 163                 (- (* (cos (degrees-to-radians latitude1))
 164                       (sin (degrees-to-radians latitude2)))
 165                    (* (sin (degrees-to-radians latitude1))
 166                       (cos (degrees-to-radians latitude2))
 167                       (cos (degrees-to-radians (- longitude2 longitude1)))))))))
 168      360))
 169
 170 (defun metar-latitude-longitude-distance-haversine (latitude1 longitude1
 171                                                     latitude2 longitude2)
 172   "Caluclate the distance (in kilometers) between two points on the
 173 surface of the earth given as LATITUDE1, LONGITUDE1, LATITUDE2 and LONGITUDE2."
 174   (cl-macrolet ((distance (d1 d2)
 175                           `(expt (sin (/ (degrees-to-radians (- ,d2 ,d1)) 2)) 2)))
 176     (let ((a (+ (distance latitude1 latitude2)
 177                 (* (cos (degrees-to-radians latitude1))
 178                    (cos (degrees-to-radians latitude2))
 179                    (distance longitude1 longitude2)))))
 180       (* 6371 (* 2 (atan (sqrt a) (sqrt (- 1 a))))))))
 181
 182 (defun metar-find-station-by-latitude/longitude (latitude longitude &optional
 183                                                           radius)
 184   "Find a station near the coordinates given by LATITUDE and LONGITUDE.
 185 Returns a cons where car is the station code and cdr is the distance in
 186 kilometers.
 187 If RADIUS is non-nil, only stations within this range (in kilometers) are
 188 considered.
 189 If no match if found, nil is returned."
 190   (interactive
 191    (list
 192     (solar-get-number "Enter latitude (decimal fraction; + north, - south): ")
 193     (solar-get-number "Enter longitude (decimal fraction; + east, - west): ")))
 194   (let ((stations (metar-stations))
 195         (best-distance (or radius 10000))
 196         (station-code nil))
 197     (while stations
 198       (let ((station-latitude (cdr (assoc 'latitude (car stations))))
 199             (station-longitude (cdr (assoc 'longitude (car stations)))))
 200         (when (and station-latitude station-longitude)
 201           (let ((distance (metar-latitude-longitude-distance-haversine
 202                            latitude longitude
 203                            station-latitude station-longitude)))
 204             (when (< distance best-distance)
 205               (setq best-distance distance
 206                     station-code (cdr (assoc 'code (car stations))))))))
 207       (setq stations (cdr stations)))
 208     (if (called-interactively-p 'interactive)
 209         (if station-code
 210             (message "%s, %s (%s) at %s is %d km away from %s."
 211                      (metar-stations-get station-code 'name)
 212                      (metar-stations-get station-code 'country)
 213                      station-code
 214                      (let ((float-output-format "%.1f"))
 215                        (format "%s%s, %s%s"
 216                                (abs (metar-stations-get station-code 'latitude))
 217                                (if (> (metar-stations-get station-code 'latitude) 0) "N" "S")
 218                                (abs (metar-stations-get station-code 'longitude))
 219                                (if (> (metar-stations-get station-code 'longitude) 0) "E" "W")))
 220                      best-distance
 221                      (let ((float-output-format "%.1f"))
 222                        (format "%s%s, %s%s"
 223                                (if (numberp latitude)
 224                                    (abs latitude)
 225                                  (+ (aref latitude 0)
 226                                     (/ (aref latitude 1) 60.0)))
 227                                (if (numberp latitude)
 228                                    (if (> latitude 0) "N" "S")
 229                                  (if (equal (aref latitude 2) 'north) "N" "S"))
 230                                (if (numberp longitude)
 231                                    (abs longitude)
 232                                  (+ (aref longitude 0)
 233                                     (/ (aref longitude 1) 60.0)))
 234                                (if (numberp longitude)
 235                                    (if (> longitude 0) "E" "W")
 236                                  (if (equal (aref longitude 2) 'east)
 237                                      "E" "W")))))
 238           (message "No appropriate station found."))
 239       (when station-code
 240         (cons station-code (round best-distance))))))
 241
 242 (defun metar-convert-unit (value new-unit)
 243   "Convert VALUE to NEW-UNIT.
 244 VALUE is a string with the value followed by the unit, like \"5 knot\"
 245 and NEW-UNIT should be a unit name like \"kph\" or similar."
 246   (cl-check-type value string)
 247   (cl-check-type new-unit (or string symbol))
 248   (cl-multiple-value-bind (value unit)
 249       (split-string
 250        (math-format-value
 251         (math-convert-units (math-simplify (math-read-expr value))
 252                             (math-read-expr
 253                              (cl-etypecase new-unit
 254                                            (string new-unit)
 255                                            (symbol (symbol-name new-unit))))))
 256        " ")
 257     (cons (string-to-number value) (intern unit))))
 258
 259 (defun metar-convert-temperature (string &optional unit)
 260   (let* ((value (concat (if (= (aref string 0) ?M)
 261                             (concat "-" (substring string 1))
 262                           string)
 263                         "degC"))
 264          (expr (math-read-expr value))
 265          (old-unit (math-single-units-in-expr-p expr))
 266          (new-unit (or unit (cdr (assq 'temperature metar-units)))))
 267     (if old-unit
 268         (cl-multiple-value-bind (value unit)
 269             (split-string
 270              (math-format-value
 271               (math-simplify-units
 272                (math-convert-temperature
 273                 expr
 274                 (list 'var
 275                       (car old-unit)
 276                       (intern (concat "var-" (symbol-name (car old-unit)))))
 277                 (math-read-expr (cl-etypecase new-unit
 278                                   (string new-unit)
 279                                   (symbol (symbol-name new-unit))))))) " ")
 280           (cons (string-to-number value) (intern unit))))))
 281
 282 (defcustom metar-url
 283   "http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT"
 284   "URL used to fetch station specific information.
 285 %s is replaced with the 4 letter station code."
 286   :group 'metar
 287   :type 'string)
 288
 289 (defun metar-url (station)
 290   (format metar-url
 291           (upcase (cl-etypecase station
 292                     (string station)
 293                     (symbol (symbol-name station))))))
 294
 295 (defconst metar-record-regexp
 296   (rx (group (1+ digit)) ?/ (group (1+ digit)) ?/ (group (1+ digit))
 297       space
 298       (group (1+ digit)) ?: (group (1+ digit))
 299       ?\n
 300       (group "%s" (* not-newline)))
 301   "Regular expression used to extract METAR information from `metar-url'.
 302 %s is replaced with the station code which always has to be present in a METAR
 303 record.")
 304
 305 (defun metar-get-record (station)
 306   "Retrieve a METAR/SPECI record for STATION from the Internet.
 307 Return a cons where `car' is the time of the measurement (as an emacs-lsip
 308 time value) and `cdr' is a string containing the actual METAR code.
 309 If no record was found for STATION, nil is returned."
 310   (with-temp-buffer
 311     (url-insert-file-contents (metar-url station))
 312     (when (re-search-forward (format metar-record-regexp station) nil t)
 313       (cons (encode-time
 314              0
 315              (string-to-number (match-string 5))
 316              (string-to-number (match-string 4))
 317              (string-to-number (match-string 3))
 318              (string-to-number (match-string 2))
 319              (string-to-number (match-string 1))
 320              0)
 321             (match-string 6)))))
 322
 323 (defconst metar-could-regexp
 324   (rx symbol-start
 325       (group (or "FEW" "SCT" "BKN" "OVC"))
 326       (group (= 3 digit))
 327       (optional (group (or "TCU" "CB")))
 328       symbol-end)
 329   "Regular expression to match cloud information in METAR records.")
 330
 331 (defun metar-clouds (info)
 332   (let ((clouds ())
 333         (from 0))
 334     (while (string-match metar-could-regexp info from)
 335       (setq from (match-end 0)
 336             clouds (push (append (list (match-string 1 info)
 337                                        (metar-convert-unit
 338                                         (concat (match-string 2 info) " ft")
 339                                         (cdr (assq 'length metar-units))))
 340                                  (when (match-string 3 info)
 341                                    (list (match-string 3 info))))
 342                          clouds)))
 343     clouds))
 344
 345 (defconst metar-phenomena '(("BC" . "patches")
 346                             ("BL" . "blowing")
 347                             ("BR" . "mist")
 348                             ("DR" . "drifting")
 349                             ("DS" . "dust storm")
 350                             ("DU" . "widespread dust")
 351                             ("DZ" . "drizzle")
 352                             ("FC" . "funnel cloud")
 353                             ("FG" . "fog")
 354                             ("FU" . "smoke")
 355                             ("FZ" . "freezing")
 356                             ("GR" . "hail")
 357                             ("GS" . "small hail/snow pellets")
 358                             ("HZ" . "haze")
 359                             ("IC" . "ice crystals")
 360                             ("MI" . "shallow")
 361                             ("PL" . "ice pellets")
 362                             ("PO" . "well developed dust/sand swirls")
 363                             ("PR" . "partials")
 364                             ("PY" . "spray")
 365                             ("RA" . "rain")
 366                             ("SA" . "sand")
 367                             ("SG" . "snow grains")
 368                             ("SH" . "showers")
 369                             ("SN" . "snow")
 370                             ("SQ" . "squall")
 371                             ("SS" . "sand storm")
 372                             ("TS" . "thunderstorm")
 373                             ("VA" . "volcanic ash")
 374                             ("VC" . "vicinity"))
 375   "Alist of codes and descriptions for METAR weather phenomenoa.")
 376
 377 (defconst metar-phenomena-regexp
 378   (eval `(rx symbol-start
 379              (group (optional (char ?+ ?-)))
 380              (group (1+ (or ,@(mapcar #'car metar-phenomena))))
 381              symbol-end))
 382   "Regular expression to match weather phenomena in METAR records.")
 383
 384 (defun metar-phenomena (info)
 385   (when (string-match metar-phenomena-regexp info)
 386     (let ((words ()))
 387       (when (string= (match-string 1 info) "-")
 388         (push "light" words))
 389       (let ((obs (match-string 2 info)))
 390         (while (> (length obs) 0)
 391           (setq words (nconc words
 392                              (list (cdr (assoc-string (substring obs 0 2)
 393                                                       metar-phenomena))))
 394                 obs (substring obs 2))))
 395       (mapconcat #'identity words " "))))
 396
 397 (defconst metar-wind-regexp
 398   (rx symbol-start
 399       (group (or "VRB" (= 3 digit)))
 400       (group (repeat 2 3 digit)) (optional (char ?G) (group (1+ digit)))
 401       "KT"
 402       symbol-end
 403       (optional (one-or-more not-newline)
 404                 symbol-start
 405                 (group (= 3 digit)) (char ?V) (group (= 3 digit))
 406                 symbol-end))
 407   "Regular expression to match wind information in METAR records.")
 408
 409 (defsubst metar-degrees (value)
 410   (cons value 'degrees))
 411
 412 (defun metar-wind (info)
 413   (when (string-match metar-wind-regexp info)
 414     (append
 415      (if (string= (match-string 1 info) "VRB")
 416          (when (and (match-string 4 info) (match-string 5 info))
 417            (list :from (string-to-number (match-string 4 info))
 418                  :to (string-to-number (match-string 5 info))))
 419        (append
 420         (list :direction (metar-degrees
 421                           (string-to-number (match-string 1 info))))
 422         (when (and (match-string 4 info) (match-string 5 info))
 423           (list :from (metar-degrees (string-to-number (match-string 4 info)))
 424                 :to (metar-degrees (string-to-number (match-string 5 info)))))))
 425      (list :speed (metar-convert-unit (concat (match-string 2 info) "knot")
 426                                       (cdr (assq 'speed metar-units))))
 427      (when (match-string 3 info)
 428        (list :gust (metar-convert-unit (concat (match-string 3 info) "knot")
 429                                        (cdr (assq 'speed metar-units))))))))
 430
 431 (defconst metar-visibility-regexp
 432   (rx symbol-start (group (1+ digit)) (optional (group "SM")) symbol-end)
 433   "Regular expression to match information about visibility in METAR records.")
 434
 435 (defconst metar-temperature-and-dewpoint-regexp
 436   (rx symbol-start
 437       (group (group (optional (char ?M))) (1+ digit))
 438       (char ?/)
 439       (group (group (optional (char ?M))) (1+ digit))
 440       symbol-end)
 441   "Regular expression to match temperature and dewpoint information in METAR
 442 records.")
 443
 444 (defun metar-temperature (info)
 445   (when (string-match metar-temperature-and-dewpoint-regexp info)
 446     (metar-convert-temperature (match-string 1 info))))
 447
 448 (defun metar-dewpoint (info)
 449   (when (string-match metar-temperature-and-dewpoint-regexp info)
 450     (metar-convert-temperature (match-string 3 info))))
 451
 452 (defun metar-humidity (info)
 453   (when (string-match metar-temperature-and-dewpoint-regexp info)
 454     (cons (round
 455            (metar-magnus-formula-humidity-from-dewpoint
 456             (save-match-data (car (metar-convert-temperature
 457                                    (match-string 1 info) 'degC)))
 458             (car (metar-convert-temperature (match-string 3 info) 'degC))))
 459           'percent)))
 460
 461 (defconst metar-pressure-regexp
 462   (rx symbol-start (group (char ?Q ?A)) (group (1+ digit)) symbol-end)
 463   "Regular expression to match air pressure information in METAR records.")
 464
 465 (defun metar-pressure (info)
 466   (when (string-match metar-pressure-regexp info)
 467     (metar-convert-unit
 468      (concat (match-string 2 info)
 469              (cond
 470               ((string= (match-string 1 info) "Q") "hPa")
 471               ((string= (match-string 1 info) "A") "cinHg")))
 472      (cdr (assq 'pressure metar-units)))))
 473
 474 (defun metar-decode (record)
 475   "Return a lisp structure describing the weather information in RECORD."
 476   (when record
 477     (let* ((codes (cdr record))
 478            (temperature (metar-temperature codes))
 479            (dewpoint (metar-dewpoint codes))
 480            (humidity (metar-humidity codes))
 481            (pressure (metar-pressure codes))
 482            (wind (metar-wind codes)))
 483       (append
 484        (list (cons 'station (car (split-string codes " ")))
 485              (cons 'timestamp (car record))
 486              (cons 'wind wind)
 487              (cons 'temperature temperature)
 488              (cons 'dewpoint dewpoint)
 489              (cons 'humidity humidity)
 490              (cons 'pressure pressure))
 491        (when (metar-phenomena codes)
 492          (list (cons 'phenomena (metar-phenomena codes))))))))
 493
 494 (defun metar-magnus-formula-humidity-from-dewpoint (temperature dewpoint)
 495   "Calculate relative humidity (in %) from TEMPERATURE and DEWPOINT (in
 496 degrees celsius)."
 497   (* 10000
 498      (expt 10
 499            (- (/ (- (* 0.4343
 500                        (+ 243.12 temperature)
 501                        (/ (* dewpoint 17.62)
 502                           (+ 243.12 dewpoint)))
 503                     (* 0.4343 17.62 temperature))
 504                  (+ 243.12 temperature))
 505               2))))
 506
 507 ;;;###autoload
 508 (defun metar (&optional arg)
 509   "Display recent weather information.
 510 If a prefix argument is given, prompt for country and station name.
 511 If two prefix arguments are given, prompt for exact station code.
 512 Otherwise, determine the best station via latitude/longitude."
 513   (interactive "p")
 514   (unless arg (setq arg 1))
 515   (let (station)
 516     (cond
 517      ((= arg 1)
 518       (unless calendar-longitude
 519         (setq calendar-longitude
 520               (solar-get-number
 521                "Enter longitude (decimal fraction; + east, - west): ")))
 522       (unless calendar-latitude
 523         (setq calendar-latitude
 524               (solar-get-number
 525              "Enter latitude (decimal fraction; + north, - south): ")))
 526       (when (and calendar-latitude calendar-longitude
 527                  (setq station (metar-find-station-by-latitude/longitude
 528                                 (calendar-latitude) (calendar-longitude))))
 529         (message "Found %s %d kilometers away." (car station) (cdr station))
 530         (setq station (car station))))
 531      ((= arg 4)
 532       (let* ((country (completing-read "Country: " (metar-station-countries) nil t))
 533              (name (completing-read "Station name: " (mapcar (lambda (s) (cdr (assq 'name s)))
 534                                                              (metar-stations-in-country country))
 535                                     nil t)))
 536         (setq station (cdr (assq 'code (cl-find-if (lambda (s)
 537                                                      (and (string= name (cdr (assq 'name s)))
 538                                                           (string= country (cdr (assq 'country s)))))
 539                                                    (metar-stations)))))))
 540      ((= arg 16)
 541       (setq station (completing-read "Enter METAR station code: "
 542                                      (mapcar (lambda (station-info)
 543                                                (cdr (assq 'code station-info)))
 544                                              (metar-stations))
 545                                      nil t))))
 546     (let ((info (metar-decode (metar-get-record station))))
 547       (if info
 548           (message "%d minutes ago at %s: %d°%c, %s%d%% humidity, %.1f %S."
 549                    (/ (truncate (float-time (time-since
 550                                              (cdr (assoc 'timestamp info)))))
 551                       60)
 552                    (or (metar-stations-get (cdr (assoc 'station info)) 'name)
 553                        (cdr (assoc 'station info)))
 554                    (cadr (assoc 'temperature info))
 555                    (cond
 556                     ((eq (cdr (assq 'temperature metar-units)) 'degC) ?C)
 557                     ((eq (cdr (assq 'temperature metar-units)) 'degF) ?F))
 558                    (if (assoc 'phenomena info)
 559                        (concat (cdr (assoc 'phenomena info)) ", ")
 560                      "")
 561                    (cadr (assoc 'humidity info))
 562                    (cadr (assoc 'pressure info)) (cddr (assoc 'pressure info)))
 563         (message "No weather information found, sorry.")))))
 564
 565 (defun metar-station-countries ()
 566   (let (countries)
 567     (dolist (station (metar-stations))
 568       (let ((country (cdr (assq 'country station))))
 569         (cl-pushnew country countries :test #'equal)))
 570     countries))
 571
 572 (defun metar-stations-in-country (country)
 573   (cl-loop for station-info in (metar-stations)
 574            when (string= country (cdr (assq 'country station-info)))
 575            collect station-info))
 576
 577 (defun metar-average-temperature (country)
 578   "Display average temperature from all stations in COUNTRY."
 579   (interactive
 580    (list (completing-read "Country: " (metar-station-countries) nil t)))
 581   (let ((count 0) (temp-sum 0)
 582         (stations (metar-stations))
 583         (url-show-status nil)
 584         (progress (make-progress-reporter
 585                    "Downloading METAR records..."
 586                    0
 587                    (cl-count-if (lambda (station)
 588                                   (string= (cdr (assoc 'country station))
 589                                            country))
 590                                 (metar-stations)))))
 591     (while stations
 592       (when (string= (cdr (assoc 'country (car stations))) country)
 593         (let ((temp (cdr (assoc 'temperature
 594                                 (metar-decode
 595                                  (metar-get-record
 596                                   (cdr (assoc 'code (car stations)))))))))
 597           (when temp
 598             (setq temp-sum (+ temp-sum temp)
 599                   count (+ count 1))
 600             (progress-reporter-update progress count))))
 601       (setq stations (cdr stations)))
 602     (progress-reporter-done progress)
 603     (if (called-interactively-p 'interactive)
 604         (message "Average temperature in %s is %s"
 605                  country
 606                  (if (> count 0)
 607                      (format "%.1f°C (%d stations)"
 608                              (/ (float temp-sum) count)
 609                              count)
 610                    "unknown"))
 611       (when (> count 0)
 612         (/ (float temp-sum) count)))))
 613
 614 (defun metar-format (format report)
 615   (format-spec
 616    format
 617    (list (cons ?d
 618                (let ((dewpoint (cdr (assq 'dewpoint report))))
 619                  (format "%.1f°%c"
 620                          (car dewpoint)
 621                          (cond ((eq (cdr dewpoint) 'degC) ?C)
 622                                ((eq (cdr dewpoint) 'degF) ?F)
 623                                ((eq (cdr dewpoint) 'degK) ?K)))))
 624          (cons ?h
 625                (let ((humidity (cdr (assq 'humidity report))))
 626                  (format "%d%%" (car humidity))))
 627          (cons ?p
 628                (let ((pressure (cdr (assq 'pressure report))))
 629                  (format "%.1f %S" (car pressure) (cdr pressure))))
 630          (cons ?s (cdr (assq 'station report)))
 631          (cons ?t
 632                (let ((temperature (cdr (assq 'temperature report))))
 633                  (format "%.1f°%c"
 634                          (car temperature)
 635                          (cond ((eq (cdr temperature) 'degC) ?C)
 636                                ((eq (cdr temperature) 'degF) ?F))))))))
 637
 638 (provide 'metar)
 639 ;;; metar.el ends here