nandi/jolt-native · c7d6ea8

modified glimmer-backends/glimmer-jvui/src/glimmer_jvui/core.clj +6 -1 Viewed

@@ -382,7 +382,12 @@
382	382	;; handing it the text is an arity error the moment somebody
383	383	;; presses Enter. The text is already theirs; they got it from
384	384	;; :on-change.
385		- (when (w/entry-activated? id) (fire! n :on-activate)))
	385	+ (when (w/entry-activated? id) (fire! n :on-activate))
	386	+ ;; A paste that found no text on the clipboard. Also a thunk, and
	387	+ ;; for frq the important one: that is how a picture is pasted — the
	388	+ ;; same Ctrl+V as everything else, reaching `s/paste-image!` because
	389	+ ;; the field had nothing to put in itself. libvidya's name for it.
	390	+ (when (w/entry-paste-empty? id) (fire! n :on-paste-empty)))
386	391
387	392	:progress (w/progress (num (:value props) 0.0))
388	393	:separator (w/separator)

          ;; handing it the text is an arity error the moment somebody
          ;; presses Enter. The text is already theirs; they got it from
          ;; :on-change.
--        (when (w/entry-activated? id) (fire! n :on-activate)))
++        (when (w/entry-activated? id) (fire! n :on-activate))
++        ;; A paste that found no text on the clipboard. Also a thunk, and
++        ;; for frq the important one: that is how a picture is pasted — the
++        ;; same Ctrl+V as everything else, reaching `s/paste-image!` because
++        ;; the field had nothing to put in itself. libvidya's name for it.
++        (when (w/entry-paste-empty? id) (fire! n :on-paste-empty)))
        :progress (w/progress (num (:value props) 0.0))
        :separator (w/separator)

modified glimmer-backends/glimmer-jvui/test/glimmer_jvui/tests.clj +27 -0 Viewed

