nandi/frqpublic Fork 0
0aa84f8
Commits
Clone
git clone https://git.rickub.com/nandi/frq.git
git clone ssh://git@rickub.com/nandi/frq.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

Show who someone is on the phone

`frq.profile` splits along the line the two halves actually differ on, and
it is not the fetching. What a profile *is* — the cache, the fields parsed
out of getProfile, the counts line, the bio truncation, the web URL, and
which identity to look one up by — is the same under either compiler and
moves to common/. What a *pointer* does about one does not: hovering a
face, the grace period for crossing from the face to the card, and the card
reporting its own pointer so moving into it is not the same as leaving.
That is `frq.profile.pointer`, and it is desktop by nature. A finger is
either on a name or not on it.

The fetch is a seam for the usual reason — a future and a blocking request
on one side, an awaited one on the other — and nothing is fetched until a
backend installs one.

`avatars/actor` came along, because deciding whether a nick is worth a
lookup is the same question on both: a DID from the account tag, else the
nick when it is handle-shaped, else nobody. The phone had never put an
`:actor` on a message, so there was nothing to look up by even once there
was something to look it up with.

The cells went into `frq.cells` rather than beside the logic, and that is
deliberate: the phone repaints off `cells/all-cells`, so a cell kept
anywhere else is state that changes and a screen that does not notice.

Two renderer gaps, both the unknown-tag marker doing its job or failing to.
`:dialog` was not a tag this backend had — on a phone it is a sheet, since
the screen is the width of the dialog already. And `:avatar` was drawn with
no gesture at all, so the chat screen's `:on-click` went nowhere: the one
gesture a phone has for opening a profile.

