[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/sketch-mode bcb639e 02/15: Transfrom transient object a
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/sketch-mode bcb639e 02/15: Transfrom transient object argument to local variable |
|
Date: |
Wed, 20 Oct 2021 05:57:34 -0400 (EDT) |
branch: externals/sketch-mode
commit bcb639ebc1677a4cfb6f369ab0461c5373dff220
Author: Daniel Nicolai <dalanicolai@gmail.com>
Commit: Daniel Nicolai <dalanicolai@gmail.com>
Transfrom transient object argument to local variable
---
sketch-mode.el | 111 +++++++++++++++++++++++++++++++++++++--------------------
1 file changed, 72 insertions(+), 39 deletions(-)
diff --git a/sketch-mode.el b/sketch-mode.el
index 6569f1c..5a0aa65 100644
--- a/sketch-mode.el
+++ b/sketch-mode.el
@@ -463,6 +463,7 @@ transient."
:keymap
`(
([sketch down-mouse-1] . sketch-interactively-1)
+ ([sketch double-mouse-1] . sketch-text-interactively)
([w1 mouse-1] . sketch-mouse-set-stroke-width)
([w2 mouse-1] . sketch-mouse-set-stroke-width)
([w3 mouse-1] . sketch-mouse-set-stroke-width)
@@ -528,7 +529,7 @@ VEC should be a cons or a list containing only number
elements."
(defvar-local show-layers nil)
(defvar-local sketch-cursor-position nil)
-(defvar sketch-object "line")
+(defvar sketch-object 'line)
(defvar sketch-stroke-color "black")
(defvar sketch-fill-color "none")
(defvar sketch-stroke-width 1)
@@ -619,8 +620,9 @@ values"
(default :initarg :default :initform nil)))
(cl-defmethod transient-infix-read ((obj sketch-variable:choices))
- (let ((choices (oref obj choices)))
- (if-let ((value (oref obj value)))
+ (let ((choices (oref obj choices))
+ (value (oref obj value)))
+ (if value
(cadr (member value choices))
(car choices))))
@@ -628,8 +630,9 @@ values"
"Return the value of OBJ's `value' slot if non-nil,
else return value of OBJ's `default' slot if non-nil,
else return nil"
- (let ((default (oref obj default)))
- (if-let ((value (oref obj value)))
+ (let ((default (oref obj default))
+ (value (oref obj value)))
+ (if value
(concat (oref obj argument) value)
(when default
(concat (oref obj argument) default)))))
@@ -706,6 +709,37 @@ else return nil"
(let ((choices (oref obj choices)))
(string-to-number (completing-read "Enter width (float also allowed): "
choices))))
+(defclass sketch-lisp-variable:object (sketch-lisp-variable:option)
+ ())
+
+(cl-defmethod transient-infix-read ((obj sketch-lisp-variable:object))
+ (let ((choices (oref obj choices))
+ (value (oref obj value)))
+ (or (cadr (member value choices)) (car choices))))
+
+(cl-defmethod transient-format-description ((obj sketch-lisp-variable:object))
+ (or (oref obj description)
+ (symbol-name (oref obj variable))))
+
+;; (cl-defmethod transient-format-value ((obj sketch-lisp-variable:choices))
+;; (propertize (prin1-to-string (oref obj value))
+;; 'face 'transient-value))
+
+(cl-defmethod transient-format-value ((obj sketch-lisp-variable:object))
+ (let ((value (symbol-name (oref obj value)))
+ (choices (mapcar #'symbol-name (oref obj choices))))
+ (concat
+ (propertize "[" 'face 'transient-inactive-value)
+ (mapconcat (lambda (choice)
+ (propertize choice 'face (if (equal choice value)
+ (if (member choice choices)
+ 'transient-value
+ 'font-lock-warning-face)
+ 'transient-inactive-value)))
+ choices
+ (propertize "|" 'face 'transient-inactive-value))
+ (propertize "]" 'face 'transient-inactive-value))))
+
;; (value (oref obj value)))
;; (or (cadr (member value choices)) (car choices))))
@@ -769,13 +803,13 @@ else return nil"
;; "url(#arrow)"
;; "none"))))
;; (command-and-coords (pcase (transient-arg-value "--object=" args)
-;; ("line" (list 'svg-line
+;; ('line (list 'svg-line
;; (car start-coords) (cdr
start-coords) (car end-coords) (cdr end-coords)))
-;; ("rectangle" `(svg-rectangle
,@(sketch--rectangle-coords start-coords end-coords)))
-;; ("circle" (list 'svg-circle
+;; ('rectangle `(svg-rectangle
,@(sketch--rectangle-coords start-coords end-coords)))
+;; ('circle (list 'svg-circle
;; (car start-coords) (cdr
start-coords)
;; (sketch--circle-radius
start-coords end-coords)))
-;; ("ellipse" `(svg-ellipse
,@(sketch--ellipse-coords start-coords end-coords))))))
+;; ('ellipse `(svg-ellipse
,@(sketch--ellipse-coords start-coords end-coords))))))
;; (apply (car command-and-coords) sketch-root `(,@(cdr command-and-coords)
,@object-props :id ,(sketch-create-label)))
;; (sketch-redraw)))
@@ -806,7 +840,7 @@ else return nil"
("A" "Add layer" sketch-add-layer)]]
["Commands"
[([sketch down-mouse-1] "Draw object" sketch-interactively-1)
- ([sketch mouse-1] "Draw text" sketch-text-interactively)
+ ([sketch double-mouse-1] "Draw text" sketch-text-interactively)
([sketch C-S-drag-mouse-1] "Crop image" sketch-crop)
;; ("T" "Polyline" test-mouse)
;; ([sketch S-down-mouse-1] "Track mouse" sketch-line)
@@ -827,10 +861,9 @@ else return nil"
(transient-define-infix sketch-object ()
:description "Option with list"
- :class 'sketch-variable:choices
- :argument "--object="
- :choices '("rectangle" "circle" "ellipse" "polyline" "polygon" "freehand")
- :default "line")
+ :class 'sketch-lisp-variable:object
+ :variable 'sketch-object
+ :choices '(line polyline rectangle circle ellipse freehand))
(transient-define-infix sketch-stroke-color ()
:description "Option with list"
@@ -988,15 +1021,15 @@ else return nil"
(let* ((prefix (concat (when (/= sketch-active-layer 0)
(number-to-string sketch-active-layer))
(pcase type
- ("line" "l")
- ("rectangle" "r")
- ("circle" "c")
- ("ellipse" "e")
- ("polyline" "p")
- ("polygon" "g")
- ("freehand" "f")
- ("text" "t")
- ("group" "g"))))
+ ('line "l")
+ ('rectangle "r")
+ ('circle "c")
+ ('ellipse "e")
+ ('polyline "p")
+ ('polygon "g")
+ ('freehand "f")
+ ('text "t")
+ ('group "g"))))
(idx 0)
(label (concat prefix (number-to-string idx)))
(labels (sketch-labels-list)))
@@ -1134,17 +1167,17 @@ else return nil"
(defun sketch-object-preview-update (object-type node start-coords end-coords)
(pcase object-type
- ("line"
+ ('line
(setf (dom-attr node 'x2) (car end-coords))
(setf (dom-attr node 'y2) (cdr end-coords)))
- ("rectangle"
+ ('rectangle
(setf (dom-attr node 'x) (car (sketch--rectangle-coords start-coords
end-coords)))
(setf (dom-attr node 'y) (cadr (sketch--rectangle-coords start-coords
end-coords)))
(setf (dom-attr node 'width) (caddr (sketch--rectangle-coords
start-coords end-coords)))
(setf (dom-attr node 'height) (cadddr (sketch--rectangle-coords
start-coords end-coords))))
- ("circle"
+ ('circle
(setf (dom-attr node 'r) (sketch--circle-radius start-coords end-coords)))
- ("ellipse"
+ ('ellipse
(setf (dom-attr node 'cx) (car (sketch--ellipse-coords start-coords
end-coords)))
(setf (dom-attr node 'cy) (cadr (sketch--ellipse-coords start-coords
end-coords)))
(setf (dom-attr node 'rx) (caddr (sketch--ellipse-coords start-coords
end-coords)))
@@ -1180,25 +1213,25 @@ else return nil"
"url(#arrow)"
"none"))))
(start-command-and-coords (pcase sketch-object
- ("line" (list 'svg-line
+ ('line (list 'svg-line
(car start-coords) (cdr
start-coords)
(car start-coords) (cdr
start-coords)))
- ("rectangle" `(svg-rectangle
+ ('rectangle `(svg-rectangle
,@(sketch--rectangle-coords start-coords start-coords)))
- ("circle" (list 'svg-circle
+ ('circle (list 'svg-circle
(car start-coords) (cdr
start-coords)
(sketch--circle-radius
start-coords start-coords)))
- ("ellipse" `(svg-ellipse
,@(sketch--ellipse-coords start-coords start-coords)))
+ ('ellipse `(svg-ellipse
,@(sketch--ellipse-coords start-coords start-coords)))
(var (list (pcase var
- ((or "polyline" "freehand")
'svg-polyline)
- ("polygon" 'svg-polygon))
+ ((or 'polyline 'freehand)
'svg-polyline)
+ ('polygon 'svg-polygon))
points))))
(label (sketch-create-label sketch-object)))
(apply (car start-command-and-coords)
(nth sketch-active-layer sketch-layers-list)
`(,@(cdr start-command-and-coords) ,@object-props :id ,label))
(let ((node (car (dom-by-id (nth sketch-active-layer sketch-layers-list)
label))))
- (cond ((member sketch-object '("line" "rectangle" "circle" "ellipse"))
+ (cond ((member sketch-object '(line rectangle circle ellipse))
(track-mouse
(while (not (eq (car event) 'drag-mouse-1))
(setq event (read-event))
@@ -1218,7 +1251,7 @@ else return nil"
(posn-object-x-y end)
(sketch--snap-to-grid (posn-object-x-y end)
grid-param))))
(sketch-object-preview-update sketch-object node start-coords
end-coords)))
- ((member sketch-object '("polyline" "polygon"))
+ ((member sketch-object '(polyline polygon))
(track-mouse
(while (not (eq (car event) 'double-mouse-1))
(setq event (read-event))
@@ -1250,7 +1283,7 @@ else return nil"
(push
end-coords points)
(cons end-coords
points)))
",
")))))
- ((string= sketch-object "freehand")
+ ((string= sketch-object 'freehand)
(track-mouse
(while (not (eq (car event) 'drag-mouse-1))
(setq event (read-event))
@@ -1290,7 +1323,7 @@ else return nil"
(interactive "@e")
(let ((coords (posn-object-x-y (event-start event)))
(node (oref transient-current-prefix value))
- (label (sketch-create-label "group")))
+ (label (sketch-create-label 'group)))
(dom-set-attribute node
'transform
(format "translate(%s,%s)" (car coords) (cdr coords)))
@@ -1314,7 +1347,7 @@ else return nil"
(snippet (if (dom-by-tag dom 'g)
(dom-elements dom 'id (number-to-string idx))
(list (dom-append-child
- (sketch-group (sketch-create-label "group"))
+ (sketch-group (sketch-create-label 'group))
(car (dom-children dom)))))))
(sketch-redraw)
(transient-setup 'sketch-import nil nil :value (car snippet)))))
@@ -1419,7 +1452,7 @@ else return nil"
;; (if sketch-include-end-marker
;; "url(#arrow)"
;; "none"))))
- (apply #'svg-text (nth sketch-active-layer sketch-layers-list) text :x
(car coords) :y (cdr coords) :id (sketch-create-label "text") object-props))
+ (apply #'svg-text (nth sketch-active-layer sketch-layers-list) text :x
(car coords) :y (cdr coords) :id (sketch-create-label 'text) object-props))
(sketch-redraw))
(transient-define-infix sketch-select-font ()
- [elpa] externals/sketch-mode updated (457ba48 -> 443e095), ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode bcb639e 02/15: Transfrom transient object argument to local variable,
ELPA Syncer <=
- [elpa] externals/sketch-mode d604e04 03/15: Implement real side-toolbar (instead of buttons in draw buffer), ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode 443e095 15/15: Merge branch 'develop', publish package :tada:, ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode 3214edb 13/15: Add hydra, ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode d23fdd7 04/15: Minor cleanup and corrections, ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode ad9c926 01/15: Add toolbars (transform transient arguments to local-variables), ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode c8dcf93 09/15: Orginal toolbar (almost finished), ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode 5abc729 11/15: Fix coordinates (hinders interactivity), and make them togglable, ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode 02b1c05 14/15: Ready for publish :tada: (small fixes + sketch Quit), ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode f728eef 10/15: First 'reasonably complete' version of cleanedup sketch-mode, ELPA Syncer, 2021/10/20
- [elpa] externals/sketch-mode 726e923 08/15: Continue cleanup and create vertically compressed toolbar, ELPA Syncer, 2021/10/20