@@ -151,6 +151,32 @@
151	151	(check! (= "hi" (ra/deref text))
152	152	(str "typed text reached :on-change: " (pr-str (ra/deref text))))))
153	153
	154	+(defn- check-paste-reaches-the-client! []
	155	+ ;; Both halves of a paste, through the reconciler. Text lands in :on-change
	156	+ ;; like typing; a clipboard with no text on it reaches :on-paste-empty, a
	157	+ ;; THUNK, which is frq's `s/paste-image!` — the way a picture is pasted.
	158	+ (let [root (jv/root-node) cx (ctx)
	159	+ text (ra/atom "")
	160	+ asked (ra/atom 0)
	161	+ clip (atom "pasted")]
	162	+ (swap! cx assoc :clipboard (fn [] @clip))
	163	+ (gui/mount root :page
	164	+ [(fn [] [:entry {:value (ra/deref text)
	165	+ :on-change #(ra/reset! text %)
	166	+ :on-paste-empty #(ra/swap! asked inc)}])])
	167	+ (jv/render-once root cx)
	168	+ (let [[ex ey] (centre (tagged root :entry))]
	169	+ (jv/render-once root cx (click-at ex ey)))
	170	+ (jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
	171	+ (check! (= "pasted" (ra/deref text))
	172	+ (str "pasted text reached :on-change: " (pr-str (ra/deref text))))
	173	+ (check! (zero? (ra/deref asked)) "and a paste of text is not a request")
	174	+ (reset! clip nil)
	175	+ (jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
	176	+ (check! (= 1 (ra/deref asked))
	177	+ "a paste with no text on the clipboard reached :on-paste-empty")
	178	+ (check! (= "pasted" (ra/deref text)) "and changed nothing")))
	179	+
154	180	(defn- check-enter-sends! []
155	181	;; Enter is the one key a field must not swallow. frq sends its message
156	182	;; on it, so a compose box that accepted text and never reported Enter
@@ -308,6 +334,7 @@
308	334	["a list sticks to the end" check-scroll-sticks!]
309	335	["Enter sends" check-enter-sends!]
310	336	["an entry round-trips" check-entry-round-trips!]
	337	+ ["a paste reaches the client" check-paste-reaches-the-client!]
311	338	["a checkbox round-trips" check-checkbox-round-trips!]
312	339	["a patch settles before it paints" check-a-patch-settles-before-it-paints!]])
313	340

      (check! (= "hi" (ra/deref text))
              (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
++(defn- check-paste-reaches-the-client! []
++  ;; Both halves of a paste, through the reconciler. Text lands in :on-change
++  ;; like typing; a clipboard with no text on it reaches :on-paste-empty, a
++  ;; THUNK, which is frq's `s/paste-image!` — the way a picture is pasted.
++  (let [root (jv/root-node) cx (ctx)
++        text (ra/atom "")
++        asked (ra/atom 0)
++        clip (atom "pasted")]
++    (swap! cx assoc :clipboard (fn [] @clip))
++    (gui/mount root :page
++               [(fn [] [:entry {:value (ra/deref text)
++                                :on-change #(ra/reset! text %)
++                                :on-paste-empty #(ra/swap! asked inc)}])])
++    (jv/render-once root cx)
++    (let [[ex ey] (centre (tagged root :entry))]
++      (jv/render-once root cx (click-at ex ey)))
++    (jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
++    (check! (= "pasted" (ra/deref text))
++            (str "pasted text reached :on-change: " (pr-str (ra/deref text))))
++    (check! (zero? (ra/deref asked)) "and a paste of text is not a request")
++    (reset! clip nil)
++    (jv/render-once root cx [{:kind :key-down :key :v :ctrl? true}])
++    (check! (= 1 (ra/deref asked))
++            "a paste with no text on the clipboard reached :on-paste-empty")
++    (check! (= "pasted" (ra/deref text)) "and changed nothing")))
++
  (defn- check-enter-sends! []
    ;; Enter is the one key a field must not swallow. frq sends its message
    ;; on it, so a compose box that accepted text and never reported Enter
     ["a list sticks to the end"     check-scroll-sticks!]
     ["Enter sends"                  check-enter-sends!]
     ["an entry round-trips"          check-entry-round-trips!]
++   ["a paste reaches the client"    check-paste-reaches-the-client!]
     ["a checkbox round-trips"        check-checkbox-round-trips!]
     ["a patch settles before it paints" check-a-patch-settles-before-it-paints!]])

modified jvui/src/jvui/app.clj +3 -0 Viewed

@@ -21,6 +21,9 @@
21	21	:painter painter
22	22	:measure (fn [s sz] (font/size-of fonts s sz))
23	23	:line-height (fn [sz] (font/line-height fonts sz))
	24	+ ;; A function for the reason `:measure` is one: a field asks the
	25	+ ;; context, and a headless walk hands it a stub instead.
	26	+ :clipboard host/clipboard-text
24	27	:draw? false
25	28	:data {} :events [] :handled #{} :stack []
26	29	:mouse [-1 -1] :mouse-down? false

             :painter painter
             :measure (fn [s sz] (font/size-of fonts s sz))
             :line-height (fn [sz] (font/line-height fonts sz))
++           ;; A function for the reason `:measure` is one: a field asks the
++           ;; context, and a headless walk hands it a stub instead.
++           :clipboard host/clipboard-text
             :draw? false
             :data {} :events [] :handled #{} :stack []
             :mouse [-1 -1] :mouse-down? false

modified jvui/src/jvui/host.clj +6 -0 Viewed

@@ -80,6 +80,12 @@
80	80	[url]
81	81	(boolean (and (string? url) (seq url) (sdl/open-url! url))))
82	82
	83	+(defn clipboard-text
	84	+ "The clipboard's text, or nil — with no window, or when what is on it is not
	85	+ text. What a field pastes; see `clipboard-image-png!` for the other kind."
	86	+ []
	87	+ (when @win (sdl/clipboard)))
	88	+
83	89	(defn clipboard-image-png!
84	90	"Write the clipboard's picture to `path` as PNG; true when there was one.
85	91

    [url]
    (boolean (and (string? url) (seq url) (sdl/open-url! url))))
++(defn clipboard-text
++  "The clipboard's text, or nil — with no window, or when what is on it is not
++  text. What a field pastes; see `clipboard-image-png!` for the other kind."
++  []
++  (when @win (sdl/clipboard)))
++
  (defn clipboard-image-png!
    "Write the clipboard's picture to `path` as PNG; true when there was one.

modified jvui/src/jvui/sdl.clj +21 -2 Viewed

@@ -51,7 +51,7 @@
51	51	(ffi/defcfn ^:private raw-poll "SDL_PollEvent" [:pointer] :bool)
52	52	(ffi/defcfn start-text-input! "SDL_StartTextInput" [:pointer] :bool)
53	53	(ffi/defcfn stop-text-input! "SDL_StopTextInput" [:pointer] :bool)
54		-(ffi/defcfn clipboard "SDL_GetClipboardText" [] :string)
	54	+(ffi/defcfn ^:private raw-clipboard-text "SDL_GetClipboardText" [] :pointer)
55	55	(ffi/defcfn clipboard! "SDL_SetClipboardText" [:string] :bool)
56	56
57	57	(ffi/defcfn texture-from-surface "SDL_CreateTextureFromSurface" [:pointer :pointer] :pointer)
@@ -118,7 +118,11 @@
118	118	(def keycodes
119	119	{13 :return 27 :escape 8 :backspace 9 :tab 32 :space 127 :delete
120	120	1073741903 :right 1073741904 :left 1073741905 :down 1073741906 :up
121		- 1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down})
	121	+ 1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down
	122	+ ;; The two keys a paste is pressed with. A letter is otherwise left as its
	123	+ ;; code: a field takes what it types from text events, and only the ones a
	124	+ ;; shortcut is built on need a name.
	125	+ 118 :v 1073741897 :insert})
122	126
123	127	(def ^:private MOD-SHIFT 3) (def ^:private MOD-CTRL 192)
124	128
@@ -310,6 +314,21 @@
310	314	(when (raw-display-bounds (display-for-window window) r)
311	315	[(ffi/read (+ r 8) :int) (ffi/read (+ r 12) :int)])))
312	316
	317	+(defn clipboard
	318	+ "The clipboard's text, or nil when it holds none.
	319	+
	320	+ Through a pointer rather than a `:string` return because the buffer is
	321	+ SDL's to allocate and ours to free, and a converted return has already
	322	+ dropped the pointer that would free it — a leak per paste. SDL answers an
	323	+ empty string rather than NULL when there is no text, and that is nil here:
	324	+ a paste of nothing is a different request from a paste of \"\"."
	325	+ []
	326	+ (let [p (raw-clipboard-text)]
	327	+ (when (and p (not (ffi/null? p)))
	328	+ (try
	329	+ (let [t (ffi/ptr->string p)] (when (seq t) t))
	330	+ (finally (sdl-free! p))))))
	331	+
313	332	(defn clipboard-data
314	333	"The clipboard's contents for `mime`, as [pointer length], or nil.
315	334

  (ffi/defcfn ^:private raw-poll    "SDL_PollEvent"       [:pointer] :bool)
  (ffi/defcfn start-text-input!     "SDL_StartTextInput"  [:pointer] :bool)
  (ffi/defcfn stop-text-input!      "SDL_StopTextInput"   [:pointer] :bool)
--(ffi/defcfn clipboard             "SDL_GetClipboardText" [] :string)
++(ffi/defcfn ^:private raw-clipboard-text "SDL_GetClipboardText" [] :pointer)
  (ffi/defcfn clipboard!            "SDL_SetClipboardText" [:string] :bool)
  (ffi/defcfn texture-from-surface  "SDL_CreateTextureFromSurface" [:pointer :pointer] :pointer)
  (def keycodes
    {13 :return 27 :escape 8 :backspace 9 :tab 32 :space 127 :delete
     1073741903 :right 1073741904 :left 1073741905 :down 1073741906 :up
--   1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down})
++   1073741901 :end 1073741898 :home 1073741899 :page-up 1073741902 :page-down
++   ;; The two keys a paste is pressed with. A letter is otherwise left as its
++   ;; code: a field takes what it types from text events, and only the ones a
++   ;; shortcut is built on need a name.
++   118 :v 1073741897 :insert})
  (def ^:private MOD-SHIFT 3) (def ^:private MOD-CTRL 192)
      (when (raw-display-bounds (display-for-window window) r)
        [(ffi/read (+ r 8) :int) (ffi/read (+ r 12) :int)])))
++(defn clipboard
++  "The clipboard's text, or nil when it holds none.
++
++  Through a pointer rather than a `:string` return because the buffer is
++  SDL's to allocate and ours to free, and a converted return has already
++  dropped the pointer that would free it — a leak per paste. SDL answers an
++  empty string rather than NULL when there is no text, and that is nil here:
++  a paste of nothing is a different request from a paste of \"\"."
++  []
++  (let [p (raw-clipboard-text)]
++    (when (and p (not (ffi/null? p)))
++      (try
++        (let [t (ffi/ptr->string p)] (when (seq t) t))
++        (finally (sdl-free! p))))))
++
  (defn clipboard-data
    "The clipboard's contents for `mime`, as [pointer length], or nil.

modified jvui/src/jvui/widgets.clj +72 -1 Viewed

@@ -388,6 +388,34 @@
388	388	(or (first (keep-indexed (fn [i [_ hi]] (when (<= caret hi) i)) spans))
389	389	(max 0 (dec (count spans)))))
390	390
	391	+(defn entry-paste-empty?
	392	+ "Did the field under `id` see a paste with no text in it, on the frame just
	393	+ walked?
	394	+
	395	+ A paste is a keystroke asking for whatever is on the clipboard, and when
	396	+ that is not text it is still a request — for the picture, the file, the
	397	+ thing a text field cannot hold. The field records it rather than dropping
	398	+ it, so the client can go and fetch what the person meant."
	399	+ [id]
	400	+ (boolean (c/state id :paste-empty false)))
	401	+
	402	+(defn- caret-near
	403	+ "The offset between `lo` and `hi` in `s` whose edge is nearest `x` points
	404	+ from the start of that line.
	405	+
	406	+ Nearest EDGE, not the character under the pointer: a click on the right
	407	+ half of a letter means after it. Widths only grow along a line, so the walk
	408	+ stops the moment the distance starts growing again."
	409	+ [s lo hi x size]
	410	+ (loop [j lo best lo best-d Double/MAX_VALUE]
	411	+ (if (> j hi)
	412	+ best
	413	+ (let [d (Math/abs (- (double (first (c/measure (subs s lo j) size)))
	414	+ (double x)))]
	415	+ (if (< d best-d)
	416	+ (recur (inc j) j d)
	417	+ best)))))
	418	+
391	419	(defn text-entry
392	420	"An editable string. Answers the text after this frame.
393	421
@@ -432,12 +460,47 @@
432	460	shown (clamp (count spans) rows max-rows)
433	461	h (+ (double (c/th :control-height)) (* (dec shown) lh))
434	462	rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5])
435		- {:keys [hover? focused?]} (c/interact! id rect)
	463	+ {:keys [hover? focused? pressed? clicked?]} (c/interact! id rect)
436	464	[rx ry rw rh] rect
437	465	inner (- rw (* 2 pad))
438	466	spans (if grows? (wrap-spans s size inner) spans)
439	467	caret0 (clamp (c/state id :caret (count s)) 0 (count s))
	468	+ ;; Where a press puts the caret, read against what was DRAWN: the
	469	+ ;; line at the top and the sideways slide are last frame's, because
	470	+ ;; last frame's is what the person was looking at when they aimed.
	471	+ ;; Held as well as clicked, so dragging along a line carries the
	472	+ ;; caret with the pointer — and a press with no release yet is how
	473	+ ;; a real window delivers the first frame of every click.
	474	+ caret0 (if (or pressed? clicked?)
	475	+ (let [[mx my] (:mouse (c/ui))
	476	+ top0 (long (c/state id :top 0))
	477	+ shift0 (double (c/state id :shift 0.0))
	478	+ [_ th0] (c/measure (if (= s "") "M" s) size)
	479	+ ty0 (+ ry (/ (- (double (c/th :control-height)) th0) 2.0))
	480	+ k (clamp (+ top0 (long (Math/floor (/ (- my ty0) lh))))
	481	+ 0 (dec (count spans)))
	482	+ [lo hi] (nth spans k)]
	483	+ (caret-near s lo hi (+ (- mx (+ rx pad)) shift0) size))
	484	+ caret0)
440	485	evs (c/key-events id)
	486	+ ;; The clipboard comes from the context, the way the measurer does:
	487	+ ;; a window reads the desktop's and a headless walk reads whatever
	488	+ ;; its test put there. Asked only when a paste is actually pressed,
	489	+ ;; and only on the walk that sees keys — the settling passes see
	490	+ ;; none — so it is read once per paste and never per frame.
	491	+ pasted-empty (atom false)
	492	+ paste (fn [s caret]
	493	+ (let [read* (or (:clipboard (c/ui)) (constantly nil))
	494	+ t (some-> (read*) str (str/replace "\r\n" "\n")
	495	+ (str/replace "\r" "\n"))
	496	+ ;; A field with no second line flattens the paste
	497	+ ;; onto its one: a newline it cannot show would leave
	498	+ ;; the text saying one thing and the box another —
	499	+ ;; the rule Shift+Enter already follows.
	500	+ t (if (or grows? (nil? t)) t (str/replace t "\n" " "))]
	501	+ (if (seq t)
	502	+ [(str (subs s 0 caret) t (subs s caret)) (+ caret (count t))]
	503	+ (do (reset! pasted-empty true) [s caret]))))
441	504	;; Where the caret would land on the line above or below, by the
442	505	;; offset it holds INTO its line rather than by how far along the
443	506	;; line it looks. Two lines of proportional text never share a
@@ -486,6 +549,12 @@
486	549	;; on it. A field one line tall takes neither — a newline it
487	550	;; could not show would leave the text saying one thing and
488	551	;; the box another.
	552	+ ;; Ctrl+V, and Shift+Insert for the hands that learned it
	553	+ ;; first. Both, because a paste that works by one of them and
	554	+ ;; silently types nothing by the other reads as a clipboard
	555	+ ;; that is empty.
	556	+ :v (if (:ctrl? e) (paste s caret) [s caret])
	557	+ :insert (if (:shift? e) (paste s caret) [s caret])
489	558	:return (if (and grows? (:shift? e))
490	559	[(str (subs s 0 caret) "\n" (subs s caret))
491	560	(inc caret)]
@@ -496,6 +565,7 @@
496	565	caret' (clamp caret' 0 (count s'))
497	566	spans' (if grows? (wrap-spans s' size inner) [[0 (count s')]])]
498	567	(c/state! id :caret caret')
	568	+ (c/state! id :paste-empty @pasted-empty)
499	569	;; What the NEXT frame will be tall enough for, recorded for a caller
500	570	;; that has to leave room for it. A frame late by construction, which is
501	571	;; the same beat everything else about this field runs on.
@@ -539,6 +609,7 @@
539	609	;; past the border and over whatever is beside it.
540	610	shift (if grows? 0.0 (max 0.0 (- caret-x inner)))]
541	611	(c/state! id :top top)
	612	+ (c/state! id :shift shift)
542	613	(c/with-clip [(+ rx pad) ry inner rh]
543	614	(fn []
544	615	(if (and (= s' "") placeholder (not focused?))

    (or (first (keep-indexed (fn [i [_ hi]] (when (<= caret hi) i)) spans))
        (max 0 (dec (count spans)))))
++(defn entry-paste-empty?
++  "Did the field under `id` see a paste with no text in it, on the frame just
++   walked?
++
++   A paste is a keystroke asking for whatever is on the clipboard, and when
++   that is not text it is still a request — for the picture, the file, the
++   thing a text field cannot hold. The field records it rather than dropping
++   it, so the client can go and fetch what the person meant."
++  [id]
++  (boolean (c/state id :paste-empty false)))
++
++(defn- caret-near
++  "The offset between `lo` and `hi` in `s` whose edge is nearest `x` points
++   from the start of that line.
++
++   Nearest EDGE, not the character under the pointer: a click on the right
++   half of a letter means after it. Widths only grow along a line, so the walk
++   stops the moment the distance starts growing again."
++  [s lo hi x size]
++  (loop [j lo best lo best-d Double/MAX_VALUE]
++    (if (> j hi)
++      best
++      (let [d (Math/abs (- (double (first (c/measure (subs s lo j) size)))
++                           (double x)))]
++        (if (< d best-d)
++          (recur (inc j) j d)
++          best)))))
++
  (defn text-entry
    "An editable string. Answers the text after this frame.
           shown (clamp (count spans) rows max-rows)
           h (+ (double (c/th :control-height)) (* (dec shown) lh))
           rect (c/leaf [(double (or min-width 160.0)) h] expand [0.0 0.5])
--         {:keys [hover? focused?]} (c/interact! id rect)
++         {:keys [hover? focused? pressed? clicked?]} (c/interact! id rect)
           [rx ry rw rh] rect
           inner (- rw (* 2 pad))
           spans (if grows? (wrap-spans s size inner) spans)
           caret0 (clamp (c/state id :caret (count s)) 0 (count s))
++         ;; Where a press puts the caret, read against what was DRAWN: the
++         ;; line at the top and the sideways slide are last frame's, because
++         ;; last frame's is what the person was looking at when they aimed.
++         ;; Held as well as clicked, so dragging along a line carries the
++         ;; caret with the pointer — and a press with no release yet is how
++         ;; a real window delivers the first frame of every click.
++         caret0 (if (or pressed? clicked?)
++                  (let [[mx my] (:mouse (c/ui))
++                        top0 (long (c/state id :top 0))
++                        shift0 (double (c/state id :shift 0.0))
++                        [_ th0] (c/measure (if (= s "") "M" s) size)
++                        ty0 (+ ry (/ (- (double (c/th :control-height)) th0) 2.0))
++                        k (clamp (+ top0 (long (Math/floor (/ (- my ty0) lh))))
++                                 0 (dec (count spans)))
++                        [lo hi] (nth spans k)]
++                    (caret-near s lo hi (+ (- mx (+ rx pad)) shift0) size))
++                  caret0)
           evs (c/key-events id)
++         ;; The clipboard comes from the context, the way the measurer does:
++         ;; a window reads the desktop's and a headless walk reads whatever
++         ;; its test put there. Asked only when a paste is actually pressed,
++         ;; and only on the walk that sees keys — the settling passes see
++         ;; none — so it is read once per paste and never per frame.
++         pasted-empty (atom false)
++         paste (fn [s caret]
++                 (let [read* (or (:clipboard (c/ui)) (constantly nil))
++                       t (some-> (read*) str (str/replace "\r\n" "\n")
++                                 (str/replace "\r" "\n"))
++                       ;; A field with no second line flattens the paste
++                       ;; onto its one: a newline it cannot show would leave
++                       ;; the text saying one thing and the box another —
++                       ;; the rule Shift+Enter already follows.
++                       t (if (or grows? (nil? t)) t (str/replace t "\n" " "))]
++                   (if (seq t)
++                     [(str (subs s 0 caret) t (subs s caret)) (+ caret (count t))]
++                     (do (reset! pasted-empty true) [s caret]))))
           ;; Where the caret would land on the line above or below, by the
           ;; offset it holds INTO its line rather than by how far along the
           ;; line it looks. Two lines of proportional text never share a
                  ;; on it. A field one line tall takes neither — a newline it
                  ;; could not show would leave the text saying one thing and
                  ;; the box another.
++                ;; Ctrl+V, and Shift+Insert for the hands that learned it
++                ;; first. Both, because a paste that works by one of them and
++                ;; silently types nothing by the other reads as a clipboard
++                ;; that is empty.
++                :v (if (:ctrl? e) (paste s caret) [s caret])
++                :insert (if (:shift? e) (paste s caret) [s caret])
                  :return (if (and grows? (:shift? e))
                            [(str (subs s 0 caret) "\n" (subs s caret))
                             (inc caret)]
           caret' (clamp caret' 0 (count s'))
           spans' (if grows? (wrap-spans s' size inner) [[0 (count s')]])]
       (c/state! id :caret caret')
++     (c/state! id :paste-empty @pasted-empty)
       ;; What the NEXT frame will be tall enough for, recorded for a caller
       ;; that has to leave room for it. A frame late by construction, which is
       ;; the same beat everything else about this field runs on.
             ;; past the border and over whatever is beside it.
             shift (if grows? 0.0 (max 0.0 (- caret-x inner)))]
         (c/state! id :top top)
++       (c/state! id :shift shift)
         (c/with-clip [(+ rx pad) ry inner rh]
           (fn []
             (if (and (= s' "") placeholder (not focused?))

modified jvui/test/jvui/tests.clj +86 -0 Viewed

@@ -258,6 +258,88 @@
258	258	(check! (= "\n" @s) "plain enter still types nothing")
259	259	(check! (= 1 @acts) "and activates the field")))
260	260
	261	+(defn- check-click-places-the-caret! []
	262	+ ;; Eight pixels a character, so the fifth edge of "hello world" is forty
	263	+ ;; points in from where the text starts. A click just past it means after
	264	+ ;; the "o"; typing there has to land between "hello" and " world".
	265	+ (let [cx (ctx) s (atom "hello world") r (atom nil)
	266	+ render (fn []
	267	+ (let [id (c/next-id nil)]
	268	+ (reset! s (w/text-entry @s {:expand :none}))
	269	+ (reset! r (c/rect-of id))))
	270	+ pad (double (:padding (:theme @cx)))]
	271	+ (frame! cx render)
	272	+ (let [[rx ry _ rh] @r
	273	+ y (+ ry (/ rh 2.0))]
	274	+ (frame! cx render (click-at (+ rx pad 41) y))
	275	+ (frame! cx render [{:kind :text :text "X"}])
	276	+ (check! (= "helloX world" @s)
	277	+ (str "a click puts the caret where it landed: " (pr-str @s)))
	278	+ ;; And a click left of the text is the start, not nowhere.
	279	+ (frame! cx render (click-at (+ rx 1) y))
	280	+ (frame! cx render [{:kind :text :text "<"}])
	281	+ (check! (= "<helloX world" @s)
	282	+ (str "and a click before the text is its start: " (pr-str @s))))))
	283	+
	284	+(defn- check-click-picks-the-line! []
	285	+ ;; A field with lines takes the click's height too: the second line of two,
	286	+ ;; at its head, is offset of the first line plus its break.
	287	+ (let [cx (ctx) s (atom "one\ntwo") r (atom nil)
	288	+ render (fn []
	289	+ (let [id (c/next-id nil)]
	290	+ (reset! s (w/text-entry @s {:expand :none :max-rows 3}))
	291	+ (reset! r (c/rect-of id))))
	292	+ pad (double (:padding (:theme @cx)))
	293	+ ch (double (:control-height (:theme @cx)))]
	294	+ (frame! cx render)
	295	+ (frame! cx render)
	296	+ (let [[rx ry] @r
	297	+ ;; the middle of the second line: the first line's top inset is
	298	+ ;; half of what the control's height leaves around one line
	299	+ y (+ ry (/ (- ch 16.0) 2.0) 16.0 8.0)]
	300	+ (frame! cx render (click-at (+ rx pad 1) y))
	301	+ (frame! cx render [{:kind :text :text "X"}])
	302	+ (check! (= "one\nXtwo" @s)
	303	+ (str "a click on the second line lands on it: " (pr-str @s))))))
	304	+
	305	+(defn- check-paste! []
	306	+ (let [cx (ctx) s (atom "ab") clip (atom "xyz")
	307	+ render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
	308	+ (swap! cx assoc :clipboard (fn [] @clip))
	309	+ (frame! cx render)
	310	+ ;; The click only focuses; where it put the caret is the other check's
	311	+ ;; business, so the caret is set here by keys — End, then one back.
	312	+ (frame! cx render (click-at 10 10))
	313	+ (frame! cx render [{:kind :key-down :key :end}
	314	+ {:kind :key-down :key :left}])
	315	+ (frame! cx render [{:kind :key-down :key :v :ctrl? true}])
	316	+ (check! (= "axyzb" @s) (str "ctrl+v pastes at the caret: " (pr-str @s)))
	317	+ (frame! cx render [{:kind :key-down :key :insert :shift? true}])
	318	+ (check! (= "axyzxyzb" @s) (str "and so does shift+insert: " (pr-str @s)))
	319	+ (frame! cx render [{:kind :key-down :key :v}])
	320	+ (check! (= "axyzxyzb" @s) "a v with no ctrl is not a paste")
	321	+ (reset! clip "one\r\ntwo")
	322	+ (reset! s "")
	323	+ (frame! cx render [{:kind :key-down :key :v :ctrl? true}])
	324	+ (check! (= "one two" @s)
	325	+ (str "a field of one line flattens a pasted break: " (pr-str @s)))))
	326	+
	327	+(defn- check-paste-with-no-text! []
	328	+ (let [cx (ctx) s (atom "") seen (atom nil)
	329	+ render (fn []
	330	+ (let [id (c/next-id nil)]
	331	+ (reset! s (w/text-entry @s {:expand :none}))
	332	+ (reset! seen (w/entry-paste-empty? id))))]
	333	+ (swap! cx assoc :clipboard (constantly nil))
	334	+ (frame! cx render)
	335	+ (frame! cx render (click-at 10 10))
	336	+ (check! (false? @seen) "no paste, no request")
	337	+ (frame! cx render [{:kind :key-down :key :v :ctrl? true}])
	338	+ (check! (true? @seen) "a paste of nothing is recorded as asked for")
	339	+ (check! (= "" @s) "and types nothing")
	340	+ (frame! cx render)
	341	+ (check! (false? @seen) "for the one frame it happened on")))
	342	+
261	343	(defn- check-unfocused-entry-ignores-keys! []
262	344	(let [cx (ctx) s (atom "")
263	345	render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
@@ -414,6 +496,10 @@
414	496	["an unfocused field does not" check-unfocused-entry-ignores-keys!]
415	497	["a field grows" check-entry-grows!]
416	498	["shift+enter breaks a line" check-entry-shift-enter!]
	499	+ ["a click places the caret" check-click-places-the-caret!]
	500	+ ["a click picks the line" check-click-picks-the-line!]
	501	+ ["a field pastes" check-paste!]
	502	+ ["a paste of nothing asks" check-paste-with-no-text!]
417	503	["tab moves focus" check-tab-moves-focus!]
418	504	["a viewport scrolls" check-scroll!]
419	505	["the theme mixes" check-theme!]])

      (check! (= "\n" @s) "plain enter still types nothing")
      (check! (= 1 @acts) "and activates the field")))
++(defn- check-click-places-the-caret! []
++  ;; Eight pixels a character, so the fifth edge of "hello world" is forty
++  ;; points in from where the text starts. A click just past it means after
++  ;; the "o"; typing there has to land between "hello" and " world".
++  (let [cx (ctx) s (atom "hello world") r (atom nil)
++        render (fn []
++                 (let [id (c/next-id nil)]
++                   (reset! s (w/text-entry @s {:expand :none}))
++                   (reset! r (c/rect-of id))))
++        pad (double (:padding (:theme @cx)))]
++    (frame! cx render)
++    (let [[rx ry _ rh] @r
++          y (+ ry (/ rh 2.0))]
++      (frame! cx render (click-at (+ rx pad 41) y))
++      (frame! cx render [{:kind :text :text "X"}])
++      (check! (= "helloX world" @s)
++              (str "a click puts the caret where it landed: " (pr-str @s)))
++      ;; And a click left of the text is the start, not nowhere.
++      (frame! cx render (click-at (+ rx 1) y))
++      (frame! cx render [{:kind :text :text "<"}])
++      (check! (= "<helloX world" @s)
++              (str "and a click before the text is its start: " (pr-str @s))))))
++
++(defn- check-click-picks-the-line! []
++  ;; A field with lines takes the click's height too: the second line of two,
++  ;; at its head, is offset of the first line plus its break.
++  (let [cx (ctx) s (atom "one\ntwo") r (atom nil)
++        render (fn []
++                 (let [id (c/next-id nil)]
++                   (reset! s (w/text-entry @s {:expand :none :max-rows 3}))
++                   (reset! r (c/rect-of id))))
++        pad (double (:padding (:theme @cx)))
++        ch (double (:control-height (:theme @cx)))]
++    (frame! cx render)
++    (frame! cx render)
++    (let [[rx ry] @r
++          ;; the middle of the second line: the first line's top inset is
++          ;; half of what the control's height leaves around one line
++          y (+ ry (/ (- ch 16.0) 2.0) 16.0 8.0)]
++      (frame! cx render (click-at (+ rx pad 1) y))
++      (frame! cx render [{:kind :text :text "X"}])
++      (check! (= "one\nXtwo" @s)
++              (str "a click on the second line lands on it: " (pr-str @s))))))
++
++(defn- check-paste! []
++  (let [cx (ctx) s (atom "ab") clip (atom "xyz")
++        render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
++    (swap! cx assoc :clipboard (fn [] @clip))
++    (frame! cx render)
++    ;; The click only focuses; where it put the caret is the other check's
++    ;; business, so the caret is set here by keys — End, then one back.
++    (frame! cx render (click-at 10 10))
++    (frame! cx render [{:kind :key-down :key :end}
++                       {:kind :key-down :key :left}])
++    (frame! cx render [{:kind :key-down :key :v :ctrl? true}])
++    (check! (= "axyzb" @s) (str "ctrl+v pastes at the caret: " (pr-str @s)))
++    (frame! cx render [{:kind :key-down :key :insert :shift? true}])
++    (check! (= "axyzxyzb" @s) (str "and so does shift+insert: " (pr-str @s)))
++    (frame! cx render [{:kind :key-down :key :v}])
++    (check! (= "axyzxyzb" @s) "a v with no ctrl is not a paste")
++    (reset! clip "one\r\ntwo")
++    (reset! s "")
++    (frame! cx render [{:kind :key-down :key :v :ctrl? true}])
++    (check! (= "one two" @s)
++            (str "a field of one line flattens a pasted break: " (pr-str @s)))))
++
++(defn- check-paste-with-no-text! []
++  (let [cx (ctx) s (atom "") seen (atom nil)
++        render (fn []
++                 (let [id (c/next-id nil)]
++                   (reset! s (w/text-entry @s {:expand :none}))
++                   (reset! seen (w/entry-paste-empty? id))))]
++    (swap! cx assoc :clipboard (constantly nil))
++    (frame! cx render)
++    (frame! cx render (click-at 10 10))
++    (check! (false? @seen) "no paste, no request")
++    (frame! cx render [{:kind :key-down :key :v :ctrl? true}])
++    (check! (true? @seen) "a paste of nothing is recorded as asked for")
++    (check! (= "" @s) "and types nothing")
++    (frame! cx render)
++    (check! (false? @seen) "for the one frame it happened on")))
++
  (defn- check-unfocused-entry-ignores-keys! []
    (let [cx (ctx) s (atom "")
          render (fn [] (reset! s (w/text-entry @s {:expand :none})))]
     ["an unfocused field does not" check-unfocused-entry-ignores-keys!]
     ["a field grows"              check-entry-grows!]
     ["shift+enter breaks a line"  check-entry-shift-enter!]
++   ["a click places the caret"   check-click-places-the-caret!]
++   ["a click picks the line"     check-click-picks-the-line!]
++   ["a field pastes"             check-paste!]
++   ["a paste of nothing asks"    check-paste-with-no-text!]
     ["tab moves focus"           check-tab-moves-focus!]
     ["a viewport scrolls"        check-scroll!]
     ["the theme mixes"           check-theme!]])

Put the caret where the click lands, and paste into the field