emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] feature/integrated-elpa c1c7c63 01/23: Initial Support for


From: Phillip Lord
Subject: [Emacs-diffs] feature/integrated-elpa c1c7c63 01/23: Initial Support for ELPA packages in core
Date: Fri, 16 Sep 2016 20:34:15 +0000 (UTC)

branch: feature/integrated-elpa
commit c1c7c634edc64d48d39c4867aeb6f12bb8a4c57f
Author: Phillip Lord <address@hidden>
Commit: Phillip Lord <address@hidden>

    Initial Support for ELPA packages in core
    
    Previously, Emacs packages in core were stored only in their own
    directory structure. Here, we add support for packages following
    conventions for ELPA to be added to the packages directory. These are
    compiled, and loaded directly using package.el during start up.
---
 Makefile.in                |    4 +-
 lisp/emacs-lisp/package.el |    5 +-
 packages/all/all.el        |  203 ++++++++++++++
 packages/metar/metar.el    |  640 ++++++++++++++++++++++++++++++++++++++++++++
 packages/package-build.el  |  134 ++++++++++
 5 files changed, 983 insertions(+), 3 deletions(-)

diff --git a/Makefile.in b/Makefile.in
index 7aac403..3381387 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -290,7 +290,7 @@ EMACS = ${EMACS_NAME}${EXEEXT}
 EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT}
 
 # Subdirectories to make recursively.
-SUBDIR = $(NTDIR) lib lib-src src lisp
+SUBDIR = $(NTDIR) lib lib-src src lisp packages
 
 # The subdir makefiles created by config.status.
 SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
@@ -381,7 +381,7 @@ src: lib-src
 lisp: src
 
 # These targets should be "${SUBDIR} without 'src'".
