[elpa] externals/sketch-mode 32559c4 06/38: Add remove functionality (id's and labels)

[ELPA Syncer]

branch: externals/sketch-mode
commit 32559c4c0e47de52f74ea2f661a5c4f029e08764
Author: Daniel Nicolai <dalanicolai@gmail.com>
Commit: Daniel Nicolai <dalanicolai@gmail.com>

    Add remove functionality (id's and labels)
---
 sketch-mode.el    |  72 +++++++++++++++++++++++++++++++++++++++++++++++++-----
 sketch-mode.png   | Bin 0 -> 65687 bytes
 sketch-scratch.el |   7 ++++++
 3 files changed, 73 insertions(+), 6 deletions(-)

diff --git a/sketch-mode.el b/sketch-mode.el
index 250f78e..5215e43 100644
--- a/sketch-mode.el
+++ b/sketch-mode.el
@@ -67,6 +67,10 @@ representing the image width and image height
   "When non-nil, show grid lines (default: t)."
   :type 'boolean)
 
+(defcustom sketch-show-labels nil
+  "When non-nil, show object labels (default: t)."
+  :type 'boolean)
+
 (defcustom sketch-default-grid-parameter 25
   "Default grid line separation distance (integer)."
   :type 'integer)
@@ -137,7 +141,9 @@ STOPS is a list of percentage/color pairs."
                                        (fill . ,(or color "black"))))))))))
 
 (define-minor-mode sketch-mode
-  "Create svg images using the mouse."
+  "Create svg images using the mouse.
+In sketch-mode buffer press \\[sketch-transient] to activate the
+transient."
   nil "sketch-mode"
   '(([drag-mouse-1] . sketch-interactively)
     ([C-S-drag-mouse-1] . sketch-interactively)
@@ -204,6 +210,7 @@ values"
       (let ((width (if arg (car sketch-default-image-size) (read-number "Enter 
width: ") ))
             (height (if arg 600 (read-number "Enter height: "))))
         (switch-to-buffer (get-buffer-create "*sketch*"))
+        (defvar-local sketch-elements nil)
         (defvar-local grid-param 25)
         (setq grid-param (if arg 25 (read-number "Enter grid parameter (enter 
0 for no grid): ")))
         (sketch--create-canvas width height grid-param)))))
@@ -292,7 +299,7 @@ values"
                 (propertize (apply 'color-rgb-to-hex (color-name-to-rgb 
default))
                             'face 'transient-inactive-argument))))))
 
-(transient-define-prefix  sketch-transient ()
+(transient-define-prefix sketch-transient ()
   "Some Emacs magic"
   :transient-suffix     'transient--do-call
   :transient-non-suffix 'transient--do-stay
@@ -302,11 +309,14 @@ values"
     ("C" "fill-color" sketch-fill-color)]
    [("w" "stroke-width" sketch-stroke-width)]
    [("m" "end-marker" sketch-object-marker)]]
-  ["Snap-to-grid"
+  ["Grid"
    ("s" "Snap to grid" sketch-snap)
-   ("t" "Toggle grid" sketch-toggle-grid)]
+   ("g" "Toggle grid" sketch-toggle-grid)]
+  ["Labels"
+   ("l" "Toggle labels" sketch-toggle-labels)]
   ["Commands"
    [([drag-mouse-1] "Sketch"  sketch-interactively-1)
+    ("R" "Remove object" sketch-remove-object)
     ("u" "Undo" sketch-undo)
     ("r" "Redo" sketch-redo)]
    [("d" "Show definition" sketch-show-definition)
@@ -360,10 +370,55 @@ values"
   (setq sketch-show-grid (if sketch-show-grid nil t))
   (sketch-redraw))
 
+(defun sketch-labels ()
+  (interactive)
+  (let ((svg-labels (svg-create 100 100)))
+    (mapc (lambda (node)
+            (pcase (car node)
+              ('rect (svg-text svg-labels
+                               (dom-attr node 'id)
+                               :x (+ (dom-attr node 'x) 2)
+                               :y (+ (dom-attr node 'y)
+                                     (- (dom-attr node 'height) 2))
+                               :font-size 20
+                               :stroke "red"
+                               :fill "red"))
+              ('line (svg-text svg-labels
+                               (dom-attr node 'id)
+                               :x (dom-attr node 'x1)
+                               :y (dom-attr node 'y1)
+                               :font-size 20
+                               :stroke "red"
+                               :fill "red"))))
+        (cddr svg-sketch))
+    (cddr svg-labels)))
+
+(defun sketch-labels-list ()
+  (mapcar (lambda (node)
+            (dom-attr node 'id))
+          (cddr svg-sketch)))
+
+(defun sketch-create-label ()
+  (interactive)
+  (let* ((alphabet "abcdefghijklmnopqrstuvwxyz")
+         (labels-list (mapcar 'string (concat alphabet (upcase alphabet))))
+         (labels (sketch-labels-list)))
+    (while (member (car labels-list) labels)
+      (setq labels-list (cdr labels-list)))
+    (car labels-list)))
+
+(defun sketch-toggle-labels ()
+  (interactive)
+  (setq sketch-show-labels (if sketch-show-labels nil t))
+  (sketch-redraw))
+
 (defun sketch-redraw ()
   (unless sketch-mode
     (user-error "Not in sketch-mode buffer"))
-  (setq svg (append svg-canvas (when sketch-show-grid (cddr svg-grid)) (cddr 
svg-sketch)))
+  (setq svg (append svg-canvas
+                    (when sketch-show-grid (cddr svg-grid))
+                    (cddr svg-sketch)
+                    (when sketch-show-labels (sketch-labels))))
   (erase-buffer) ;; a (not exact) alternative is to use (kill-backward-chars 1)
   (insert-image (svg-image svg :pointer 'arrow :grid-param grid-param)))
 
@@ -401,9 +456,14 @@ values"
                                                (car start-coords) (cdr 
start-coords)
                                                (sketch--circle-radius 
start-coords end-coords)))
                                ("ellipse" `(svg-ellipse 
,@(sketch--ellipse-coords start-coords end-coords))))))
-    (apply (car command-and-coords) svg-sketch `(,@(cdr command-and-coords) 
,@object-props))
+    (apply (car command-and-coords) svg-sketch `(,@(cdr command-and-coords) 
,@object-props :id ,(sketch-create-label)))
     (sketch-redraw)))
 
+(transient-define-suffix sketch-remove-object ()
+  (interactive)
+  (svg-remove svg-sketch (completing-read "Remove element with id: "
+                                          (sketch-labels-list)))
+  (sketch-redraw))
 ;; (defun sketch-interactively (event)
 ;;   "Draw object interactively, interpreting mouse event."
 ;;   (interactive "e")
diff --git a/sketch-mode.png b/sketch-mode.png
new file mode 100644
index 0000000..1be0fc4
Binary files /dev/null and b/sketch-mode.png differ
diff --git a/sketch-scratch.el b/sketch-scratch.el
new file mode 100644
index 0000000..1108976
--- /dev/null
+++ b/sketch-scratch.el
@@ -0,0 +1,7 @@
+(setq svg-scratch (svg-create 100 100))
+(svg-rectangle svg-scratch 25 25 50 50 :id "a")
+(svg-line svg-scratch 25 25 75 75 :id "b" :stroke-color "black")
+
+;; (svg-remove svg-scratch "a")
+
+(insert-image (svg-image (append svg-scratch (nthcdr 2 svg-labels))))