diff --git a/CHANGELOG b/CHANGELOG
index 9caef53dd7d76eb0f6a4dbb89280cc83789fae96..29d7fe7bab13a4e613337859e4a1971031abab7f 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,5 +1,9 @@
2020-07-21 David Byers <david.byers@liu.se>
+ Clean up
+ * olc.el: Declare external functions for the byte compiler. Fix
+ whitespace. Shortened lines. Fixed some docstrings.
+
More integer math:
(olc-decode): Converted to use integer math.
diff --git a/olc.el b/olc.el
index 1b7273bf131167d47e0a4aced735289bd8e1526b..e5c8849fdfd3b0f3814da3655592729b75fee557 100644
--- a/olc.el
+++ b/olc.el
@@ -1,24 +1,31 @@
-;;;; -*-coding: utf-8;-*-
-;;;;
-;;;; Copyright (C) 2020 David Byers
-;;;;
-;;;; 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
-;;;; <https://www.gnu.org/licenses/>.
-
-;;; ========================================================================
-;;; This program provides basic open location code support in emacs
-;;; lisp. The support for recovering shortened codes depends on the
+;;; olc.el --- Open location code library
+;;;
+;;; Copyright (C) 2020 David Byers
+;;;
+;;; Author: David Byers <david.byers@liu.se>
+;;; Version: 1.0
+;;; Package-Requires: ((emacs "25.1"))
+;;; Keywords: comm, extensions, tools
+;;; URL: https://gitlab.liu.se/davby02/olc
+;;;
+;;; 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
+;;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; This program provides basic open location code support in Emacs
+;;; Lisp. The support for recovering shortened codes depends on the
;;; request library and uses OpenStreetMap; please check the terms of
;;; use for the service to ensure that you remain compliant.
;;;
@@ -26,8 +33,8 @@
;;; provided in some form. The implementation passed the tests present
;;; in the open location code github repository at the time of writing
;;; almost cleanly -- there are some minor rounding issues in decode.
-;;; ========================================================================
+;;; Code:
;; This is me being dragged kicking and screaming into the 21st
;; century because the alternative is to cl-lib is to include my own
@@ -38,43 +45,59 @@
(require 'request nil t)
-;; ========================================================================
-;; Errors raised by this package
-;; ========================================================================
+;;; ==================================================================
+;;; Silence the compiler if request is not on load-path at compile
+;;; time
+;;; ==================================================================
+
+(declare-function request "request")
+(declare-function request-response-status-code "request")
+(declare-function request-response-data "request")
+
+
+;;; ==================================================================
+;;; Errors raised by this package
+;;; ==================================================================
(define-error 'olc-error "Error in open location code.")
-(define-error 'olc-parse-error "Parse error in open location code" 'olc-error)
-(define-error 'olc-decode-error "Error decoding open location code" 'olc-error)
-(define-error 'olc-encode-error "Error encoding open location code" 'olc-error)
-(define-error 'olc-shorten-error "Error shortening open location code" 'olc-error)
+(define-error 'olc-parse-error
+ "Parse error in open location code" 'olc-error)
+(define-error 'olc-decode-error
+ "Error decoding open location code" 'olc-error)
+(define-error 'olc-encode-error
+ "Error encoding open location code" 'olc-error)
+(define-error 'olc-shorten-error
+ "Error shortening open location code" 'olc-error)
+
-;; ========================================================================
-;; Mapping of digits to base 20 values
-;; ========================================================================
+;;; ==================================================================
+;;; Mapping of digits to base 20 values
+;;; ==================================================================
(defvar olc-value-mapping "23456789CFGHJMPQRVWX"
"Mapping from values to olc base 20 digits.")
-(defvar olc-digit-mapping (let ((count 0))
- (mapcan (lambda (letter)
- (prog1 (list (cons letter count)
- (cons (downcase letter) count))
- (setq count (1+ count))))
- olc-value-mapping))
+(defvar olc-digit-mapping
+ (let ((count 0))
+ (mapcan (lambda (letter)
+ (prog1 (list (cons letter count)
+ (cons (downcase letter) count))
+ (setq count (1+ count))))
+ olc-value-mapping))
"Mapping from olc base 20 digits to values.")
(defsubst olc-digit-value (digit)
- "Return the base 20 value of a digit."
+ "Return the base 20 value of DIGIT."
(cdr (assq digit olc-digit-mapping)))
(defsubst olc-value-digit (value)
- "Return the digit for a value up to 19."
+ "Return the digit for a VALUE up to 19."
(elt olc-value-mapping value))
-;; ========================================================================
-;; Data structures
-;; ========================================================================
+;;; ==================================================================
+;;; Data structures
+;;; ==================================================================
(cl-defstruct (olc-parse (:copier nil)
(:constructor olc-parse-create))
@@ -92,34 +115,43 @@
(defsubst olc-area-lat (area)
"Get center latitute of AREA."
- (min (+ (/ (- (olc-area-lathi area) (olc-area-latlo area)) 2) (olc-area-latlo area)) 90))
+ (min (+ (/ (- (olc-area-lathi area) (olc-area-latlo area)) 2)
+ (olc-area-latlo area))
+ 90))
(defsubst olc-area-lon (area)
"Get center longitude of AREA."
- (min (+ (/ (- (olc-area-lonhi area) (olc-area-lonlo area)) 2) (olc-area-lonlo area)) 180))
+ (min (+ (/ (- (olc-area-lonhi area) (olc-area-lonlo area)) 2)
+ (olc-area-lonlo area))
+ 180))
-;; ========================================================================
-;; (Mostly) internal functions
-;; ========================================================================
+;;; ==================================================================
+;;; (Mostly) internal functions
+;;; ==================================================================
(defmacro olc-valid-char (char)
"Check if CHAR is a valid OLC digit."
`(assq ,char olc-digit-mapping))
(defmacro olc-transform-error (spec &rest body)
- "Catch some errors and throw others."
+ "Catch some errors and throw others.
+
+SPEC is a list consisting of an error to catch, the error to
+raise, and args for the raised error.
+
+\(fn (CATCH SIGNAL &rest ARGS) BODY...)"
(declare (indent 1))
`(condition-case nil
,@body
(,(elt spec 0) (signal ',(elt spec 1) (list ,@(cddr spec))))))
(defsubst olc-clip-latitude (lat)
- "Clip LAT to -90,90"
+ "Clip LAT to -90,90."
(max -90 (min 90 lat)))
(defsubst olc-normalize-latitude (lat len)
- "Normalize latitude LAT."
+ "Normalize latitude LAT for a LEN character log code."
(setq lat (olc-clip-latitude lat))
(when (= lat 90.0)
(setq lat (- lat (/ (olc-latitude-precision len) 2.0))))
@@ -143,69 +175,87 @@
(if (olc-parse-p code)
code
(let ((pos 0)
- (pairs nil)
- (short nil)
+ (pairs nil)
+ (short nil)
(precision nil)
- (grid nil)
- (padding 0))
+ (grid nil)
+ (padding 0))
;; Parse up to four initial pairs
(catch 'break
- (while (< pos (length code))
- (olc-transform-error (args-out-of-range olc-parse-error "code too short" code (1+ pos))
+ (while (< pos (length code))
+ (olc-transform-error
+ (args-out-of-range olc-parse-error
+ "code too short" code (1+ pos))
(cond ((eq (elt code pos) ?+) (throw 'break nil))
- ((eq (elt code pos) ?0) (throw 'break nil))
- ((= (length pairs) 4) (throw 'break nil))
- ((not (olc-valid-char (elt code pos)))
- (signal 'olc-parse-error (list "invalid character" pos code)))
- ((not (olc-valid-char (elt code (1+ pos))))
- (signal 'olc-parse-error (list "invalid character" (1+ pos) code)))
- (t (setq pairs (cons (cons (elt code pos) (elt code (1+ pos))) pairs)))))
- (setq pos (+ pos 2))))
+ ((eq (elt code pos) ?0) (throw 'break nil))
+ ((= (length pairs) 4) (throw 'break nil))
+ ((not (olc-valid-char (elt code pos)))
+ (signal 'olc-parse-error
+ (list "invalid character" pos code)))
+ ((not (olc-valid-char (elt code (1+ pos))))
+ (signal 'olc-parse-error
+ (list "invalid character" (1+ pos) code)))
+ (t (setq pairs (cons (cons (elt code pos)
+ (elt code (1+ pos)))
+ pairs)))))
+ (setq pos (+ pos 2))))
;; Measure the padding
(when (string-match "0+" code pos)
- (setq pos (match-end 0) padding (- (match-end 0) (match-beginning 0))))
+ (setq pos (match-end 0)
+ padding (- (match-end 0) (match-beginning 0))))
;; Parse the separator
- (olc-transform-error (args-out-of-range olc-parse-error "code too short" code pos)
+ (olc-transform-error
+ (args-out-of-range olc-parse-error
+ "code too short" code pos)
(if (eq (elt code pos) ?+)
- (setq pos (1+ pos))
- (signal 'olc-parse-error (list "missing separator" pos code))))
+ (setq pos (1+ pos))
+ (signal 'olc-parse-error
+ (list "missing separator" pos code))))
;; Check the length of the padding
(unless (and (= (% padding 2) 0)
(<= (+ padding (* 2 (length pairs))) 8))
- (signal 'olc-parse-error (list "incorrect padding length" pos code)))
+ (signal 'olc-parse-error
+ (list "incorrect padding length" pos code)))
;; Determine if the code is shortened or not
(setq short (< (+ (* 2 (length pairs)) padding) 8))
;; We cant be short and have padding (not sure why)
(when (and short (> padding 0))
- (signal 'olc-parse-error (list "padded codes can't be shortened" pos code)))
+ (signal 'olc-parse-error
+ (list "padded codes can't be shortened" pos code)))
;; Determine the precision of the code
(setq precision (- 8 padding))
;; Parse what's after the separator
(when (< pos (length code))
- (when (> padding 0)
- (signal 'olc-parse-error (list "padding followed by data" pos code)))
-
- ;; Parse one more pair
- (olc-transform-error (args-out-of-range olc-parse-error "code too short" code (1+ pos))
- (setq pairs (cons (cons (elt code pos) (elt code (1+ pos))) pairs)
- pos (+ 2 pos)
+ (when (> padding 0)
+ (signal 'olc-parse-error
+ (list "padding followed by data" pos code)))
+
+ ;; Parse one more pair
+ (olc-transform-error
+ (args-out-of-range olc-parse-error
+ "code too short" code (1+ pos))
+ (setq pairs (cons (cons (elt code pos)
+ (elt code (1+ pos)))
+ pairs)
+ pos (+ 2 pos)
precision (+ 2 precision)))
- ;; Parse grid
- (while (< pos (length code))
- (cond ((not (olc-valid-char (elt code pos)))
- (signal 'olc-parse-error (list "invalid character" pos code)))
- ((>= (length grid) 5) (setq pos (1+ pos)))
- (t (setq grid (cons (elt code pos) grid)
- pos (1+ pos)
+ ;; Parse grid
+ (while (< pos (length code))
+ (cond ((not (olc-valid-char (elt code pos)))
+ (signal 'olc-parse-error
+ (list "invalid character" pos code)))
+ ((>= (length grid) 5) (setq pos (1+ pos)))
+ (t (setq grid (cons (elt code pos) grid)
+ pos (1+ pos)
precision (1+ precision))))))
;; Check for an empty code
@@ -219,9 +269,9 @@
:precision precision))))
-;;; ========================================================================
+;;; ==================================================================
;;; Public functions
-;;; ========================================================================
+;;; ==================================================================
(defun olc-is-valid (code)
"Return non-nil if CODE is a valid open location code."
@@ -278,11 +328,11 @@ differences, however, are extremely small."
;; Process the pairs
(mapc (lambda (pair)
- (setq lat (+ lat (* latsize (olc-digit-value (car pair))))
- lon (+ lon (* lonsize (olc-digit-value (cdr pair))))
- latsize (/ latsize 20)
+ (setq lat (+ lat (* latsize (olc-digit-value (car pair))))
+ lon (+ lon (* lonsize (olc-digit-value (cdr pair))))
+ latsize (/ latsize 20)
lonsize (/ lonsize 20)))
- (olc-parse-pairs parse))
+ (olc-parse-pairs parse))
;; I'm too tired to figure out why
(setq latsize (* latsize 20) lonsize (* lonsize 20))
@@ -290,11 +340,11 @@ differences, however, are extremely small."
;; Process the grid
(when (olc-parse-grid parse)
(mapc (lambda (refine)
- (setq latsize (/ latsize 5) lonsize (/ lonsize 4))
- (let ((coord (olc-digit-value refine)))
- (setq lat (+ lat (* latsize (/ coord 4)))
- lon (+ lon (* lonsize (% coord 4))))))
- (olc-parse-grid parse)))
+ (setq latsize (/ latsize 5) lonsize (/ lonsize 4))
+ (let ((coord (olc-digit-value refine)))
+ (setq lat (+ lat (* latsize (/ coord 4)))
+ lon (+ lon (* lonsize (% coord 4))))))
+ (olc-parse-grid parse)))
(olc-area-create :latlo (/ lat (float latscale))
:lonlo (/ lon (float lonscale))
@@ -329,7 +379,8 @@ values cannot (legally) be encoded to the selected length."
;; Calculate the grid part if needed
(if (> len 10)
(dotimes (i 5)
- (setq code (cons (olc-value-digit (+ (* (% lat 5) 4) (% lon 4)))
+ (setq code (cons (olc-value-digit
+ (+ (* (% lat 5) 4) (% lon 4)))
code)
lat (truncate lat 5)
lon (truncate lon 4)))
@@ -371,7 +422,10 @@ full open location code."
(length (olc-parse-grid parse))))
(resolution (expt 20 (- 2 (/ padlen 2))))
(half-resolution (/ resolution 2.0))
- (area (olc-decode (concat (substring (olc-encode lat lon 10) 0 padlen) code))))
+ (area (olc-decode
+ (concat (substring (olc-encode lat lon 10)
+ 0 padlen)
+ code))))
(cond ((and (< (+ lat half-resolution) (olc-area-lat area))
(>= (- (olc-area-lat area) resolution) -90))
(setq lat (- (olc-area-lat area) resolution)))
@@ -384,8 +438,9 @@ full open location code."
((> (- lon half-resolution) (olc-area-lon area))
(setq lon (+ (olc-area-lon area) resolution)))
(t (setq lon (olc-area-lon area))))
- (cond ((eq format 'latlon) (cons lat lon))
- (t (olc-encode lat lon (olc-parse-precision parse))))))))
+ (if (eq format 'latlon)
+ (cons lat lon)
+ (olc-encode lat lon (olc-parse-precision parse)))))))
(defun olc-shorten (code lat lon &optional limit)
@@ -401,11 +456,14 @@ shortened code, of if LIMIT is not positive and even."
(area (olc-decode parse)))
(when (null limit) (setq limit 12))
(unless (and (> limit 0) (= 0 (% limit 2)))
- (signal 'olc-shorten-error (list "limit must be even and positive" code)))
+ (signal 'olc-shorten-error
+ (list "limit must be even and positive" code)))
(when (olc-is-short parse)
- (signal 'olc-shorten-error (list "can't shorten shortened codes" code)))
+ (signal 'olc-shorten-error
+ (list "can't shorten shortened codes" code)))
(when (< (olc-parse-precision parse) 8)
- (signal 'olc-shorten-error (list "can't shorten padded codes" code)))
+ (signal 'olc-shorten-error
+ (list "can't shorten padded codes" code)))
(setq lat (olc-clip-latitude lat)
lon (olc-normalize-longitude lon))
@@ -415,42 +473,53 @@ shortened code, of if LIMIT is not positive and even."
(catch 'break
(dolist (spec '((4 . 0.0025) (3 . 0.05) (2 . 1) (1 . 20)))
(when (< coderange (* (cdr spec) 0.3))
- (throw 'break (substring code (min limit (* (car spec) 2))))))
+ (throw 'break (substring code
+ (min limit (* (car spec) 2))))))
code))))
-(defun olc-recover-string (string &optional reference format)
- "Recover a location from a shortened open location code and reference.
-When called with one argument, it must be a string consisting of a
-shortened open location code followed by whitespace and a geographical
-location.
+(defun olc-recover-string (arg1 &optional arg2 arg3)
+ "Recover a location from a short code and reference.
-When called with two strings, the first must be a shortened open
-location code and the second if the geographical location.
+When called with one argument, ARG1, it must be a string
+consisting of a shortened open location code followed by
+whitespace and a geographical location.
+
+When called with two strings, ARG1 and ARG2, the first must be a
+shortened open location code and the second if the geographical
+location.
-Optionally, the last argument in either case can be a symbol
-indicating the format of the return value (see `olc-recover' for
-details)."
+Optionally, the last argument (ARG2 or ARG3 depencing on the
+other arguments) in either case can be a symbol indicating the
+format of the return value (see `olc-recover' for details)."
(unless (fboundp 'request)
- (error "request library is not loaded"))
- (let (code resp)
- (cond ((and (stringp string) (not (stringp reference)))
- (setq format reference)
- (if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" string)
- (setq code (match-string 1 string)
- reference (match-string 2 string))
- (signal 'wrong-type-argument string)))
- ((and (stringp string) (stringp reference))
- (setq code string))
- (t (signal 'wrong-type-argument string)))
- (setq resp (request "https://nominatim.openstreetmap.org/search"
- :params `((q . ,reference)
- (format . "json")
- (limit . 1))
- :parser 'json-read
- :sync t))
- (when (eq 200 (request-response-status-code resp))
- (olc-recover code
- (string-to-number (alist-get 'lat (elt (request-response-data resp) 0)))
- (string-to-number (alist-get 'lon (elt (request-response-data resp) 0)))
- format))))
+ (error "`request' library is not loaded"))
+
+ (let (code reference format)
+ (cond ((and (stringp arg1) (not (stringp arg2)))
+ (if (string-match "^\\(\\S-+\\)\\s-+\\(.*\\)$" arg1)
+ (setq code (match-string 1 arg1)
+ reference (match-string 2 arg1)
+ format arg2)
+ (signal 'wrong-type-argument arg1)))
+ ((and (stringp arg1) (stringp arg2))
+ (setq code arg1 reference arg2 format arg3))
+ (t (signal 'wrong-type-argument arg1)))
+ (let ((resp (request "https://nominatim.openstreetmap.org/search"
+ :params `((q . ,reference)
+ (format . "json")
+ (limit . 1))
+ :parser 'json-read
+ :sync t)))
+ (when (eq 200 (request-response-status-code resp))
+ (let ((data (elt (request-response-data resp) 0)))
+ (olc-recover code
+ (string-to-number (alist-get 'lat data))
+ (string-to-number (alist-get 'lon data))
+ format))))))
+
+
+(provide 'olc)
+
+;;; -*-coding: utf-8;-*-
+;;; olc.el ends here
diff --git a/olc.texi b/olc.texi
index e8627d7b4d0eed83fe90a7d8056deaae923bc838..020652830dcca7457cdf08bbb7010e5835be9e83 100644
--- a/olc.texi
+++ b/olc.texi
@@ -140,10 +140,10 @@ is otherwise invalid (i.e. 3, 5, 7, or 9).
@defun olc-decode code
Decode @var{code} and return an @code{olc-area} representing the
-location. Raises @code{olc-parse-error} if the code can't be parsed,
-and @code{olc-decode-error} if it can't be decoded (e.g. a padded
-shortened code, a padded code with grid coordinates, an empty code,
-and so forth). Returns an olc-area structure.
+location. Returns an olc-area structure. Raises @code{olc-parse-error}
+if the code can't be parsed, and @code{olc-decode-error} if it can't
+be decoded (e.g. a padded shortened code, a padded code with grid
+coordinates, an empty code, and so forth).
@example
@group