Verified on a Pixel 6a: tapping a face opens the card with the name,
handle, DID, bio and counts, and Close puts it away.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-12T02:13:30-07:00 Browse files
0aa84f8 parent: dcb50e0
modified common/frq/cells.cljc +15 -1
@@ -214,6 +214,20 @@
214214 (defonce image-picker (atom nil))
215215
216216
217+;; ------------------------------------------------------------------ profiles
218+
219+;; Who is being looked at, or nil `{:nick :actor}`, where `actor` is the DID
220+;; or handle, and nil for a guest.
221+(defonce profile-viewing (atom nil))
222+
223+;; The face the pointer is resting on, the same shape. A card is painted for
224+;; this one alone rather than hung under every avatar in the column.
225+(defonce profile-hovering (atom nil))
226+
227+;; Bumped when a profile fetch lands, so the screen re-renders without
228+;; watching the cache map itself.
229+(defonce profile-tick (atom 0))
230+
217231 ;; ------------------------------------------------------------- enumeration
218232
219233 (defn all-cells
@@ -241,4 +255,4 @@
241255 attachment jump-tick show-users? hide-chat-list? overview? at-present?
242256 emoji-group emoji-search highlight jump-to lightbox overview-return
243257 reacting window-height window-width reaction-hover hide-join-part?
244- image-picker])
258+ image-picker profile-viewing profile-hovering profile-tick])
@@ -214,6 +214,20 @@
214 (defonce image-picker (atom nil))214 (defonce image-picker (atom nil))
215 215
216 216
217+;; ------------------------------------------------------------------ profiles
218+
219+;; Who is being looked at, or nil `{:nick :actor}`, where `actor` is the DID
220+;; or handle, and nil for a guest.
221+(defonce profile-viewing (atom nil))
222+
223+;; The face the pointer is resting on, the same shape. A card is painted for
224+;; this one alone rather than hung under every avatar in the column.
225+(defonce profile-hovering (atom nil))
226+
227+;; Bumped when a profile fetch lands, so the screen re-renders without
228+;; watching the cache map itself.
229+(defonce profile-tick (atom 0))
230+
217 ;; ------------------------------------------------------------- enumeration231 ;; ------------------------------------------------------------- enumeration
218 232
219 (defn all-cells233 (defn all-cells
@@ -241,4 +255,4 @@
241 attachment jump-tick show-users? hide-chat-list? overview? at-present?255 attachment jump-tick show-users? hide-chat-list? overview? at-present?
242 emoji-group emoji-search highlight jump-to lightbox overview-return256 emoji-group emoji-search highlight jump-to lightbox overview-return
243 reacting window-height window-width reaction-hover hide-join-part?257 reacting window-height window-width reaction-hover hide-join-part?
244- image-picker])258+ image-picker profile-viewing profile-hovering profile-tick])
added common/frq/profile.cljc +150 -0
new file mode 100644
@@ -0,0 +1,150 @@
1+(ns frq.profile
2+ "Who someone is, behind the nick on a line.
3+
4+ sleek's peer profile modal, as a screen. Tapping a name or a face opens it:
5+ the picture at a size worth looking at, the display name and handle, the DID,
6+ whatever bio and counts Bluesky holds, and a way through to their profile on
7+ the web.
8+
9+ One fetch per person, kept for the run a profile is looked at repeatedly
10+ and changes on nobody's timescale. Guests have no identity to fetch, so for
11+ them the screen is the nick and a line saying so, which is the honest answer
12+ rather than a spinner that never lands.
13+
14+ What a profile *is* is here. What a *pointer* does about one is not: hovering
15+ a face, the grace period for crossing to the card, and the card reporting its
16+ own pointer are all the desktop's, and stay in `src/frq/profile.clj`. A
17+ finger is either on a name or not on it.
18+
19+ The fetch is a seam, because it is the one part that differs a future and a
20+ blocking request on one side, an awaited one on the other. Nothing is fetched
21+ until a backend installs one, and `entry` simply answers nil."
22+ (:require [clojure.string :as str]
23+ [frq.atproto.core :as atproto]
24+ [frq.cells :as cells]))
25+
26+(def directory-host atproto/directory-host)
27+
28+;; actor -> {:status :loading | :ready | :failed, and the fields when ready}.
29+;;
30+;; Not one of `frq.cells`: nothing reads the map itself, `profile-tick` is the
31+;; signal that what it holds has changed, and that is a cell.
32+(defonce ^:private cache (atom {}))
33+
34+(def viewing cells/profile-viewing)
35+(def hovering cells/profile-hovering)
36+(def tick cells/profile-tick)
37+
38+;; A handle is a domain: labels joined by dots, ending in something alphabetic.
39+;; An IRC nick cannot be one by accident `sleek5209` and `eve` are not.
40+(def ^:private handle-pattern
41+ #"(?i)^[a-z0-9][a-z0-9-]*(\.[a-z0-9][a-z0-9-]*)*\.[a-z]{2,}$")
42+
43+(defn handle?
44+ "Whether this nick is an AT Protocol handle, and so worth a lookup."
45+ [nick]
46+ (boolean (and nick (re-matches handle-pattern nick))))
47+
48+(defn actor
49+ "The identity to look a profile up by, or nil when there is none.
50+
51+ A DID from the message's `account` tag when the server sent one — it is the
52+ identity itself, and holds whatever the nick happens to be today. Otherwise
53+ the nick, but only when it is handle-shaped: freeq gives an authenticated
54+ user their handle by default, while `sleek5209` is a guest with no profile."
55+ [did nick]
56+ (cond
57+ (and did (str/starts-with? (str did) "did:")) did
58+ (handle? nick) nick
59+ :else nil))
60+
61+(defn profile-req
62+ "Ask the directory who this is.
63+
64+ The actor goes in unescaped, as it always has: a handle is a domain name and
65+ a DID is `did:` and base32, and neither carries a character a query string
66+ would mind."
67+ [actor]
68+ {:host directory-host
69+ :path (str "/xrpc/app.bsky.actor.getProfile?actor=" actor)})
70+
71+(defn parse
72+ "The fields the screen paints, out of an `app.bsky.actor.getProfile` body."
73+ [body]
74+ {:status :ready
75+ :did (atproto/json-str body "did")
76+ :handle (atproto/json-str body "handle")
77+ :display-name (some-> (atproto/json-str body "displayName")
78+ atproto/json-unescape
79+ str/trim
80+ not-empty)
81+ :description (some-> (atproto/json-str body "description")
82+ atproto/json-unescape
83+ str/trim
84+ not-empty)
85+ :followers (atproto/json-num body "followersCount")
86+ :follows (atproto/json-num body "followsCount")
87+ :posts (atproto/json-num body "postsCount")})
88+
89+(defn entry
90+ "What is known about this person right now, or nil before anything is."
91+ [actor]
92+ (get @cache actor))
93+
94+;; The backend's fetcher: called with the actor, and expected to land the
95+;; answer through `deliver-profile!` whenever it arrives.
96+(defonce ^:private fetcher (atom nil))
97+
98+(defn install-fetch!
99+ "How this backend asks the directory. See the ns docstring."
100+ [f]
101+ (reset! fetcher f))
102+
103+(defn deliver-profile!
104+ "What came back, however it was fetched. `body` nil means it did not."
105+ [actor body]
106+ (swap! cache assoc actor
107+ (or (when (and body (atproto/json-str body "did")) (parse body))
108+ {:status :failed}))
109+ (swap! tick inc))
110+
111+(defn fetch!
112+ "Ensure this person's profile is on its way. Returns without waiting;
113+ `entry` answers for it afterwards and `tick` says when that has changed."
114+ [actor]
115+ (when (and (seq (str (or actor ""))) (not (contains? @cache actor)))
116+ (swap! cache assoc actor {:status :loading})
117+ (when-let [f @fetcher] (f actor))))
118+
119+(defn open!
120+ "Look at someone. `actor` is their DID or handle, or nil for a guest."
121+ [nick actor]
122+ (reset! viewing {:nick nick :actor actor})
123+ (fetch! actor))
124+
125+(defn close! [] (reset! viewing nil))
126+
127+(defn web-url
128+ "Their profile on the web, by handle where there is one and DID otherwise."
129+ [{:keys [handle did]}]
130+ (let [who (or (not-empty (str/trim (or handle ""))) did)]
131+ (when (seq who)
132+ (str "https://bsky.app/profile/" (str/replace who #"^@" "")))))
133+
134+(defn stats-line
135+ "\"12 followers · 34 following · 56 posts\", or nil when none are known."
136+ [{:keys [followers follows posts]}]
137+ (let [parts (cond-> []
138+ followers (conj (str followers " followers"))
139+ follows (conj (str follows " following"))
140+ posts (conj (str posts " posts")))]
141+ (when (seq parts) (str/join " · " parts))))
142+
143+(defn truncate
144+ "A bio cut to `max` characters, keeping its line breaks — the height of a
145+ multi-line bio is part of what it says."
146+ [s max]
147+ (let [t (str/trim (or s ""))]
148+ (if (<= (count t) max)
149+ t
150+ (str (subs t 0 (dec max)) ""))))
new file mode 100644
@@ -0,0 +1,150 @@
1+(ns frq.profile
2+ "Who someone is, behind the nick on a line.
3+
4+ sleek's peer profile modal, as a screen. Tapping a name or a face opens it:
5+ the picture at a size worth looking at, the display name and handle, the DID,
6+ whatever bio and counts Bluesky holds, and a way through to their profile on
7+ the web.
8+
9+ One fetch per person, kept for the run a profile is looked at repeatedly
10+ and changes on nobody's timescale. Guests have no identity to fetch, so for
11+ them the screen is the nick and a line saying so, which is the honest answer
12+ rather than a spinner that never lands.
13+
14+ What a profile *is* is here. What a *pointer* does about one is not: hovering
15+ a face, the grace period for crossing to the card, and the card reporting its
16+ own pointer are all the desktop's, and stay in `src/frq/profile.clj`. A
17+ finger is either on a name or not on it.
18+
19+ The fetch is a seam, because it is the one part that differs a future and a
20+ blocking request on one side, an awaited one on the other. Nothing is fetched
21+ until a backend installs one, and `entry` simply answers nil."
22+ (:require [clojure.string :as str]
23+ [frq.atproto.core :as atproto]
24+ [frq.cells :as cells]))
25+
26+(def directory-host atproto/directory-host)
27+
28+;; actor -> {:status :loading | :ready | :failed, and the fields when ready}.
29+;;
30+;; Not one of `frq.cells`: nothing reads the map itself, `profile-tick` is the
31+;; signal that what it holds has changed, and that is a cell.
32+(defonce ^:private cache (atom {}))
33+
34+(def viewing cells/profile-viewing)
35+(def hovering cells/profile-hovering)
36+(def tick cells/profile-tick)
37+
38+;; A handle is a domain: labels joined by dots, ending in something alphabetic.
39+;; An IRC nick cannot be one by accident `sleek5209` and `eve` are not.
40+(def ^:private handle-pattern
41+ #"(?i)^[a-z0-9][a-z0-9-]*(\.[a-z0-9][a-z0-9-]*)*\.[a-z]{2,}$")
42+
43+(defn handle?
44+ "Whether this nick is an AT Protocol handle, and so worth a lookup."
45+ [nick]
46+ (boolean (and nick (re-matches handle-pattern nick))))
47+
48+(defn actor
49+ "The identity to look a profile up by, or nil when there is none.
50+
51+ A DID from the message's `account` tag when the server sent one — it is the
52+ identity itself, and holds whatever the nick happens to be today. Otherwise
53+ the nick, but only when it is handle-shaped: freeq gives an authenticated
54+ user their handle by default, while `sleek5209` is a guest with no profile."
55+ [did nick]
56+ (cond
57+ (and did (str/starts-with? (str did) "did:")) did
58+ (handle? nick) nick
59+ :else nil))
60+
61+(defn profile-req
62+ "Ask the directory who this is.
63+
64+ The actor goes in unescaped, as it always has: a handle is a domain name and
65+ a DID is `did:` and base32, and neither carries a character a query string
66+ would mind."
67+ [actor]
68+ {:host directory-host
69+ :path (str "/xrpc/app.bsky.actor.getProfile?actor=" actor)})
70+
71+(defn parse
72+ "The fields the screen paints, out of an `app.bsky.actor.getProfile` body."
73+ [body]
74+ {:status :ready
75+ :did (atproto/json-str body "did")
76+ :handle (atproto/json-str body "handle")
77+ :display-name (some-> (atproto/json-str body "displayName")
78+ atproto/json-unescape
79+ str/trim
80+ not-empty)
81+ :description (some-> (atproto/json-str body "description")
82+ atproto/json-unescape
83+ str/trim
84+ not-empty)
85+ :followers (atproto/json-num body "followersCount")
86+ :follows (atproto/json-num body "followsCount")
87+ :posts (atproto/json-num body "postsCount")})
88+
89+(defn entry
90+ "What is known about this person right now, or nil before anything is."
91+ [actor]
92+ (get @cache actor))
93+
94+;; The backend's fetcher: called with the actor, and expected to land the
95+;; answer through `deliver-profile!` whenever it arrives.
96+(defonce ^:private fetcher (atom nil))
97+
98+(defn install-fetch!
99+ "How this backend asks the directory. See the ns docstring."
100+ [f]
101+ (reset! fetcher f))
102+
103+(defn deliver-profile!
104+ "What came back, however it was fetched. `body` nil means it did not."
105+ [actor body]
106+ (swap! cache assoc actor
107+ (or (when (and body (atproto/json-str body "did")) (parse body))
108+ {:status :failed}))
109+ (swap! tick inc))
110+
111+(defn fetch!
112+ "Ensure this person's profile is on its way. Returns without waiting;
113+ `entry` answers for it afterwards and `tick` says when that has changed."
114+ [actor]
115+ (when (and (seq (str (or actor ""))) (not (contains? @cache actor)))
116+ (swap! cache assoc actor {:status :loading})
117+ (when-let [f @fetcher] (f actor))))
118+
119+(defn open!
120+ "Look at someone. `actor` is their DID or handle, or nil for a guest."
121+ [nick actor]
122+ (reset! viewing {:nick nick :actor actor})
123+ (fetch! actor))
124+
125+(defn close! [] (reset! viewing nil))
126+
127+(defn web-url
128+ "Their profile on the web, by handle where there is one and DID otherwise."
129+ [{:keys [handle did]}]
130+ (let [who (or (not-empty (str/trim (or handle ""))) did)]
131+ (when (seq who)
132+ (str "https://bsky.app/profile/" (str/replace who #"^@" "")))))
133+
134+(defn stats-line
135+ "\"12 followers · 34 following · 56 posts\", or nil when none are known."
136+ [{:keys [followers follows posts]}]
137+ (let [parts (cond-> []
138+ followers (conj (str followers " followers"))
139+ follows (conj (str follows " following"))
140+ posts (conj (str posts " posts")))]
141+ (when (seq parts) (str/join " · " parts))))
142+
143+(defn truncate
144+ "A bio cut to `max` characters, keeping its line breaks — the height of a
145+ multi-line bio is part of what it says."
146+ [s max]
147+ (let [t (str/trim (or s ""))]
148+ (if (<= (count t) max)
149+ t
150+ (str (subs t 0 (dec max)) ""))))
modified flutter/src/frq/hiccup.cljd +46 -9
@@ -471,6 +471,30 @@
471471 .fontSize (* 0.85 size)
472472 .color (if mine t/on-accent t/on-card)))]))))))
473473
474+ ;; libcosmic's dialog is centred over the window with what you were
475+ ;; reading dimmed behind it. There is no behind on a phone worth
476+ ;; keeping: the screen is the width of the dialog already, so this is a
477+ ;; sheet — the title, a rule, and the body — drawn where the tree puts
478+ ;; it, above the conversation it was opened from.
479+ ;;
480+ ;; `:modal` and the hover pair are read and ignored. They are what a
481+ ;; pointer needs to tell a card it opened by resting from one it opened
482+ ;; by pressing, and a finger only ever presses.
483+ :dialog
484+ (m/Container
485+ .width double/infinity
486+ .margin (m/EdgeInsets.only .bottom t/space-xs)
487+ .padding (m/EdgeInsets.all t/space-xs)
488+ .decoration (m/BoxDecoration
489+ .color t/card
490+ .border (m/Border.all .color t/divider .width 1.0)
491+ .borderRadius (m/BorderRadius.circular t/radius-m))
492+ .child
493+ (col t/space-xxs
494+ (into [[:title-2 {:label (:label p "")}]
495+ [:separator {}]]
496+ (body node))))
497+
474498 :separator (m/Divider .height 1.0 .thickness 1.0 .color t/divider)
475499
476500 ;; A 16px indeterminate circle, with the label as a caption beside it.
@@ -569,17 +593,30 @@
569593 :emoji
570594 (m/Text (str (:emoji p "")) .style (m/TextStyle .fontSize (dbl (:size p) 16.0)))
571595
596+ ;; A face is a way in to who someone is, so it takes the press that
597+ ;; opens their profile. It was drawn without one and the chat screen's
598+ ;; `:on-click` went nowhere — the one gesture a phone has for this.
599+ ;; `:on-hover` and `:on-unhover` come with it on the desktop and are
600+ ;; nothing here.
572601 :avatar
573602 (let [s (dbl (:size p) 32.0)
574- src (:src p)]
575- (m/CircleAvatar
576- .radius (/ s 2.0)
577- .backgroundColor t/component
578- .backgroundImage (when (and src (not= "" src)) (m/NetworkImage src))
579- .child (when (or (nil? src) (= "" src))
580- (txt ctx (let [l (str (:label p ""))]
581- (if (pos? (count l)) (.toUpperCase (subs l 0 1)) "?"))
582- t/text-body t/on-bg))))
603+ src (:src p)
604+ face (m/CircleAvatar
605+ .radius (/ s 2.0)
606+ .backgroundColor t/component
607+ .backgroundImage (when (and src (not= "" src))
608+ (m/NetworkImage src))
609+ .child (when (or (nil? src) (= "" src))
610+ (txt ctx (let [l (str (:label p ""))]
611+ (if (pos? (count l))
612+ (.toUpperCase (subs l 0 1))
613+ "?"))
614+ t/text-body t/on-bg)))]
615+ (if-let [on (:on-click p)]
616+ (m/InkWell .onTap #(on)
617+ .customBorder (m/CircleBorder)
618+ .child face)
619+ face))
583620
584621 :image
585622 (let [src (or (:src p) (:path p))
@@ -471,6 +471,30 @@
471 .fontSize (* 0.85 size)471 .fontSize (* 0.85 size)
472 .color (if mine t/on-accent t/on-card)))]))))))472 .color (if mine t/on-accent t/on-card)))]))))))
473 473
474+ ;; libcosmic's dialog is centred over the window with what you were
475+ ;; reading dimmed behind it. There is no behind on a phone worth
476+ ;; keeping: the screen is the width of the dialog already, so this is a
477+ ;; sheet — the title, a rule, and the body — drawn where the tree puts
478+ ;; it, above the conversation it was opened from.
479+ ;;
480+ ;; `:modal` and the hover pair are read and ignored. They are what a
481+ ;; pointer needs to tell a card it opened by resting from one it opened
482+ ;; by pressing, and a finger only ever presses.
483+ :dialog
484+ (m/Container
485+ .width double/infinity
486+ .margin (m/EdgeInsets.only .bottom t/space-xs)
487+ .padding (m/EdgeInsets.all t/space-xs)
488+ .decoration (m/BoxDecoration
489+ .color t/card
490+ .border (m/Border.all .color t/divider .width 1.0)
491+ .borderRadius (m/BorderRadius.circular t/radius-m))
492+ .child
493+ (col t/space-xxs
494+ (into [[:title-2 {:label (:label p "")}]
495+ [:separator {}]]
496+ (body node))))
497+
474 :separator (m/Divider .height 1.0 .thickness 1.0 .color t/divider)498 :separator (m/Divider .height 1.0 .thickness 1.0 .color t/divider)
475 499
476 ;; A 16px indeterminate circle, with the label as a caption beside it.500 ;; A 16px indeterminate circle, with the label as a caption beside it.
@@ -569,17 +593,30 @@
569 :emoji593 :emoji
570 (m/Text (str (:emoji p "")) .style (m/TextStyle .fontSize (dbl (:size p) 16.0)))594 (m/Text (str (:emoji p "")) .style (m/TextStyle .fontSize (dbl (:size p) 16.0)))
571 595
596+ ;; A face is a way in to who someone is, so it takes the press that
597+ ;; opens their profile. It was drawn without one and the chat screen's
598+ ;; `:on-click` went nowhere — the one gesture a phone has for this.
599+ ;; `:on-hover` and `:on-unhover` come with it on the desktop and are
600+ ;; nothing here.
572 :avatar601 :avatar
573 (let [s (dbl (:size p) 32.0)602 (let [s (dbl (:size p) 32.0)
574- src (:src p)]603+ src (:src p)
575- (m/CircleAvatar604+ face (m/CircleAvatar
576- .radius (/ s 2.0)605+ .radius (/ s 2.0)
577- .backgroundColor t/component606+ .backgroundColor t/component
578- .backgroundImage (when (and src (not= "" src)) (m/NetworkImage src))607+ .backgroundImage (when (and src (not= "" src))
579- .child (when (or (nil? src) (= "" src))608+ (m/NetworkImage src))
580- (txt ctx (let [l (str (:label p ""))]609+ .child (when (or (nil? src) (= "" src))
581- (if (pos? (count l)) (.toUpperCase (subs l 0 1)) "?"))610+ (txt ctx (let [l (str (:label p ""))]
582- t/text-body t/on-bg))))611+ (if (pos? (count l))
612+ (.toUpperCase (subs l 0 1))
613+ "?"))
614+ t/text-body t/on-bg)))]
615+ (if-let [on (:on-click p)]
616+ (m/InkWell .onTap #(on)
617+ .customBorder (m/CircleBorder)
618+ .child face)
619+ face))
583 620
584 :image621 :image
585 (let [src (or (:src p) (:path p))622 (let [src (or (:src p) (:path p))
modified flutter/src/frq/main.cljd +36 -0
@@ -42,6 +42,7 @@
4242 [frq.members :as members]
4343 [frq.reactions :as reactions]
4444 [frq.edits :as edits]
45+ [frq.profile :as profile]
4546 [frq.irc.mutate :as mutate]
4647 [frq.oauth.core :as oauth]
4748 [frq.oauth.dart :as oauth-dart]
@@ -157,6 +158,11 @@
157158 {:from who
158159 :text text
159160 :did (:account m)
161+ ;; Who to look a profile up by: the DID the
162+ ;; server put on the line, or the nick when that
163+ ;; is handle-shaped. A guest has neither and gets
164+ ;; no lookup, which is the honest answer.
165+ :actor (profile/actor (:account m) who)
160166 :id (irc/tag-value tags "msgid")
161167 ;; The server canonicalises +draft/reply to
162168 ;; +reply; a client that sent the draft name may
@@ -563,6 +569,13 @@
563569 ;; same signature OpenSSL gives on the desktop, so a signature minted
564570 ;; here verifies the same way at the server.
565571 (crypto-dart/install!)
572+ ;; How this half asks the directory who someone is. `frq.profile` decides
573+ ;; when to ask and remembers the answer; only the awaiting is here.
574+ (profile/install-fetch!
575+ (fn [actor]
576+ (.then (atproto/fetch (profile/profile-req actor))
577+ (fn [body] (profile/deliver-profile! actor body) nil)
578+ .onError (fn [_ _] (profile/deliver-profile! actor nil) nil))))
566579 ;; Before any widget is built: a cell that changes before its watch is on
567580 ;; is a change the screen never hears about.
568581 (watch-cells!)
@@ -622,6 +635,29 @@
622635 ;; so there is nothing here to raise a card about.
623636 :hover-reaction! (fn [_ _] nil)
624637 :unhover-reaction! (fn [_ _] nil)
638+
639+ ;; Who someone is, behind the nick on a line. `frq.profile` holds the
640+ ;; cache and the fields; this is the tapping.
641+ :profile-open! profile/open!
642+ :profile-close! profile/close!
643+ :profile-dismiss! profile/close!
644+ :profile-entry profile/entry
645+ :profile-tick (fn [] @profile/tick)
646+ :profile-stats-line profile/stats-line
647+ :profile-truncate profile/truncate
648+ :profile-web-url profile/web-url
649+ :viewing (fn [] @profile/viewing)
650+ ;; The pointer half of a profile, which a phone does not have: there is
651+ ;; no hovering a face, no crossing from the face to the card, and so no
652+ ;; card to hold open while it happens.
653+ :hovering (fn [] nil)
654+ :profile-hover! (fn [_ _] nil)
655+ :profile-unhover! (fn [_] nil)
656+ :profile-enter-dialog! (fn [] nil)
657+ :profile-leave-dialog! (fn [] nil)
658+ ;; Their profile on the web, handed to the browser the same way the
659+ ;; sign-in link is.
660+ :open-url! (fn [url] (fio/open-url! url))
625661 :wide? (fn [] false)
626662 :desktop? (fn [] false)
627663 :mine? (fn [m] (rooms/mine? m (str @cells/form-nick)))
@@ -42,6 +42,7 @@
42 [frq.members :as members]42 [frq.members :as members]
43 [frq.reactions :as reactions]43 [frq.reactions :as reactions]
44 [frq.edits :as edits]44 [frq.edits :as edits]
45+ [frq.profile :as profile]
45 [frq.irc.mutate :as mutate]46 [frq.irc.mutate :as mutate]
46 [frq.oauth.core :as oauth]47 [frq.oauth.core :as oauth]
47 [frq.oauth.dart :as oauth-dart]48 [frq.oauth.dart :as oauth-dart]
@@ -157,6 +158,11 @@
157 {:from who158 {:from who
158 :text text159 :text text
159 :did (:account m)160 :did (:account m)
161+ ;; Who to look a profile up by: the DID the
162+ ;; server put on the line, or the nick when that
163+ ;; is handle-shaped. A guest has neither and gets
164+ ;; no lookup, which is the honest answer.
165+ :actor (profile/actor (:account m) who)
160 :id (irc/tag-value tags "msgid")166 :id (irc/tag-value tags "msgid")
161 ;; The server canonicalises +draft/reply to167 ;; The server canonicalises +draft/reply to
162 ;; +reply; a client that sent the draft name may168 ;; +reply; a client that sent the draft name may
@@ -563,6 +569,13 @@
563 ;; same signature OpenSSL gives on the desktop, so a signature minted569 ;; same signature OpenSSL gives on the desktop, so a signature minted
564 ;; here verifies the same way at the server.570 ;; here verifies the same way at the server.
565 (crypto-dart/install!)571 (crypto-dart/install!)
572+ ;; How this half asks the directory who someone is. `frq.profile` decides
573+ ;; when to ask and remembers the answer; only the awaiting is here.
574+ (profile/install-fetch!
575+ (fn [actor]
576+ (.then (atproto/fetch (profile/profile-req actor))
577+ (fn [body] (profile/deliver-profile! actor body) nil)
578+ .onError (fn [_ _] (profile/deliver-profile! actor nil) nil))))
566 ;; Before any widget is built: a cell that changes before its watch is on579 ;; Before any widget is built: a cell that changes before its watch is on
567 ;; is a change the screen never hears about.580 ;; is a change the screen never hears about.
568 (watch-cells!)581 (watch-cells!)
@@ -622,6 +635,29 @@
622 ;; so there is nothing here to raise a card about.635 ;; so there is nothing here to raise a card about.
623 :hover-reaction! (fn [_ _] nil)636 :hover-reaction! (fn [_ _] nil)
624 :unhover-reaction! (fn [_ _] nil)637 :unhover-reaction! (fn [_ _] nil)
638+
639+ ;; Who someone is, behind the nick on a line. `frq.profile` holds the
640+ ;; cache and the fields; this is the tapping.
641+ :profile-open! profile/open!
642+ :profile-close! profile/close!
643+ :profile-dismiss! profile/close!
644+ :profile-entry profile/entry
645+ :profile-tick (fn [] @profile/tick)
646+ :profile-stats-line profile/stats-line
647+ :profile-truncate profile/truncate
648+ :profile-web-url profile/web-url
649+ :viewing (fn [] @profile/viewing)
650+ ;; The pointer half of a profile, which a phone does not have: there is
651+ ;; no hovering a face, no crossing from the face to the card, and so no
652+ ;; card to hold open while it happens.
653+ :hovering (fn [] nil)
654+ :profile-hover! (fn [_ _] nil)
655+ :profile-unhover! (fn [_] nil)
656+ :profile-enter-dialog! (fn [] nil)
657+ :profile-leave-dialog! (fn [] nil)
658+ ;; Their profile on the web, handed to the browser the same way the
659+ ;; sign-in link is.
660+ :open-url! (fn [url] (fio/open-url! url))
625 :wide? (fn [] false)661 :wide? (fn [] false)
626 :desktop? (fn [] false)662 :desktop? (fn [] false)
627 :mine? (fn [m] (rooms/mine? m (str @cells/form-nick)))663 :mine? (fn [m] (rooms/mine? m (str @cells/form-nick)))
modified src/frq/app.clj +1 -1
@@ -25,7 +25,7 @@
2525 [frq.glyphs :as glyphs]
2626 [frq.media :as media]
2727 [frq.platform :as platform]
28- [frq.profile :as profile]
28+ [frq.profile.pointer :as profile]
2929 ;; The connect screen lives in common/ now — the same file the
3030 ;; phone renders. It reads frq.cells and calls frq.actions, and
3131 ;; this requires it exactly where its own copy used to be.
@@ -25,7 +25,7 @@
25 [frq.glyphs :as glyphs]25 [frq.glyphs :as glyphs]
26 [frq.media :as media]26 [frq.media :as media]
27 [frq.platform :as platform]27 [frq.platform :as platform]
28- [frq.profile :as profile]28+ [frq.profile.pointer :as profile]
29 ;; The connect screen lives in common/ now — the same file the29 ;; The connect screen lives in common/ now — the same file the
30 ;; phone renders. It reads frq.cells and calls frq.actions, and30 ;; phone renders. It reads frq.cells and calls frq.actions, and
31 ;; this requires it exactly where its own copy used to be.31 ;; this requires it exactly where its own copy used to be.
modified src/frq/avatars.clj +6 -20
@@ -10,33 +10,19 @@
1010 The thumbnail preset, and `@png` rather than the CDN's default: the tree
1111 backend decodes PNG, and 128×128 is what a 24-point avatar needs."
1212 (:require [clojure.string :as str]
13+ [frq.profile :as profile]
1314 [frq.atproto :as atproto]
1415 [jolt.host :as host]
1516 [jolt.mvn-http :as http]))
1617
1718 (def ^:private directory-host "public.api.bsky.app")
1819
19-;; A handle is a domain: labels joined by dots, ending in something alphabetic.
20-;; An IRC nick cannot be one by accident — `sleek5209` and `eve` are not.
21-(def ^:private handle-pattern #"(?i)^[a-z0-9][a-z0-9-]*(\.[a-z0-9][a-z0-9-]*)*\.[a-z]{2,}$")
20+(def handle?
21+ "Moved to `frq.profile`, which is what asks: whether a nick is worth looking
22+ a profile up by is the same question under either compiler."
23+ profile/handle?)
2224
23-(defn handle?
24- "Whether this nick is an AT Protocol handle, and so worth a lookup."
25- [nick]
26- (boolean (and nick (re-matches handle-pattern nick))))
27-
28-(defn actor
29- "The identity to look a profile up by, or nil when there is none.
30-
31- A DID from the message's `account` tag when the server sent one it is the
32- identity itself, and holds whatever the nick happens to be today. Otherwise
33- the nick, but only when it is handle-shaped: freeq gives an authenticated
34- user their handle by default, while `sleek5209` is a guest with no profile."
35- [did nick]
36- (cond
37- (and did (str/starts-with? did "did:")) did
38- (handle? nick) nick
39- :else nil))
25+(def actor profile/actor)
4026
4127 (defn cache-dir []
4228 (let [xdg (host/getenv "XDG_CACHE_HOME")
@@ -10,33 +10,19 @@
10 The thumbnail preset, and `@png` rather than the CDN's default: the tree10 The thumbnail preset, and `@png` rather than the CDN's default: the tree
11 backend decodes PNG, and 128×128 is what a 24-point avatar needs."11 backend decodes PNG, and 128×128 is what a 24-point avatar needs."
12 (:require [clojure.string :as str]12 (:require [clojure.string :as str]
13+ [frq.profile :as profile]
13 [frq.atproto :as atproto]14 [frq.atproto :as atproto]
14 [jolt.host :as host]15 [jolt.host :as host]
15 [jolt.mvn-http :as http]))16 [jolt.mvn-http :as http]))
16 17
17 (def ^:private directory-host "public.api.bsky.app")18 (def ^:private directory-host "public.api.bsky.app")
18 19
19-;; A handle is a domain: labels joined by dots, ending in something alphabetic.20+(def handle?
20-;; An IRC nick cannot be one by accident — `sleek5209` and `eve` are not.21+ "Moved to `frq.profile`, which is what asks: whether a nick is worth looking
21-(def ^:private handle-pattern #"(?i)^[a-z0-9][a-z0-9-]*(\.[a-z0-9][a-z0-9-]*)*\.[a-z]{2,}$")22+ a profile up by is the same question under either compiler."
23+ profile/handle?)
22 24
23-(defn handle?25+(def actor profile/actor)
24- "Whether this nick is an AT Protocol handle, and so worth a lookup."
25- [nick]
26- (boolean (and nick (re-matches handle-pattern nick))))
27-
28-(defn actor
29- "The identity to look a profile up by, or nil when there is none.
30-
31- A DID from the message's `account` tag when the server sent one it is the
32- identity itself, and holds whatever the nick happens to be today. Otherwise
33- the nick, but only when it is handle-shaped: freeq gives an authenticated
34- user their handle by default, while `sleek5209` is a guest with no profile."
35- [did nick]
36- (cond
37- (and did (str/starts-with? did "did:")) did
38- (handle? nick) nick
39- :else nil))
40 26
41 (defn cache-dir []27 (defn cache-dir []
42 (let [xdg (host/getenv "XDG_CACHE_HOME")28 (let [xdg (host/getenv "XDG_CACHE_HOME")
deleted src/frq/profile.clj +0 -188
deleted file mode 100644
@@ -1,188 +0,0 @@
1-(ns frq.profile
2- "Who someone is, behind the nick on a line.
3-
4- sleek's peer profile modal, as a screen. Tapping a name or a face in the
5- chat opens it: the picture at a size worth looking at, the display name and
6- handle, the DID, whatever bio and counts Bluesky holds, and a way through to
7- their profile on the web.
8-
9- One fetch per person, kept for the run — a profile is looked at repeatedly
10- and changes on nobody's timescale. Guests have no identity to fetch, so for
11- them the screen is the nick and a line saying so, which is the honest answer
12- rather than a spinner that never lands."
13- (:require [clojure.string :as str]
14- [glimmer.ratom :as r :refer [atom]]
15- [frq.atproto :as atproto]
16- [frq.avatars :as avatars]
17- [frq.platform :as platform]))
18-
19-(def ^:private directory-host "public.api.bsky.app")
20-
21-;; Who is being looked at, or nil — `{:nick :actor}`, where `actor` is the DID
22-;; or handle `frq.avatars/actor` worked out, and nil for a guest.
23-(defonce viewing (atom nil))
24-
25-;; actor -> {:status :loading | :ready | :failed, and the fields when ready}
26-(defonce ^:private cache (atom {}))
27-
28-;; Bumped when a fetch lands, so the screen re-renders without watching the
29-;; cache map itself — the same trick the chat view uses for pictures.
30-(defonce tick (atom 0))
31-
32-(defn- parse
33- "The fields the screen paints, out of an `app.bsky.actor.getProfile` body."
34- [body]
35- {:status :ready
36- :did (atproto/json-str body "did")
37- :handle (atproto/json-str body "handle")
38- :display-name (some-> (atproto/json-str body "displayName")
39- atproto/json-unescape
40- str/trim
41- not-empty)
42- :description (some-> (atproto/json-str body "description")
43- atproto/json-unescape
44- str/trim
45- not-empty)
46- :followers (atproto/json-num body "followersCount")
47- :follows (atproto/json-num body "followsCount")
48- :posts (atproto/json-num body "postsCount")})
49-
50-(defn entry
51- "What is known about this person right now, or nil before anything is."
52- [actor]
53- (get @cache actor))
54-
55-(defn fetch!
56- "Ensure this person's profile is on its way, in the background. Returns
57- without waiting; `entry` answers for it afterwards and `tick` says when that
58- answer has changed."
59- [actor]
60- (when (and (seq actor) (not (contains? @cache actor)))
61- (swap! cache assoc actor {:status :loading})
62- (future
63- (let [got (try
64- (let [body (atproto/request
65- directory-host
66- (str "/xrpc/app.bsky.actor.getProfile?actor=" actor)
67- nil)]
68- (when (atproto/json-str body "did")
69- (parse body)))
70- (catch Exception _ nil))]
71- (swap! cache assoc actor (or got {:status :failed}))
72- (swap! tick inc)))))
73-
74-(defn open!
75- "Look at someone. `actor` is their DID or handle, or nil for a guest."
76- [nick actor]
77- (reset! viewing {:nick nick :actor actor})
78- ;; The picture too: the chat asks for one when a line arrives, but this
79- ;; screen can be opened on someone whose avatar never landed, and it paints
80- ;; a bigger one than the column it was fetched for.
81- (when (seq actor) (avatars/fetch! actor #(swap! tick inc)))
82- (fetch! actor))
83-
84-(defn close! [] (reset! viewing nil))
85-
86-;; The face the pointer is resting on, or nil — `{:nick :actor}`, the same
87-;; shape as `viewing`. A card is painted for this one alone rather than hung
88-;; under every avatar in the column: the tree keeps whatever it is given, and
89-;; a channel's worth of unseen profile cards is a tree nobody looks at.
90-(defonce hovering (atom nil))
91-
92-(defn hover!
93- "The pointer has come to rest on someone's face. Starts the same two fetches
94- opening them would, so the card has something on it by the time it is read."
95- [nick actor]
96- (reset! hovering {:nick nick :actor actor})
97- (when (seq actor) (avatars/fetch! actor #(swap! tick inc)))
98- (fetch! actor))
99-
100-;; Whether the pointer is on the dialog the hover put up.
101-;;
102-;; This is what makes a hovered profile something you can move into and read
103-;; rather than something you can only glance at: the dialog reports its own
104-;; pointer, so leaving the face is not the end of the hover if the pointer
105-;; turned up here instead.
106-(defonce ^:private over-dialog? (atom false))
107-
108-(defn dismiss!
109- "Put the profile away, however it was opened.
110-
111- The dialog is shown for `viewing` or for `hovering`, so a Close that cleared
112- only the first left one the pointer had opened on screen with its own button
113- doing nothing to it."
114- []
115- (reset! viewing nil)
116- (reset! hovering nil)
117- ;; And the pointer's claim on it. Close takes the dialog out from under the
118- ;; pointer, so there is no leaving edge coming to say so — left set, it
119- ;; would hold the next hover open for good.
120- (reset! over-dialog? false))
121-
122-;; How long the pointer may be on neither the face nor the dialog before the
123-;; dialog goes.
124-;;
125-;; There is a gap between the two — the dialog is centred and the face is
126-;; wherever the message is — and a hover that ended the instant the pointer
127-;; left the face would close it halfway across every time. Long enough to
128-;; cross, short enough that a pointer moving somewhere else entirely does not
129-;; drag it along.
130-(def ^:private grace-ms 400)
131-
132-(defn- release!
133- "Let `nick`'s hover go, unless something has taken it up again.
134-
135- Three things can have happened in the grace period: the pointer arrived on
136- the dialog, it went back to the face, or it landed on someone else's. In all
137- three there is a hover to keep, and it is not this one's to end — which is
138- what the nick guard says."
139- [nick]
140- (when-not @over-dialog?
141- (swap! hovering #(when-not (= nick (:nick %)) %))))
142-
143-(defn unhover!
144- "The pointer has left `nick`'s face — which is not yet the end of it.
145-
146- Guarded by who is being left, so the leaving of one face cannot take down
147- the card of the next one: both edges arrive in the same frame when the
148- pointer crosses straight over."
149- [nick]
150- (platform/after! grace-ms #(release! nick)))
151-
152-(defn enter-dialog!
153- "The pointer is on the dialog. Whatever hover put it there is now this."
154- []
155- (reset! over-dialog? true))
156-
157-(defn leave-dialog!
158- "The pointer has left the dialog, and with it the last thing holding the
159- profile open — unless it went back to the face it came from."
160- []
161- (reset! over-dialog? false)
162- (let [nick (:nick @hovering)]
163- (platform/after! grace-ms #(release! nick))))
164-
165-(defn web-url
166- "Their profile on the web, by handle where there is one and DID otherwise."
167- [{:keys [handle did]}]
168- (let [who (or (not-empty (str/trim (or handle ""))) did)]
169- (when (seq who)
170- (str "https://bsky.app/profile/" (str/replace who #"^@" "")))))
171-
172-(defn stats-line
173- "\"12 followers · 34 following · 56 posts\", or nil when none are known."
174- [{:keys [followers follows posts]}]
175- (let [parts (cond-> []
176- followers (conj (str followers " followers"))
177- follows (conj (str follows " following"))
178- posts (conj (str posts " posts")))]
179- (when (seq parts) (str/join " · " parts))))
180-
181-(defn truncate
182- "A bio cut to `max` characters, keeping its line breaks — the height of a
183- multi-line bio is part of what it says."
184- [s max]
185- (let [t (str/trim (or s ""))]
186- (if (<= (count t) max)
187- t
188- (str (subs t 0 (dec max)) "…"))))
deleted file mode 100644
@@ -1,188 +0,0 @@
1-(ns frq.profile
2- "Who someone is, behind the nick on a line.
3-
4- sleek's peer profile modal, as a screen. Tapping a name or a face in the
5- chat opens it: the picture at a size worth looking at, the display name and
6- handle, the DID, whatever bio and counts Bluesky holds, and a way through to
7- their profile on the web.
8-
9- One fetch per person, kept for the run — a profile is looked at repeatedly
10- and changes on nobody's timescale. Guests have no identity to fetch, so for
11- them the screen is the nick and a line saying so, which is the honest answer
12- rather than a spinner that never lands."
13- (:require [clojure.string :as str]
14- [glimmer.ratom :as r :refer [atom]]
15- [frq.atproto :as atproto]
16- [frq.avatars :as avatars]
17- [frq.platform :as platform]))
18-
19-(def ^:private directory-host "public.api.bsky.app")
20-
21-;; Who is being looked at, or nil — `{:nick :actor}`, where `actor` is the DID
22-;; or handle `frq.avatars/actor` worked out, and nil for a guest.
23-(defonce viewing (atom nil))
24-
25-;; actor -> {:status :loading | :ready | :failed, and the fields when ready}
26-(defonce ^:private cache (atom {}))
27-
28-;; Bumped when a fetch lands, so the screen re-renders without watching the
29-;; cache map itself — the same trick the chat view uses for pictures.
30-(defonce tick (atom 0))
31-
32-(defn- parse
33- "The fields the screen paints, out of an `app.bsky.actor.getProfile` body."
34- [body]
35- {:status :ready
36- :did (atproto/json-str body "did")
37- :handle (atproto/json-str body "handle")
38- :display-name (some-> (atproto/json-str body "displayName")
39- atproto/json-unescape
40- str/trim
41- not-empty)
42- :description (some-> (atproto/json-str body "description")
43- atproto/json-unescape
44- str/trim
45- not-empty)
46- :followers (atproto/json-num body "followersCount")
47- :follows (atproto/json-num body "followsCount")
48- :posts (atproto/json-num body "postsCount")})
49-
50-(defn entry
51- "What is known about this person right now, or nil before anything is."
52- [actor]
53- (get @cache actor))
54-
55-(defn fetch!
56- "Ensure this person's profile is on its way, in the background. Returns
57- without waiting; `entry` answers for it afterwards and `tick` says when that
58- answer has changed."
59- [actor]
60- (when (and (seq actor) (not (contains? @cache actor)))
61- (swap! cache assoc actor {:status :loading})
62- (future
63- (let [got (try
64- (let [body (atproto/request
65- directory-host
66- (str "/xrpc/app.bsky.actor.getProfile?actor=" actor)
67- nil)]
68- (when (atproto/json-str body "did")
69- (parse body)))
70- (catch Exception _ nil))]
71- (swap! cache assoc actor (or got {:status :failed}))
72- (swap! tick inc)))))
73-
74-(defn open!
75- "Look at someone. `actor` is their DID or handle, or nil for a guest."
76- [nick actor]
77- (reset! viewing {:nick nick :actor actor})
78- ;; The picture too: the chat asks for one when a line arrives, but this
79- ;; screen can be opened on someone whose avatar never landed, and it paints
80- ;; a bigger one than the column it was fetched for.
81- (when (seq actor) (avatars/fetch! actor #(swap! tick inc)))
82- (fetch! actor))
83-
84-(defn close! [] (reset! viewing nil))
85-
86-;; The face the pointer is resting on, or nil — `{:nick :actor}`, the same
87-;; shape as `viewing`. A card is painted for this one alone rather than hung
88-;; under every avatar in the column: the tree keeps whatever it is given, and
89-;; a channel's worth of unseen profile cards is a tree nobody looks at.
90-(defonce hovering (atom nil))
91-
92-(defn hover!
93- "The pointer has come to rest on someone's face. Starts the same two fetches
94- opening them would, so the card has something on it by the time it is read."
95- [nick actor]
96- (reset! hovering {:nick nick :actor actor})
97- (when (seq actor) (avatars/fetch! actor #(swap! tick inc)))
98- (fetch! actor))
99-
100-;; Whether the pointer is on the dialog the hover put up.
101-;;
102-;; This is what makes a hovered profile something you can move into and read
103-;; rather than something you can only glance at: the dialog reports its own
104-;; pointer, so leaving the face is not the end of the hover if the pointer
105-;; turned up here instead.
106-(defonce ^:private over-dialog? (atom false))
107-
108-(defn dismiss!
109- "Put the profile away, however it was opened.
110-
111- The dialog is shown for `viewing` or for `hovering`, so a Close that cleared
112- only the first left one the pointer had opened on screen with its own button
113- doing nothing to it."
114- []
115- (reset! viewing nil)
116- (reset! hovering nil)
117- ;; And the pointer's claim on it. Close takes the dialog out from under the
118- ;; pointer, so there is no leaving edge coming to say so — left set, it
119- ;; would hold the next hover open for good.
120- (reset! over-dialog? false))
121-
122-;; How long the pointer may be on neither the face nor the dialog before the
123-;; dialog goes.
124-;;
125-;; There is a gap between the two — the dialog is centred and the face is
126-;; wherever the message is — and a hover that ended the instant the pointer
127-;; left the face would close it halfway across every time. Long enough to
128-;; cross, short enough that a pointer moving somewhere else entirely does not
129-;; drag it along.
130-(def ^:private grace-ms 400)
131-
132-(defn- release!
133- "Let `nick`'s hover go, unless something has taken it up again.
134-
135- Three things can have happened in the grace period: the pointer arrived on
136- the dialog, it went back to the face, or it landed on someone else's. In all
137- three there is a hover to keep, and it is not this one's to end — which is
138- what the nick guard says."
139- [nick]
140- (when-not @over-dialog?
141- (swap! hovering #(when-not (= nick (:nick %)) %))))
142-
143-(defn unhover!
144- "The pointer has left `nick`'s face — which is not yet the end of it.
145-
146- Guarded by who is being left, so the leaving of one face cannot take down
147- the card of the next one: both edges arrive in the same frame when the
148- pointer crosses straight over."
149- [nick]
150- (platform/after! grace-ms #(release! nick)))
151-
152-(defn enter-dialog!
153- "The pointer is on the dialog. Whatever hover put it there is now this."
154- []
155- (reset! over-dialog? true))
156-
157-(defn leave-dialog!
158- "The pointer has left the dialog, and with it the last thing holding the
159- profile open — unless it went back to the face it came from."
160- []
161- (reset! over-dialog? false)
162- (let [nick (:nick @hovering)]
163- (platform/after! grace-ms #(release! nick))))
164-
165-(defn web-url
166- "Their profile on the web, by handle where there is one and DID otherwise."
167- [{:keys [handle did]}]
168- (let [who (or (not-empty (str/trim (or handle ""))) did)]
169- (when (seq who)
170- (str "https://bsky.app/profile/" (str/replace who #"^@" "")))))
171-
172-(defn stats-line
173- "\"12 followers · 34 following · 56 posts\", or nil when none are known."
174- [{:keys [followers follows posts]}]
175- (let [parts (cond-> []
176- followers (conj (str followers " followers"))
177- follows (conj (str follows " following"))
178- posts (conj (str posts " posts")))]
179- (when (seq parts) (str/join " · " parts))))
180-
181-(defn truncate
182- "A bio cut to `max` characters, keeping its line breaks — the height of a
183- multi-line bio is part of what it says."
184- [s max]
185- (let [t (str/trim (or s ""))]
186- (if (<= (count t) max)
187- t
188- (str (subs t 0 (dec max)) "…"))))
added src/frq/profile/pointer.clj +122 -0
new file mode 100644
@@ -0,0 +1,122 @@
1+(ns frq.profile.pointer
2+ "What a pointer does about a profile, and how this half fetches one.
3+
4+ `frq.profile` under common/ is what a profile *is* — the cache, the fields,
5+ the URL, the counts — and both halves share it. This is the rest, and it is
6+ all desktop by nature: hovering a face, the grace period for crossing from
7+ the face to the card, and the card reporting its own pointer so moving into
8+ it is not the same as leaving. A phone has none of those; a finger is either
9+ on a name or not on it.
10+
11+ The fetch lives here too, because a `future` and a blocking request is this
12+ backend's answer to a question the other one answers by awaiting."
13+ (:require [frq.atproto :as atproto]
14+ [frq.avatars :as avatars]
15+ [frq.platform :as platform]
16+ [frq.profile :as profile]))
17+
18+;; The shared names, re-exported so callers did not move.
19+(def viewing profile/viewing)
20+(def hovering profile/hovering)
21+(def tick profile/tick)
22+(def entry profile/entry)
23+(def close! profile/close!)
24+(def web-url profile/web-url)
25+(def stats-line profile/stats-line)
26+(def truncate profile/truncate)
27+
28+(profile/install-fetch!
29+ (fn [actor]
30+ (future
31+ (profile/deliver-profile!
32+ actor
33+ (try
34+ (let [{:keys [host path]} (profile/profile-req actor)]
35+ (atproto/request host path nil))
36+ (catch Exception _ nil))))))
37+
38+(defn- with-avatar!
39+ "The picture too. The chat asks for one when a line arrives, but a profile
40+ can be opened on someone whose avatar never landed, and it paints a bigger
41+ one than the column it was fetched for."
42+ [actor]
43+ (when (seq actor) (avatars/fetch! actor #(swap! tick inc))))
44+
45+(defn open!
46+ "Look at someone. `actor` is their DID or handle, or nil for a guest."
47+ [nick actor]
48+ (with-avatar! actor)
49+ (profile/open! nick actor))
50+
51+;; Whether the pointer is on the dialog the hover put up.
52+;;
53+;; This is what makes a hovered profile something you can move into and read
54+;; rather than something you can only glance at: the dialog reports its own
55+;; pointer, so leaving the face is not the end of the hover if the pointer
56+;; turned up here instead.
57+(defonce ^:private over-dialog? (atom false))
58+
59+(defn hover!
60+ "The pointer has come to rest on someone's face. Starts the same two fetches
61+ opening them would, so the card has something on it by the time it is read."
62+ [nick actor]
63+ (reset! hovering {:nick nick :actor actor})
64+ (with-avatar! actor)
65+ (profile/fetch! actor))
66+
67+(defn dismiss!
68+ "Put the profile away, however it was opened.
69+
70+ The dialog is shown for `viewing` or for `hovering`, so a Close that cleared
71+ only the first left one the pointer had opened on screen with its own button
72+ doing nothing to it."
73+ []
74+ (reset! viewing nil)
75+ (reset! hovering nil)
76+ ;; And the pointer's claim on it. Close takes the dialog out from under the
77+ ;; pointer, so there is no leaving edge coming to say so — left set, it
78+ ;; would hold the next hover open for good.
79+ (reset! over-dialog? false))
80+
81+;; How long the pointer may be on neither the face nor the dialog before the
82+;; dialog goes.
83+;;
84+;; There is a gap between the two — the dialog is centred and the face is
85+;; wherever the message is — and a hover that ended the instant the pointer
86+;; left the face would close it halfway across every time. Long enough to
87+;; cross, short enough that a pointer moving somewhere else entirely does not
88+;; drag it along.
89+(def ^:private grace-ms 400)
90+
91+(defn- release!
92+ "Let `nick`'s hover go, unless something has taken it up again.
93+
94+ Three things can have happened in the grace period: the pointer arrived on
95+ the dialog, it went back to the face, or it landed on someone else's. In all
96+ three there is a hover to keep, and it is not this one's to end — which is
97+ what the nick guard says."
98+ [nick]
99+ (when-not @over-dialog?
100+ (swap! hovering #(when-not (= nick (:nick %)) %))))
101+
102+(defn unhover!
103+ "The pointer has left `nick`'s face — which is not yet the end of it.
104+
105+ Guarded by who is being left, so the leaving of one face cannot take down
106+ the card of the next one: both edges arrive in the same frame when the
107+ pointer crosses straight over."
108+ [nick]
109+ (platform/after! grace-ms #(release! nick)))
110+
111+(defn enter-dialog!
112+ "The pointer is on the dialog. Whatever hover put it there is now this."
113+ []
114+ (reset! over-dialog? true))
115+
116+(defn leave-dialog!
117+ "The pointer has left the dialog, and with it the last thing holding the
118+ profile open — unless it went back to the face it came from."
119+ []
120+ (reset! over-dialog? false)
121+ (let [nick (:nick @hovering)]
122+ (platform/after! grace-ms #(release! nick))))
new file mode 100644
@@ -0,0 +1,122 @@
1+(ns frq.profile.pointer
2+ "What a pointer does about a profile, and how this half fetches one.
3+
4+ `frq.profile` under common/ is what a profile *is* — the cache, the fields,
5+ the URL, the counts — and both halves share it. This is the rest, and it is
6+ all desktop by nature: hovering a face, the grace period for crossing from
7+ the face to the card, and the card reporting its own pointer so moving into
8+ it is not the same as leaving. A phone has none of those; a finger is either
9+ on a name or not on it.
10+
11+ The fetch lives here too, because a `future` and a blocking request is this
12+ backend's answer to a question the other one answers by awaiting."
13+ (:require [frq.atproto :as atproto]
14+ [frq.avatars :as avatars]
15+ [frq.platform :as platform]
16+ [frq.profile :as profile]))
17+
18+;; The shared names, re-exported so callers did not move.
19+(def viewing profile/viewing)
20+(def hovering profile/hovering)
21+(def tick profile/tick)
22+(def entry profile/entry)
23+(def close! profile/close!)
24+(def web-url profile/web-url)
25+(def stats-line profile/stats-line)
26+(def truncate profile/truncate)
27+
28+(profile/install-fetch!
29+ (fn [actor]
30+ (future
31+ (profile/deliver-profile!
32+ actor
33+ (try
34+ (let [{:keys [host path]} (profile/profile-req actor)]
35+ (atproto/request host path nil))
36+ (catch Exception _ nil))))))
37+
38+(defn- with-avatar!
39+ "The picture too. The chat asks for one when a line arrives, but a profile
40+ can be opened on someone whose avatar never landed, and it paints a bigger
41+ one than the column it was fetched for."
42+ [actor]
43+ (when (seq actor) (avatars/fetch! actor #(swap! tick inc))))
44+
45+(defn open!
46+ "Look at someone. `actor` is their DID or handle, or nil for a guest."
47+ [nick actor]
48+ (with-avatar! actor)
49+ (profile/open! nick actor))
50+
51+;; Whether the pointer is on the dialog the hover put up.
52+;;
53+;; This is what makes a hovered profile something you can move into and read
54+;; rather than something you can only glance at: the dialog reports its own
55+;; pointer, so leaving the face is not the end of the hover if the pointer
56+;; turned up here instead.
57+(defonce ^:private over-dialog? (atom false))
58+
59+(defn hover!
60+ "The pointer has come to rest on someone's face. Starts the same two fetches
61+ opening them would, so the card has something on it by the time it is read."
62+ [nick actor]
63+ (reset! hovering {:nick nick :actor actor})
64+ (with-avatar! actor)
65+ (profile/fetch! actor))
66+
67+(defn dismiss!
68+ "Put the profile away, however it was opened.
69+
70+ The dialog is shown for `viewing` or for `hovering`, so a Close that cleared
71+ only the first left one the pointer had opened on screen with its own button
72+ doing nothing to it."
73+ []
74+ (reset! viewing nil)
75+ (reset! hovering nil)
76+ ;; And the pointer's claim on it. Close takes the dialog out from under the
77+ ;; pointer, so there is no leaving edge coming to say so — left set, it
78+ ;; would hold the next hover open for good.
79+ (reset! over-dialog? false))
80+
81+;; How long the pointer may be on neither the face nor the dialog before the
82+;; dialog goes.
83+;;
84+;; There is a gap between the two — the dialog is centred and the face is
85+;; wherever the message is — and a hover that ended the instant the pointer
86+;; left the face would close it halfway across every time. Long enough to
87+;; cross, short enough that a pointer moving somewhere else entirely does not
88+;; drag it along.
89+(def ^:private grace-ms 400)
90+
91+(defn- release!
92+ "Let `nick`'s hover go, unless something has taken it up again.
93+
94+ Three things can have happened in the grace period: the pointer arrived on
95+ the dialog, it went back to the face, or it landed on someone else's. In all
96+ three there is a hover to keep, and it is not this one's to end — which is
97+ what the nick guard says."
98+ [nick]
99+ (when-not @over-dialog?
100+ (swap! hovering #(when-not (= nick (:nick %)) %))))
101+
102+(defn unhover!
103+ "The pointer has left `nick`'s face — which is not yet the end of it.
104+
105+ Guarded by who is being left, so the leaving of one face cannot take down
106+ the card of the next one: both edges arrive in the same frame when the
107+ pointer crosses straight over."
108+ [nick]
109+ (platform/after! grace-ms #(release! nick)))
110+
111+(defn enter-dialog!
112+ "The pointer is on the dialog. Whatever hover put it there is now this."
113+ []
114+ (reset! over-dialog? true))
115+
116+(defn leave-dialog!
117+ "The pointer has left the dialog, and with it the last thing holding the
118+ profile open — unless it went back to the face it came from."
119+ []
120+ (reset! over-dialog? false)
121+ (let [nick (:nick @hovering)]
122+ (platform/after! grace-ms #(release! nick))))