-lib lib-src lisp nt: Makefile
+lib lib-src lisp nt packages: Makefile
        $(MAKE) -C $@ all
 
 # Ideally, VCSWITNESS should be a file that is modified whenever the
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 540a0e9..baaa5e2 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -292,7 +292,10 @@ packages in `package-directory-list'."
       (and (stringp f)
            (equal (file-name-nondirectory f) "site-lisp")
            (push (expand-file-name "elpa" f) result)))
-    (nreverse result))
+    (cons
+     ;; And the inbuild ELPA directory
+     (concat (expand-file-name "../packages" data-directory))
+     (nreverse result)))
   "List of additional directories containing Emacs Lisp packages.
 Each directory name should be absolute.
 
diff --git a/packages/all/all.el b/packages/all/all.el
new file mode 100644
index 0000000..845b85a
--- /dev/null
+++ b/packages/all/all.el
@@ -0,0 +1,203 @@
+;;; all.el --- Edit all lines matching a given regexp
+
+;; Copyright (C) 1985-1987,1992,1994,2011-2012 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <address@hidden>
+;; Version: 1.0
+;; Keywords: matching
+
+;; LCD Archive Entry:
+;; all|Per Abrahamsen|address@hidden|
+;; 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
diff --git a/packages/metar/metar.el b/packages/metar/metar.el
new file mode 100644
index 0000000..b6989ea
--- /dev/null
+++ b/packages/metar/metar.el
@@ -0,0 +1,640 @@
+;;; metar.el --- Retrieve and decode METAR weather information
+
+;; Copyright (C) 2007, 2014-2016  Free Software Foundation, Inc.
+
+;; Author: Mario Lang <address@hidden>
+;; 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
diff --git a/packages/package-build.el b/packages/package-build.el
new file mode 100644
index 0000000..57987b9
--- /dev/null
+++ b/packages/package-build.el
@@ -0,0 +1,134 @@
+(require 'package)
+(require 'lisp-mnt)
+
+;; these functions are stolen from ELPA
+(defun archive--metadata (dir pkg)
+  "Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS),
+where SIMPLE is non-nil if the package is simple;
+VERSION is the version string of the simple package;
+DESCRIPTION is the brief description of the package;
+REQ is a list of requirements;
+EXTRAS is an alist with additional metadata.
+
+PKG is the name of the package and DIR is the directory where it is."
+  (let* ((mainfile (expand-file-name (concat pkg ".el") dir))
+         (files (directory-files dir nil "\\`dir\\'\\|\\.el\\'")))
+    (setq files (delete (concat pkg "-pkg.el") files))
+    (setq files (delete (concat pkg "-autoloads.el") files))
+    (cond
+     ((file-exists-p mainfile)
+      (with-temp-buffer
+       (insert-file-contents mainfile)
+       (goto-char (point-min))
+       (if (not (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ 
\t]*\\)?$"))
+            (error "Can't parse first line of %s" mainfile)
+          ;; Grab the other fields, which are not mandatory.
+          (let* ((description (match-string 1))
+                 (version
+                  (or (lm-header "package-version")
+                      (lm-header "version")
+                      (unless (equal pkg "org")
+                        (error "Missing `version' header"))))
+                 (_ (archive--version-to-list version)) ; Sanity check!
+                 (requires-str (lm-header "package-requires"))
+                 (pt (lm-header "package-type"))
+                 (simple (if pt (equal pt "simple") (= (length files) 1)))
+                 (keywords (lm-keywords-list))
+                 (url (or (lm-header "url")
+                          (format archive-default-url-format pkg)))
+                 (req
+                  (if requires-str
+                      (mapcar 'archive--convert-require
+                              (car (read-from-string requires-str))))))
+            (list simple version description req
+                  ;; extra parameters
+                  (list (cons :url url)
+                        (cons :keywords keywords)))))))
+     (t
+      (error "Can't find main file %s file in %s" mainfile dir)))))
+
+;; PWL: this is changed to give a clean entry point
+(defun archive--refresh-pkg-file (directory)
+  (let* ((dir directory)
+         (pkg (file-name-nondirectory dir)))
+    (apply #'archive--write-pkg-file dir pkg
+           (cdr (archive--metadata dir pkg)))))
+
+
+(defun archive--write-pkg-file (pkg-dir name version desc requires extras)
+  (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
+       (print-level nil)
+        (print-quoted t)
+       (print-length nil))
+    (write-region
+     (concat (format ";; Generated package description from %s.el\n"
+                    name)
+            (prin1-to-string
+              (nconc
+               (list 'define-package
+                     name
+                     version
+                     desc
+                     (list 'quote
+                           ;; Turn version lists into string form.
+                           (mapcar
+                            (lambda (elt)
+                              (list (car elt)
+                                    (package-version-join (cadr elt))))
+                            requires)))
+               (archive--alist-to-plist-args extras)))
+            "\n")
+     nil
+     pkg-file)))
+
+(defun archive--version-to-list (vers)
+  (when vers
+    (let ((l (version-to-list vers)))
+      ;; Signal an error for things like "1.02" which is parsed as "1.2".
+      (cl-assert (equal vers (package-version-join l)) nil
+                 "Unsupported version syntax %S" vers)
+      l)))
+
+(defconst archive-default-url-format "http://elpa.gnu.org/packages/%s.html";)
+(defun archive--alist-to-plist-args (alist)
+  (mapcar (lambda (x)
+            (if (and (not (consp x))
+                     (or (keywordp x)
+                         (not (symbolp x))
+                         (memq x '(nil t))))
+                x `',x))
+          (apply #'nconc
+                 (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
+
+(defun archive--convert-require (elt)
+  (list (car elt)
+       (archive--version-to-list (car (cdr elt)))))
+
+
+(defun package-build-dir (pkg)
+  (concat default-directory pkg))
+
+;; So this one does the business during build
+(defun package-build-prepare (dir)
+  (let ((descr
+           (package-desc-create :name (make-symbol dir)))
+          (location (package-build-dir dir)))
+      (archive--refresh-pkg-file location)
+      (setq descr (package-load-descriptor location))
+      (package-generate-autoloads (package-desc-name descr) location)
+      (package-activate descr)
+      (package--compile descr)))
+
+
+;; and this one does the business during the load
+(defun test-load (dir)
+  (setq descr
+        (package-load-descriptor
+         (test-dir dir)))
+  (package--load-files-for-activation descr nil))
+
+;; (test-prepare "all")
+;; (test-load "all")
+
+;; (test-prepare "metar")
+;; (test-load "metar")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]