[elpa] externals/osm c3215cf89f 1/3: Configurable pin colors

[ELPA Syncer]

branch: externals/osm
commit c3215cf89fb0f9f6af026b83e7f54b703f8d77fe
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Configurable pin colors
---
 osm.el | 58 ++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 34 insertions(+), 24 deletions(-)

diff --git a/osm.el b/osm.el
index e04bc29cbc..51d967c39b 100644
--- a/osm.el
+++ b/osm.el
@@ -94,6 +94,14 @@
   "List of tile servers."
   :type '(alist :key-type symbol :value-type plist))
 
+(defcustom osm-pin-colors
+  '((selected-bookmark . "#e20")
+    (bookmark . "#f80")
+    (center . "#f08")
+    (org-link . "#7a9"))
+  "Colors of pins."
+  :type '(alist :key-type symbol :value-type string))
+
 (defcustom osm-home
   (let ((lat (bound-and-true-p calendar-latitude))
         (lon (bound-and-true-p calendar-longitude)))
@@ -131,10 +139,12 @@ Should be at least 7 days according to the server usage 
policies."
 
 (defvar osm-mode-map
   (let ((map (make-sparse-keymap)))
-    (define-key map [osm-transient] #'ignore)
-    (define-key map [osm-bookmark mouse-1] #'osm-bookmark-select-click)
-    (define-key map [osm-bookmark mouse-2] #'osm-bookmark-select-click)
-    (define-key map [osm-bookmark mouse-3] #'osm-bookmark-select-click)
+    (define-key map [org-link] #'ignore)
+    (define-key map [center] #'ignore)
+    (define-key map [selected-bookmark] #'ignore)
+    (define-key map [bookmark mouse-1] #'osm-bookmark-select-click)
+    (define-key map [bookmark mouse-2] #'osm-bookmark-select-click)
+    (define-key map [bookmark mouse-3] #'osm-bookmark-select-click)
     (define-key map "+" #'osm-zoom-in)
     (define-key map "-" #'osm-zoom-out)
     (define-key map " " #'osm-zoom-in)
@@ -394,7 +404,7 @@ Should be at least 7 days according to the server usage 
policies."
     (when (< osm--zoom (osm--server-property :max-zoom))
       (cl-incf osm--x (- x osm--wx))
       (cl-incf osm--y (- y osm--wy))
-      (osm--put-transient-pin 'osm-transient osm--x osm--y "#ff0088" "Center")
+      (osm--put-transient-pin 'center osm--x osm--y "Center")
       (osm--update))))
 
 (defun osm-bookmark-set-click (event)
@@ -420,12 +430,11 @@ Should be at least 7 days according to the server usage 
policies."
                (q (osm--lat-to-y (car coord) osm--zoom))
                (d (+ (* (- p x) (- p x)) (* (- q y) (- q y)))))
           (when (and (>= q y) (< q (+ y 50)) (>= p (- x 20)) (< p (+ x 20)) (< 
d min))
-            (setq min d found `(,p ,q . ,(car bm)))))))
-    (message "Selected '%s'" (cddr found))
-    (osm--put-transient-pin 'osm-selected-bookmark
-                            (car found) (cadr found)
-                            "#FF0000" (cddr found))
-    (osm--update)))
+            (setq min d found (list p q (car bm)))))))
+    (when found
+      (message "Selected '%s'" (cddr found))
+      (apply #'osm--put-transient-pin 'selected-bookmark found)
+      (osm--update))))
 
 (defun osm-org-link-click (event)
   "Store link at position of click EVENT."
@@ -434,7 +443,7 @@ Should be at least 7 days according to the server usage 
policies."
                (osm--x (+ osm--x (- x osm--wx)))
                (osm--y (+ osm--y (- y osm--wy))))
     (call-interactively 'org-store-link)
-    (osm--put-transient-pin 'osm-transient osm--x osm--y "#7a9" "Org Link"))
+    (osm--put-transient-pin 'org-link osm--x osm--y "Org Link"))
   (osm--update))
 
 (defun osm-zoom-in (&optional n)
@@ -561,10 +570,10 @@ Should be at least 7 days according to the server usage 
policies."
   (and (>= p (- x 32)) (< p (+ x 256 32))
        (>= q y) (< q (+ y 256 64))))
 
-(defun osm--put-pin (id x y color help)
-  "Put pin at X/Y with COLOR, HELP and ID in pins hash table."
+(defun osm--put-pin (id x y help)
+  "Put pin at X/Y with HELP and ID in pins hash table."
   (let ((x0 (/ x 256)) (y0 (/ y 256)))
-    (push `(,(- x (* x0 256)) ,(- y (* y0 256)) ,id ,color . ,help)
+    (push `(,(- x (* x0 256)) ,(- y (* y0 256)) ,id . ,help)
           (gethash (cons x0 y0) osm--pins))
     (cl-loop
      for i from -1 to 1 do
@@ -573,7 +582,7 @@ Should be at least 7 days according to the server usage 
policies."
       (let ((x1 (/ (+ x (* 32 i)) 256))
             (y1 (/ (+ y (* 64 j)) 256)))
         (unless (and (= x0 x1) (= y0 y1))
-          (push `(,(- x (* x1 256)) ,(- y (* y1 256)) ,id ,color . ,help)
+          (push `(,(- x (* x1 256)) ,(- y (* y1 256)) ,id . ,help)
                 (gethash (cons x1 y1) osm--pins))))))))
 
 (defun osm--update-pins ()
@@ -587,7 +596,7 @@ Should be at least 7 days according to the server usage 
policies."
       (let* ((coord (bookmark-prop-get bm 'coordinates))
              (x (osm--lon-to-x (cadr coord) osm--zoom))
              (y (osm--lat-to-y (car coord) osm--zoom)))
-        (osm--put-pin 'osm-bookmark x y "#ff8800" (car bm))))))
+        (osm--put-pin 'bookmark x y (car bm))))))
 
 (autoload 'svg--image-data "svg")
 (defun osm--make-tile (x y)
@@ -600,10 +609,11 @@ Should be at least 7 days according to the server usage 
policies."
               (let* ((areas nil)
                      (svg-pins
                      (mapconcat
-                      (pcase-lambda (`(,p ,q ,id ,color . ,help))
+                      (pcase-lambda (`(,p ,q ,id . ,help))
                         (push `((poly . [,p ,q ,(- p 20) ,(- q 40) ,p ,(- q 
50) ,(+ p 20) ,(- q 40) ])
                                 ,id (help-echo ,(truncate-string-to-width help 
20 0 nil t) pointer hand))
                               areas)
+                        ;; 
https://commons.wikimedia.org/wiki/File:Simpleicons_Places_map-marker-1.svg
                         (format "
 <g fill='%s' stroke='#000000' stroke-width='9' transform='translate(%s %s) 
scale(0.09) translate(-256 -512)'>
 <path d='M256 0C167.641 0 96 71.625 96 160c0 24.75 5.625 48.219 15.672
@@ -611,7 +621,7 @@ Should be at least 7 days according to the server usage 
policies."
 C409.719 210.844 416 186.156 416 160C416 71.625 344.375
 0 256 0z M256 256c-53.016 0-96-43-96-96s42.984-96 96-96
 c53 0 96 43 96 96S309 256 256 256z'/>
-</g>" color p q)) ;; 
https://commons.wikimedia.org/wiki/File:Simpleicons_Places_map-marker-1.svg
+</g>" (alist-get id osm-pin-colors) p q))
                       pins "")))
                 (list :type 'svg :base-uri file :map areas
                       :data (concat "<svg width='256' height='256' 
version='1.1'
@@ -850,12 +860,12 @@ xmlns='http://www.w3.org/2000/svg' 
xmlns:xlink='http://www.w3.org/1999/xlink'>
             osm--zoom (nth 2 at)
             osm--x (osm--lon-to-x (nth 1 at) osm--zoom)
             osm--y (osm--lat-to-y (nth 0 at) osm--zoom))
-      (osm--put-transient-pin 'osm-transient osm--x osm--y "#ff0088" "Center"))
+      (osm--put-transient-pin 'center osm--x osm--y "Center"))
     (prog1 (pop-to-buffer (current-buffer))
       (osm--update))))
 
-(defun osm--put-transient-pin (id x y color help)
-  "Set transient pin at X/Y with COLOR, ID and HELP."
+(defun osm--put-transient-pin (id x y help)
+  "Set transient pin at X/Y with ID and HELP."
   (let ((buffer (current-buffer))
         (sym (make-symbol "osm--remove-transient-pin")))
     (fset sym (lambda ()
@@ -864,12 +874,12 @@ xmlns='http://www.w3.org/2000/svg' 
xmlns:xlink='http://www.w3.org/1999/xlink'>
                   (setq osm--transient-pins (assq-delete-all id 
osm--transient-pins))
                   ;; HACK: handle bookmark deletion
                   (when (and (eq this-command #'osm-bookmark-delete)
-                             (eq id 'osm-selected-bookmark))
+                             (eq id 'selected-bookmark))
                     (osm-bookmark-delete help)
                     (setq this-command #'ignore)))))
     (add-hook 'pre-command-hook sym)
     (setf (alist-get id osm--transient-pins)
-          (list x y color help))))
+          (list x y help))))
 
 ;;;###autoload
 (defun osm-goto (lat lon zoom)