--- /dev/null
+;;; all.el --- Edit all lines matching a given regexp
+
+;; Copyright (C) 1985-1987,1992,1994,2011-2012 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Version: 1.0
+;; Keywords: matching
+
+;; LCD Archive Entry:
+;; all|Per Abrahamsen|abraham@dina.kvl.dk|
+;; Edit all lines matching a given regexp|
+;; $Date: 1997/03/04 10:29:42 $|$Revision: 5.2 $|~/misc/all.Z|
+
+;; This program 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, or (at your option)
+;; any later version.
+;;
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Just like occur, except that changes in the *All* buffer are
+;; propagated to the original buffer.
+
+;; You can no longer use mouse-2 to find a match in the original file,
+;; since the default definition of mouse is too useful.
+;; However, `C-c C-c' still works.
+
+;; Line numbers are not listed in the *All* buffer.
+
+;; Ok, it is _not_ just like occur.
+
+;; Some limitations:
+
+;; - Undo in the *All* buffer is an ordinary change in the original.
+;; - Changes to the original buffer are not reflected in the *All* buffer.
+;; - A single change in the *All* buffer must be limited to a single match.
+
+;;; Code:
+
+(defvar all-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-c" 'all-mode-goto)
+ map))
+
+(defvar all-buffer nil)
+(make-variable-buffer-local 'all-buffer)
+
+(define-derived-mode all-mode fundamental-mode "All"
+ "Major mode for output from \\[all].
+
+All changes made in this buffer will be propagated to the buffer where
+you ran \\[all].
+
+Press \\[all-mode-goto] to go to the same spot in the original buffer."
+ (add-hook 'before-change-functions 'all-before-change-function nil 'local)
+ (add-hook 'after-change-functions 'all-after-change-function nil 'local))
+
+(defun all-mode-find (pos)
+ ;; Find position in original buffer corresponding to POS.
+ (let ((overlay (all-mode-find-overlay pos)))
+ (if overlay
+ (+ (marker-position (overlay-get overlay 'all-marker))
+ (- pos (overlay-start overlay))))))
+
+(defun all-mode-find-overlay (pos)
+ ;; Find the overlay containing POS.
+ (let ((overlays (overlays-at pos)))
+ (while (and overlays (null (overlay-get (car overlays) 'all-marker)))
+ (setq overlays (cdr overlays)))
+ (car-safe overlays)))
+
+(defun all-mode-goto ()
+ "Move point to the corresponding position in the original buffer."
+ (interactive)
+ (let ((pos (all-mode-find (point))))
+ (if pos
+ (pop-to-buffer all-buffer)
+ (error "This text is not from the original buffer"))
+ (goto-char pos)))
+
+(defvar all-initialization-p nil)
+
+(defun all-before-change-function (from to)
+ ;; Check that change is legal.
+ (and all-buffer
+ (not all-initialization-p)
+ (let ((start (all-mode-find-overlay from))
+ (end (all-mode-find-overlay to)))
+ (not (and start (eq start end))))
+ (error "Changes should be limited to a single text piece")))
+
+(defun all-after-change-function (from to length)
+ ;; Propagate changes from *All* buffer.
+ (and all-buffer
+ (null all-initialization-p)
+ (let ((buffer (current-buffer))
+ (pos (all-mode-find from)))
+ (if pos
+ (with-current-buffer all-buffer
+ (save-excursion
+ (goto-char pos)
+ (delete-region pos (+ pos length))
+ (insert-buffer-substring buffer from to)))))))
+
+;;;###autoload
+(defun all (regexp &optional nlines)
+ "Show all lines in the current buffer containing a match for REGEXP.
+
+If a match spreads across multiple lines, all those lines are shown.
+
+Each line is displayed with NLINES lines before and after, or -NLINES
+before if NLINES is negative.
+NLINES defaults to `list-matching-lines-default-context-lines'.
+Interactively it is the prefix arg.
+
+The lines are shown in a buffer named `*All*'.
+Any changes made in that buffer will be propagated to this buffer."
+ (interactive
+ (list (let* ((default (car regexp-history)))
+ (read-string
+ (if default
+ (format
+ "Edit lines matching regexp (default `%s'): " default)
+ "Edit lines matching regexp: ")
+ nil 'regexp-history default))
+ current-prefix-arg))
+ (setq nlines (if nlines (prefix-numeric-value nlines)
+ list-matching-lines-default-context-lines))
+ (let ((all-initialization-p t)
+ (buffer (current-buffer))
+ (prevend nil)
+ (prevstart nil)
+ (prevpos (point-min)))
+ (with-output-to-temp-buffer "*All*"
+ (with-current-buffer standard-output
+ (all-mode)
+ (setq all-buffer buffer)
+ (insert "Lines matching ")
+ (prin1 regexp)
+ (insert " in buffer " (buffer-name buffer) ?. ?\n)
+ (insert "--------\n"))
+ (if (eq buffer standard-output)
+ (goto-char (point-max)))
+ (save-excursion
+ (goto-char (point-min))
+ ;; Find next match, but give up if prev match was at end of buffer.
+ (while (and (not (= prevpos (point-max)))
+ (re-search-forward regexp nil t))
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (setq prevpos (point))
+ (goto-char (match-end 0))
+ (let* ((start (save-excursion
+ (goto-char (match-beginning 0))
+ (forward-line (if (< nlines 0) nlines (- nlines)))
+ (point)))
+ (end (save-excursion
+ (goto-char (match-end 0))
+ (if (> nlines 0)
+ (forward-line (1+ nlines))
+ (forward-line 1))
+ (point))))
+ (cond ((null prevend)
+ (setq prevstart start
+ prevend end))
+ ((> start prevend)
+ (all-insert prevstart prevend regexp nlines)
+ (setq prevstart start
+ prevend end))
+ (t
+ (setq prevend end)))))
+ (if prevend
+ (all-insert prevstart prevend regexp nlines))))))
+
+(defun all-insert (start end regexp nlines)
+ ;; Insert match.
+ (let ((marker (copy-marker start))
+ (buffer (current-buffer)))
+ (with-current-buffer standard-output
+ (let ((from (point))
+ to)
+ (insert-buffer-substring buffer start end)
+ (setq to (point))
+ (overlay-put (make-overlay from to) 'all-marker marker)
+ (goto-char from)
+ (while (re-search-forward regexp to t)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'match))
+ (goto-char to)
+ (if (> nlines 0)
+ (insert "--------\n"))))))
+
+(provide 'all)
+
+;;; all.el ends here
--- /dev/null
+;;; metar.el --- Retrieve and decode METAR weather information
+
+;; Copyright (C) 2007, 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Mario Lang <mlang@delysid.org>
+;; Version: 0.2
+;; Package-Requires: ((cl-lib "0.5"))
+;; Keywords: comm
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Run `M-x metar RET' to get a simple weather report from weather.noaa.gov.
+;; The value of `calendar-latitude' and `calendar-longitude' will be used to
+;; automatically determine a nearby station. If these variables are not set,
+;; you will be prompted to enter the location manually.
+;;
+;; With `C-u M-x metar RET', country and station name need to be entered.
+;; `C-u C-u M-x metar RET' will prompt for the METAR station code (4 letters).
+;;
+;; Customize `metar-units' to change length, speed, temperature or pressure
+;; units to your liking.
+;;
+;; For programmatic access to decoded weather reports, use:
+;;
+;; (metar-decode (metar-get-record "CODE"))
+
+;;; Code:
+
+(require 'calc-units)
+(require 'cl-lib)
+(require 'format-spec)
+(require 'rx)
+(require 'solar)
+(require 'url)
+
+(defgroup metar ()
+ "METAR weather reports."
+ :group 'net-utils)
+
+(defcustom metar-units '((length . m)
+ (pressure . hPa)
+ (speed . kph)
+ (temperature . degC))
+ "Default measurement units to use when reporting weather information."
+ :group 'metar
+ :type '(list (cons :format "%v"
+ (const :tag "Length: " length)
+ (choice (const :tag "Meter" m)
+ (const :tag "Inch" in)
+ (const :tag "Foot" ft)
+ (const :tag "Yard" yd)
+ (const :tag "Mile" mi)))
+ (cons :format "%v"
+ (const :tag "Pressure:" pressure)
+ (choice (const :tag "Pascal" Pa)
+ (const :tag "Hecto pascal" hPa)
+ (const :tag "Bar" bar)
+ (const :tag "Inch of mercury" inHg)
+ (const :tag "Standard atmosphere" atm)
+ (const :tag "Meter of mercury" mHg)
+ (const :tag "Punds per square inch" psi)))
+ (cons :format "%v"
+ (const :tag "Speed:" speed)
+ (choice (const :tag "Kilometers per hour" kph)
+ (const :tag "Miles per hour" mph)
+ (const :tag "Knot" knot)))
+ (cons :format "%v"
+ (const :tag "Temperature:" temperature)
+ (choice (const :tag "Degree Celsius" degC)
+ (const :tag "Degree Kelvin" degK)
+ (const :tag "Degree Fahrenheit" degF)))))
+
+(defcustom metar-stations-info-url "http://weather.noaa.gov/data/nsd_bbsss.txt"
+ "URL to use for retrieving station meta information."
+ :group 'metar
+ :type 'string)
+
+(defvar metar-stations nil
+ "Variable containing (cached) METAR station information.
+Use the function `metar-stations' to get the actual station list.")
+
+(defun metar-station-convert-dms-to-deg (string)
+ "Convert degrees, minutes and optional seconds, to degrees."
+ (when (string-match (rx string-start
+ (group (1+ digit)) ?- (group (1+ digit))
+ (optional ?- (group (1+ digit)))
+ (group (char ?N ?E ?S ?W))
+ string-end) string)
+ (funcall (if (memq (aref (match-string 4 string) 0) '(?N ?E)) #'+ #'-)
+ (+ (string-to-number (match-string 1 string))
+ (/ (string-to-number (match-string 2 string)) 60.0)
+ (if (match-string 3 string)
+ (/ (string-to-number (match-string 3 string)) 3600.0)
+ 0)))))
+
+(defun metar-stations ()
+ "Retrieve a list of METAR stations.
+Results are cached in variable `metar-stations'.
+If this variable is nil, the information is retrieved from the Internet."
+ (or metar-stations
+ (let ((data (with-temp-buffer
+ (url-insert-file-contents metar-stations-info-url)
+ (mapcar (lambda (entry)
+ (split-string entry ";"))
+ (split-string (buffer-string) "\n")))))
+ (setq metar-stations nil)
+ (while data
+ (when (and (nth 7 (car data)) (nth 8 (car data))
+ (not (string= (nth 2 (car data)) "----")))
+ (setq metar-stations
+ (append
+ (let ((item (car data)))
+ (list
+ (list (cons 'code (nth 2 item))
+ (cons 'name (nth 3 item))
+ (cons 'country (nth 5 item))
+ (cons 'latitude
+ (metar-station-convert-dms-to-deg (nth 7 item)))
+ (cons 'longitude
+ (metar-station-convert-dms-to-deg (nth 8 item)))
+ (cons 'altitude (string-to-number (nth 12 item))))))
+ metar-stations)))
+ (setq data (cdr data)))
+ ;; (unless metar-timer
+ ;; (setq metar-timer
+ ;; (run-with-timer 600 nil (lambda () (setq metar-stations nil)))))
+ metar-stations)))
+
+(defun metar-stations-get (station-code key)
+ "Get meta information for station with STATION-CODE and KEY.
+KEY can be one of the symbols `code', `name', `country', `latitude',
+`longitude' or `altitude'."
+ (let ((stations (metar-stations)) result)
+ (while stations
+ (when (string= (cdr (assoc 'code (car stations))) station-code)
+ (setq result (cdr (assoc key (car stations)))
+ stations nil))
+ (setq stations (cdr stations)))
+ result))
+
+(defun metar-latitude-longitude-bearing (latitude1 longitude1
+ latitude2 longitude2)
+ "Calculate bearing from start point LATITUDE1/LONGITUDE1 to end point
+LATITUDE2/LONGITUDE2."
+ (% (+ 360
+ (truncate
+ (radians-to-degrees
+ (atan (* (sin (degrees-to-radians (- longitude2 longitude1)))
+ (cos (degrees-to-radians latitude2)))
+ (- (* (cos (degrees-to-radians latitude1))
+ (sin (degrees-to-radians latitude2)))
+ (* (sin (degrees-to-radians latitude1))
+ (cos (degrees-to-radians latitude2))
+ (cos (degrees-to-radians (- longitude2 longitude1)))))))))
+ 360))
+
+(defun metar-latitude-longitude-distance-haversine (latitude1 longitude1
+ latitude2 longitude2)
+ "Caluclate the distance (in kilometers) between two points on the
+surface of the earth given as LATITUDE1, LONGITUDE1, LATITUDE2 and LONGITUDE2."
+ (cl-macrolet ((distance (d1 d2)
+ `(expt (sin (/ (degrees-to-radians (- ,d2 ,d1)) 2)) 2)))
+ (let ((a (+ (distance latitude1 latitude2)
+ (* (cos (degrees-to-radians latitude1))
+ (cos (degrees-to-radians latitude2))
+ (distance longitude1 longitude2)))))
+ (* 6371 (* 2 (atan (sqrt a) (sqrt (- 1 a))))))))
+
+(defun metar-find-station-by-latitude/longitude (latitude longitude &optional
+ radius)
+ "Find a station near the coordinates given by LATITUDE and LONGITUDE.
+Returns a cons where car is the station code and cdr is the distance in
+kilometers.
+If RADIUS is non-nil, only stations within this range (in kilometers) are
+considered.
+If no match if found, nil is returned."
+ (interactive
+ (list
+ (solar-get-number "Enter latitude (decimal fraction; + north, - south): ")
+ (solar-get-number "Enter longitude (decimal fraction; + east, - west): ")))
+ (let ((stations (metar-stations))
+ (best-distance (or radius 10000))
+ (station-code nil))
+ (while stations
+ (let ((station-latitude (cdr (assoc 'latitude (car stations))))
+ (station-longitude (cdr (assoc 'longitude (car stations)))))
+ (when (and station-latitude station-longitude)
+ (let ((distance (metar-latitude-longitude-distance-haversine
+ latitude longitude
+ station-latitude station-longitude)))
+ (when (< distance best-distance)
+ (setq best-distance distance
+ station-code (cdr (assoc 'code (car stations))))))))
+ (setq stations (cdr stations)))
+ (if (called-interactively-p 'interactive)
+ (if station-code
+ (message "%s, %s (%s) at %s is %d km away from %s."
+ (metar-stations-get station-code 'name)
+ (metar-stations-get station-code 'country)
+ station-code
+ (let ((float-output-format "%.1f"))
+ (format "%s%s, %s%s"
+ (abs (metar-stations-get station-code 'latitude))
+ (if (> (metar-stations-get station-code 'latitude) 0) "N" "S")
+ (abs (metar-stations-get station-code 'longitude))
+ (if (> (metar-stations-get station-code 'longitude) 0) "E" "W")))
+ best-distance
+ (let ((float-output-format "%.1f"))
+ (format "%s%s, %s%s"
+ (if (numberp latitude)
+ (abs latitude)
+ (+ (aref latitude 0)
+ (/ (aref latitude 1) 60.0)))
+ (if (numberp latitude)
+ (if (> latitude 0) "N" "S")
+ (if (equal (aref latitude 2) 'north) "N" "S"))
+ (if (numberp longitude)
+ (abs longitude)
+ (+ (aref longitude 0)
+ (/ (aref longitude 1) 60.0)))
+ (if (numberp longitude)
+ (if (> longitude 0) "E" "W")
+ (if (equal (aref longitude 2) 'east)
+ "E" "W")))))
+ (message "No appropriate station found."))
+ (when station-code
+ (cons station-code (round best-distance))))))
+
+(defun metar-convert-unit (value new-unit &optional convert-units-function)
+ "Convert VALUE to NEW-UNIT.
+VALUE is a string with the value followed by the unit, like \"5 knot\"
+and NEW-UNIT should be a unit name like \"kph\" or similar.
+CONVERT-UNITS-FUNCTION designates the function actually doing the conversion.
+It must have the signature of `math-convert-units', which is the default."
+ (cl-check-type value string)
+ (unless (symbolp new-unit)
+ (setq new-unit (intern new-unit)))
+ (let ((expr (math-simplify (math-read-expr value))))
+ ;; Sneakily work around bug#19582.
+ (when (eq (car-safe expr) 'neg)
+ (setq expr `(* -1 ,(cadr expr))))
+ (cl-assert (or (math-zerop expr)
+ (not (memq (math-single-units-in-expr-p expr) '(nil wrong))))
+ nil
+ "Metar: Not exactly one unit in expression: %S" expr)
+ (let ((res (math-simplify-units
+ (funcall (or convert-units-function 'math-convert-units)
+ expr
+ (math-build-var-name new-unit)
+ t))))
+ (cl-assert (math-realp res) nil
+ "Metar: Not a Calc real number: %S" res)
+ (cons (string-to-number (math-format-value (if (integerp res)
+ res
+ (math-float res))))
+ new-unit))))
+
+(defun metar-convert-temperature (string &optional unit)
+ (metar-convert-unit (concat (if (= (aref string 0) ?M)
+ (concat "-" (substring string 1))
+ string)
+ "degC")
+ (or unit (cdr (assq 'temperature metar-units)))
+ (lambda (expr new-unit-var pure)
+ (math-convert-temperature expr
+ (math-build-var-name 'degC)
+ new-unit-var
+ pure))))
+
+(defcustom metar-url
+ "http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT"
+ "URL used to fetch station specific information.
+%s is replaced with the 4 letter station code."
+ :group 'metar
+ :type 'string)
+
+(defun metar-url (station)
+ (format metar-url
+ (upcase (cl-etypecase station
+ (string station)
+ (symbol (symbol-name station))))))
+
+(defconst metar-record-regexp
+ (rx (group (1+ digit)) ?/ (group (1+ digit)) ?/ (group (1+ digit))
+ space
+ (group (1+ digit)) ?: (group (1+ digit))
+ ?\n
+ (group "%s" (* not-newline)))
+ "Regular expression used to extract METAR information from `metar-url'.
+%s is replaced with the station code which always has to be present in a METAR
+record.")
+
+(defun metar-get-record (station)
+ "Retrieve a METAR/SPECI record for STATION from the Internet.
+Return a cons where `car' is the time of the measurement (as an emacs-lsip
+time value) and `cdr' is a string containing the actual METAR code.
+If no record was found for STATION, nil is returned."
+ (with-temp-buffer
+ (url-insert-file-contents (metar-url station))
+ (when (re-search-forward (format metar-record-regexp station) nil t)
+ (cons (encode-time
+ 0
+ (string-to-number (match-string 5))
+ (string-to-number (match-string 4))
+ (string-to-number (match-string 3))
+ (string-to-number (match-string 2))
+ (string-to-number (match-string 1))
+ 0)
+ (match-string 6)))))
+
+(defconst metar-could-regexp
+ (rx symbol-start
+ (group (or "FEW" "SCT" "BKN" "OVC"))
+ (group (= 3 digit))
+ (optional (group (or "TCU" "CB")))
+ symbol-end)
+ "Regular expression to match cloud information in METAR records.")
+
+(defun metar-clouds (info)
+ (let ((clouds ())
+ (from 0))
+ (while (string-match metar-could-regexp info from)
+ (setq from (match-end 0)
+ clouds (push (append (list (match-string 1 info)
+ (metar-convert-unit
+ (concat (match-string 2 info) " ft")
+ (cdr (assq 'length metar-units))))
+ (when (match-string 3 info)
+ (list (match-string 3 info))))
+ clouds)))
+ clouds))
+
+(defconst metar-phenomena '(("BC" . "patches")
+ ("BL" . "blowing")
+ ("BR" . "mist")
+ ("DR" . "drifting")
+ ("DS" . "dust storm")
+ ("DU" . "widespread dust")
+ ("DZ" . "drizzle")
+ ("FC" . "funnel cloud")
+ ("FG" . "fog")
+ ("FU" . "smoke")
+ ("FZ" . "freezing")
+ ("GR" . "hail")
+ ("GS" . "small hail/snow pellets")
+ ("HZ" . "haze")
+ ("IC" . "ice crystals")
+ ("MI" . "shallow")
+ ("PL" . "ice pellets")
+ ("PO" . "well developed dust/sand swirls")
+ ("PR" . "partials")
+ ("PY" . "spray")
+ ("RA" . "rain")
+ ("SA" . "sand")
+ ("SG" . "snow grains")
+ ("SH" . "showers")
+ ("SN" . "snow")
+ ("SQ" . "squall")
+ ("SS" . "sand storm")
+ ("TS" . "thunderstorm")
+ ("VA" . "volcanic ash")
+ ("VC" . "vicinity"))
+ "Alist of codes and descriptions for METAR weather phenomenoa.")
+
+(defconst metar-phenomena-regexp
+ (eval `(rx symbol-start
+ (group (optional (char ?+ ?-)))
+ (group (1+ (or ,@(mapcar #'car metar-phenomena))))
+ symbol-end))
+ "Regular expression to match weather phenomena in METAR records.")
+
+(defun metar-phenomena (info)
+ (when (string-match metar-phenomena-regexp info)
+ (let ((words ()))
+ (when (string= (match-string 1 info) "-")
+ (push "light" words))
+ (let ((obs (match-string 2 info)))
+ (while (> (length obs) 0)
+ (setq words (nconc words
+ (list (cdr (assoc-string (substring obs 0 2)
+ metar-phenomena))))
+ obs (substring obs 2))))
+ (mapconcat #'identity words " "))))
+
+(defconst metar-wind-regexp
+ (rx symbol-start
+ (group (or "VRB" (= 3 digit)))
+ (group (repeat 2 3 digit)) (optional (char ?G) (group (1+ digit)))
+ "KT"
+ symbol-end
+ (optional (one-or-more not-newline)
+ symbol-start
+ (group (= 3 digit)) (char ?V) (group (= 3 digit))
+ symbol-end))
+ "Regular expression to match wind information in METAR records.")
+
+(defsubst metar-degrees (value)
+ (cons value 'degrees))
+
+(defun metar-wind (info)
+ (when (string-match metar-wind-regexp info)
+ (append
+ (if (string= (match-string 1 info) "VRB")
+ (when (and (match-string 4 info) (match-string 5 info))
+ (list :from (string-to-number (match-string 4 info))
+ :to (string-to-number (match-string 5 info))))
+ (append
+ (list :direction (metar-degrees
+ (string-to-number (match-string 1 info))))
+ (when (and (match-string 4 info) (match-string 5 info))
+ (list :from (metar-degrees (string-to-number (match-string 4 info)))
+ :to (metar-degrees (string-to-number (match-string 5 info)))))))
+ (list :speed (metar-convert-unit (concat (match-string 2 info) "knot")
+ (cdr (assq 'speed metar-units))))
+ (when (match-string 3 info)
+ (list :gust (metar-convert-unit (concat (match-string 3 info) "knot")
+ (cdr (assq 'speed metar-units))))))))
+
+(defconst metar-visibility-regexp
+ (rx symbol-start (group (1+ digit)) (optional (group "SM")) symbol-end)
+ "Regular expression to match information about visibility in METAR records.")
+
+(defconst metar-temperature-and-dewpoint-regexp
+ (rx symbol-start
+ (group (group (optional (char ?M))) (1+ digit))
+ (char ?/)
+ (group (group (optional (char ?M))) (1+ digit))
+ symbol-end)
+ "Regular expression to match temperature and dewpoint information in METAR
+records.")
+
+(defun metar-temperature (info)
+ (when (string-match metar-temperature-and-dewpoint-regexp info)
+ (metar-convert-temperature (match-string 1 info))))
+
+(defun metar-dewpoint (info)
+ (when (string-match metar-temperature-and-dewpoint-regexp info)
+ (metar-convert-temperature (match-string 3 info))))
+
+(defun metar-humidity (info)
+ (when (string-match metar-temperature-and-dewpoint-regexp info)
+ (cons (round
+ (metar-magnus-formula-humidity-from-dewpoint
+ (save-match-data (car (metar-convert-temperature
+ (match-string 1 info) 'degC)))
+ (car (metar-convert-temperature (match-string 3 info) 'degC))))
+ 'percent)))
+
+(defconst metar-pressure-regexp
+ (rx symbol-start (group (char ?Q ?A)) (group (1+ digit)) symbol-end)
+ "Regular expression to match air pressure information in METAR records.")
+
+(defun metar-pressure (info)
+ (when (string-match metar-pressure-regexp info)
+ (metar-convert-unit
+ (concat (match-string 2 info)
+ (cond
+ ((string= (match-string 1 info) "Q") "hPa")
+ ((string= (match-string 1 info) "A") "cinHg")))
+ (cdr (assq 'pressure metar-units)))))
+
+(defun metar-decode (record)
+ "Return a lisp structure describing the weather information in RECORD."
+ (when record
+ (let* ((codes (cdr record))
+ (temperature (metar-temperature codes))
+ (dewpoint (metar-dewpoint codes))
+ (humidity (metar-humidity codes))
+ (pressure (metar-pressure codes))
+ (wind (metar-wind codes)))
+ (append
+ (list (cons 'station (car (split-string codes " ")))
+ (cons 'timestamp (car record))
+ (cons 'wind wind)
+ (cons 'temperature temperature)
+ (cons 'dewpoint dewpoint)
+ (cons 'humidity humidity)
+ (cons 'pressure pressure))
+ (when (metar-phenomena codes)
+ (list (cons 'phenomena (metar-phenomena codes))))))))
+
+(defun metar-magnus-formula-humidity-from-dewpoint (temperature dewpoint)
+ "Calculate relative humidity (in %) from TEMPERATURE and DEWPOINT (in
+degrees celsius)."
+ (* 10000
+ (expt 10
+ (- (/ (- (* 0.4343
+ (+ 243.12 temperature)
+ (/ (* dewpoint 17.62)
+ (+ 243.12 dewpoint)))
+ (* 0.4343 17.62 temperature))
+ (+ 243.12 temperature))
+ 2))))
+
+;;;###autoload
+(defun metar (&optional arg)
+ "Display recent weather information.
+If a prefix argument is given, prompt for country and station name.
+If two prefix arguments are given, prompt for exact station code.
+Otherwise, determine the best station via latitude/longitude."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (let (station)
+ (cond
+ ((= arg 1)
+ (unless calendar-longitude
+ (setq calendar-longitude
+ (solar-get-number
+ "Enter longitude (decimal fraction; + east, - west): ")))
+ (unless calendar-latitude
+ (setq calendar-latitude
+ (solar-get-number
+ "Enter latitude (decimal fraction; + north, - south): ")))
+ (when (and calendar-latitude calendar-longitude
+ (setq station (metar-find-station-by-latitude/longitude
+ (calendar-latitude) (calendar-longitude))))
+ (message "Found %s %d kilometers away." (car station) (cdr station))
+ (setq station (car station))))
+ ((= arg 4)
+ (let* ((country (completing-read "Country: " (metar-station-countries) nil t))
+ (name (completing-read "Station name: " (mapcar (lambda (s) (cdr (assq 'name s)))
+ (metar-stations-in-country country))
+ nil t)))
+ (setq station (cdr (assq 'code (cl-find-if (lambda (s)
+ (and (string= name (cdr (assq 'name s)))
+ (string= country (cdr (assq 'country s)))))
+ (metar-stations)))))))
+ ((= arg 16)
+ (setq station (completing-read "Enter METAR station code: "
+ (mapcar (lambda (station-info)
+ (cdr (assq 'code station-info)))
+ (metar-stations))
+ nil t))))
+ (let ((info (metar-decode (metar-get-record station))))
+ (if info
+ (message "%d minutes ago at %s: %d°%c, %s%d%% humidity, %.1f %S."
+ (/ (truncate (float-time (time-since
+ (cdr (assoc 'timestamp info)))))
+ 60)
+ (or (metar-stations-get (cdr (assoc 'station info)) 'name)
+ (cdr (assoc 'station info)))
+ (cadr (assoc 'temperature info))
+ (cond
+ ((eq (cdr (assq 'temperature metar-units)) 'degC) ?C)
+ ((eq (cdr (assq 'temperature metar-units)) 'degF) ?F))
+ (if (assoc 'phenomena info)
+ (concat (cdr (assoc 'phenomena info)) ", ")
+ "")
+ (cadr (assoc 'humidity info))
+ (cadr (assoc 'pressure info)) (cddr (assoc 'pressure info)))
+ (message "No weather information found, sorry.")))))
+
+(defun metar-station-countries ()
+ (let (countries)
+ (dolist (station (metar-stations))
+ (let ((country (cdr (assq 'country station))))
+ (cl-pushnew country countries :test #'equal)))
+ countries))
+
+(defun metar-stations-in-country (country)
+ (cl-loop for station-info in (metar-stations)
+ when (string= country (cdr (assq 'country station-info)))
+ collect station-info))
+
+(defun metar-average-temperature (country)
+ "Display average temperature from all stations in COUNTRY."
+ (interactive
+ (list (completing-read "Country: " (metar-station-countries) nil t)))
+ (let ((count 0) (temp-sum 0)
+ (stations (metar-stations))
+ (url-show-status nil)
+ (progress (make-progress-reporter
+ "Downloading METAR records..."
+ 0
+ (cl-count-if (lambda (station)
+ (string= (cdr (assoc 'country station))
+ country))
+ (metar-stations)))))
+ (while stations
+ (when (string= (cdr (assoc 'country (car stations))) country)
+ (let ((temp (cdr (assoc 'temperature
+ (metar-decode
+ (metar-get-record
+ (cdr (assoc 'code (car stations)))))))))
+ (when temp
+ (setq temp-sum (+ temp-sum temp)
+ count (+ count 1))
+ (progress-reporter-update progress count))))
+ (setq stations (cdr stations)))
+ (progress-reporter-done progress)
+ (if (called-interactively-p 'interactive)
+ (message "Average temperature in %s is %s"
+ country
+ (if (> count 0)
+ (format "%.1f°C (%d stations)"
+ (/ (float temp-sum) count)
+ count)
+ "unknown"))
+ (when (> count 0)
+ (/ (float temp-sum) count)))))
+
+(defun metar-format (format report)
+ (format-spec
+ format
+ (list (cons ?d
+ (let ((dewpoint (cdr (assq 'dewpoint report))))
+ (format "%.1f°%c"
+ (car dewpoint)
+ (cond ((eq (cdr dewpoint) 'degC) ?C)
+ ((eq (cdr dewpoint) 'degF) ?F)
+ ((eq (cdr dewpoint) 'degK) ?K)))))
+ (cons ?h
+ (let ((humidity (cdr (assq 'humidity report))))
+ (format "%d%%" (car humidity))))
+ (cons ?p
+ (let ((pressure (cdr (assq 'pressure report))))
+ (format "%.1f %S" (car pressure) (cdr pressure))))
+ (cons ?s (cdr (assq 'station report)))
+ (cons ?t
+ (let ((temperature (cdr (assq 'temperature report))))
+ (format "%.1f°%c"
+ (car temperature)
+ (cond ((eq (cdr temperature) 'degC) ?C)
+ ((eq (cdr temperature) 'degF) ?F))))))))
+
+(provide 'metar)
+;;; metar.el ends here
projects / emacs.git / commitdiff