1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
|
(ns frq.state
"Every cell the UI reads, and the reducers that write them.
glimmer components re-render from ratoms, so the whole app state is a handful
of `atom`s here; the IRC reader thread pushes into the same ones. `apply-msg!`
is the only place a wire message turns into UI state."
(:require [clojure.string :as str]
[glimmer.ratom :as r :refer [atom]]
[jolt.host :as host]
[frq.atproto :as atproto]
[frq.av :as av]
[frq.clock :as clock]
[frq.emoji :as emoji]
[frq.irc :as irc]
[frq.msgsig :as msgsig]
[frq.avatars :as avatars]
[frq.media :as media]
[frq.oauth :as oauth]
[frq.store :as store]
[frq.upload :as upload]
[glimmer-vidya.core :as vidya]))
(def default-host "irc.freeq.at")
(def default-port "6697")
(def popular-channels
[["#general" "General discussion"]
["#test" "Test channel"]
["#freeq" "freeq development & support"]
["#dev" "Programming & technology"]
["#music" "Music recommendations"]
["#random" "Off-topic chat"]])
;; screen: :connect | :chats | :chat | :discover | :settings
(defonce screen (atom :connect))
(defonce conn (atom nil))
(defonce status (atom "Not connected"))
(defonce error (atom nil))
(defonce connecting? (atom false))
(defonce form-host (atom default-host))
(defonce form-port (atom default-port))
;; TLS is the default; untick it for a server's plain :6667 listener
(defonce form-tls? (atom true))
(defonce form-nick (atom "frq-guest"))
;; Bluesky sign-in. The app password reaches the user's own PDS and nothing
;; else: freeq is handed the session token it mints, and verifies that token by
;; asking the same PDS. It is never written to disk.
(defonce auth-mode (atom :guest)) ; :guest | :bluesky | :app-password
(defonce form-handle (atom ""))
(defonce form-app-password (atom ""))
(defonce session (atom nil)) ; a pds-session or a web-token one
;; The durable half of an OAuth sign-in. The web-token beside it is single-use,
;; so a reconnect mints a fresh one from this rather than replaying the old.
(defonce broker-token (atom nil))
(defonce login-url (atom nil)) ; shown while the browser is open
;; joined as soon as the server sends 001
(def auto-join "#test")
;; How much backlog to ask for when the server did not volunteer any.
(def history-limit 100)
;; name -> {:name :messages [{:from :text}] :unread n :joined? bool}
(defonce channels (atom {}))
(defonce current (atom nil))
(defonce draft (atom ""))
;; The message the draft is answering, as {:id :from :text}, or nil. Held whole
;; rather than as an id alone so the compose bar can say who is being answered
;; without going looking for them.
(defonce replying-to (atom nil))
(defn reply-to! [m] (reset! replying-to (select-keys m [:id :from :text])))
(defn cancel-reply! [] (reset! replying-to nil))
;; The message the draft is a rewrite of, as `{:channel :id}`, or nil when the
;; box is being used for something new. Only the id is kept: what is being
;; rewritten is in the box, and the line on screen is the thing it will replace.
(defonce editing (atom nil))
;; The message the emoji picker is choosing for, as `{:channel :id}`, or nil
;; when it is closed. The picker is a panel over the compose bar rather than a
;; screen: what is being reacted to has to stay in sight.
(defonce reacting (atom nil))
;; What the picker is showing: the search box, and which group is on screen
;; when nothing has been typed. `nil` is the popular row it opens on.
(defonce emoji-search (atom ""))
(defonce emoji-group (atom nil))
;; The picture being looked at full size, or nil. Vidya's tree has no overlay,
;; so this is a screen of its own rather than a layer over the chat.
(defonce lightbox (atom nil)) ; {:path :url}
(defonce join-input (atom ""))
;; Whether the chat screen is showing who is in the channel. Off by default:
;; the panel costs the conversation a column, and the reader is here for the
;; conversation.
(defonce show-users? (atom false))
(defn toggle-users! [] (swap! show-users? not))
;; The window's content width in points, polled from the backend a few times a
;; second. The app is laid out for a phone-width window, and this is what lets
;; a wide one be more than a phone with margins: past `wide-width` the channel
;; list and the conversation are both on screen instead of taking turns.
(defonce window-width (atom 0))
;; The window's content height, polled beside the width and for the same
;; reason. What it is for is the pictures in the conversation: a preview sized
;; against the window is a picture on a laptop and a thumbnail on a phone,
;; where one fixed height is only ever right on one of them.
(defonce window-height (atom 0))
;; Where the second pane starts paying for itself. Below this a 300pt list
;; beside a conversation leaves the messages narrower than the phone layout
;; they were written for.
(def wide-width 900)
(defn wide?
"True while the window has room for the list and a conversation at once."
[]
(>= @window-width wide-width))
(defn chat-visible?
"Whether the conversation in `current` is on screen.
On a narrow window that is the chat screen alone. On a wide one the chats
screen shows it too, in the pane beside the list — so this, and not the
screen, is what decides whether an arriving line counts as unread."
[]
(or (= :chat @screen)
(and (wide?) (= :chats @screen))))
;; Whether the chat view is showing the newest line, and a counter the view
;; watches to be told to go back to it. A counter rather than a flag: a flag
;; would need clearing, and there is no frame in which to clear it.
(defonce at-present? (atom true))
(defonce jump-tick (atom 0))
(defn jump-to-present! [] (swap! jump-tick inc))
;; A counter rather than a clock: the list only needs their order, and a
;; monotonic tick cannot be surprised by the system time moving.
(defonce access-tick (atom 0))
(defonce search (atom ""))
;; Comings and goings, hidden or not. A quiet room reads better with them —
;; they are how you notice someone arriving — and a busy one drowns in them,
;; so it is the reader's call. Only other people's: your own "Joined #chan" is
;; the answer to something you just did.
(defonce hide-join-part? (atom false))
(defn- save-prefs! []
(future (store/save-prefs! (assoc (store/load-prefs)
:hide-join-part? @hide-join-part?))))
(defn toggle-hide-join-part! []
(swap! hide-join-part? not)
(save-prefs!))
(defn restore-prefs!
"Bring back the saved settings at startup."
[]
(let [prefs (store/load-prefs)]
(reset! hide-join-part? (boolean (:hide-join-part? prefs)))
prefs))
(defn connected? [] (some? @conn))
(declare channel-order request-names!)
(defn- remember-channels!
"Write the order out. Off the caller's thread: opening a channel should not
wait on a file, and the order it records is read from the same atom either
way."
[]
(future (store/save-channels! (channel-order))))
(defn dm?
"Whether a buffer is a conversation with a person rather than a room. Every
channel name starts with `#`; what does not is somebody's nick."
[name]
(and (seq name) (not (str/starts-with? name "#"))))
(defn normalize-channel [s]
(let [s (str/trim (or s ""))]
(cond (str/blank? s) ""
(str/starts-with? s "#") s
:else (str "#" s))))
(defn- ensure-channel [m name]
(if (contains? m name)
m
(assoc m name {:name name :messages [] :unread 0
:joined? false :joining? false :accessed 0
;; nick -> mode prefix, for the people panel
:users {}})))
(defonce ^{:doc "Bumped whenever a fetched image becomes available, so the
chat view re-renders without every message row watching the media cache."}
media-tick (atom 0))
(defn push-message!
"Append a line to a buffer, creating it if needed, and bump the unread count
unless that buffer is the one on screen. Any image it links to is fetched in
the background, as is the sender's avatar.
The extras are what the message carried beyond its text: `:at` when it was
said, from the server's own `time` tag where there is one, and `:did` who
said it, from the `account` tag — an identity that outlasts whatever nick
they are using today. `:id` names this message so a reply can point at it,
and `:reply-to` is the one it answers. `:reactions` is what people have put
on it already, which on a replayed backlog the server hands over in full."
([channel from text] (push-message! channel from text {}))
([channel from text {:keys [at did id reply-to reactions edited?]}]
(let [at (or at (clock/now-ms))
who (avatars/actor did from)]
(doseq [url (media/image-urls text)]
(media/fetch! url #(swap! media-tick inc)))
;; The same tick: an avatar arriving is a picture arriving, and the chat
;; view already repaints on it.
(when who (avatars/fetch! who #(swap! media-tick inc)))
(swap! channels
(fn [m]
(let [m (ensure-channel m channel)
viewing? (and (chat-visible?) (= channel @current))
;; The server hands the same message over more than once: a
;; JOIN replays the backlog, the CHATHISTORY we ask for
;; replays it again, and a line can have arrived live before
;; either. The msgid is the message's identity and it
;; survives every revision, so holding the copy we have is
;; what keeps a rejoin from doubling the buffer — and what
;; keeps a replayed *pre-edit* row from landing under a line
;; already showing the current text.
seen? (and id (some #(= id (:id %))
(get-in m [channel :messages])))]
(cond
;; The copy we already hold is the pre-edit one, and this is
;; the server's collapsed row saying so. Same message, later
;; word: take the text rather than the arrival order.
(and seen? edited?)
(assoc-in m [channel :messages]
(mapv (fn [msg]
(if (= id (:id msg))
(assoc msg :text text :edited? true
:images (media/image-urls text))
msg))
(get-in m [channel :messages])))
seen? m
:else
(-> m
(update-in [channel :messages] conj
{:from from :text text :system? (= "*" from)
:actor who
:images (media/image-urls text)
:at at
;; `:id` is what a reply points at, and
;; `:reply-to` is what this one points at.
:id id :reply-to reply-to
;; The sender has since rewritten this line.
;; Replay says so with a tag rather than by
;; sending the revision, so a message can
;; arrive already edited.
:edited? (boolean edited?)
;; emoji -> the nicks who put it there
:reactions (or reactions {})})
(update-in [channel :unread]
(if viewing? (constantly 0) inc))))))))))
(defn open-channel!
"Show a buffer. A channel we are not in is joined on the way — a row can
outlive the membership behind it (a disconnect drops every channel, the
buffer stays), and opening one is a request to be in it."
[name]
(reset! current name)
;; On a wide window the conversation lives in the chats screen's second
;; pane, beside the list; :chat is the narrow window's way of showing it
;; instead of the list, and there is nothing there to trade it for.
(reset! screen (if (wide?) :chats :chat))
;; A picker belongs to the message it was opened on; carrying it into another
;; buffer would offer to react to something that is no longer on screen.
(reset! reacting nil)
;; And an edit belongs to a line in the buffer being left: carried across, the
;; next Send would rewrite a message nobody in this room can see.
(when (and @editing (not= name (:channel @editing)))
(reset! editing nil)
(reset! draft ""))
(swap! channels #(-> (ensure-channel % name)
(assoc-in [name :unread] 0)
(assoc-in [name :accessed] (swap! access-tick inc))))
(remember-channels!)
;; `joining?` as well as `joined?`: the JOIN echo takes a round trip, and a
;; second JOIN sent in the meantime is what makes the server replay nothing.
(let [buffer (get @channels name)]
(when (and @conn
(str/starts-with? name "#")
(not (:joined? buffer))
(not (:joining? buffer)))
(swap! channels #(assoc-in % [name :joining?] true))
(irc/join! @conn name)))
;; Already in it, and nobody listed: the membership survived a restart the
;; NAMES that came with it did not.
(when (:joined? (get @channels name))
(request-names! name)))
(defn- parse-reactions
"The server's tally of what is already on a message, as
`emoji:nick,nick;emoji:nick` — what CHATHISTORY sends so reactions survive a
reconnect rather than starting empty every time the app opens."
[encoded]
(when (seq (or encoded ""))
(reduce (fn [acc part]
(let [[emoji nicks] (str/split part #":" 2)]
(if (and (seq emoji) (seq (or nicks "")))
(assoc acc emoji (vec (remove str/blank? (str/split nicks #","))))
acc)))
{}
(str/split encoded #";"))))
(defn- with-reaction
"One nick's reaction added to or taken off a tally. An emoji nobody is left
on goes away with them: an empty pill is a pill that says nothing."
[reactions emoji nick on?]
(let [nicks (vec (get reactions emoji []))
nicks (if on?
(if (some #{nick} nicks) nicks (conj nicks nick))
(vec (remove #{nick} nicks)))]
(if (seq nicks)
(assoc reactions emoji nicks)
(dissoc reactions emoji))))
(defn update-reaction!
"Fold one reaction into the buffer it belongs to. The message it names may
not be there — a reaction on something older than the backlog we asked for —
and then there is nothing to show it on, so nothing happens."
[channel msgid emoji nick on?]
(when (and channel msgid (seq (or emoji "")))
(swap! channels
(fn [m]
(if-let [msgs (get-in m [channel :messages])]
(assoc-in m [channel :messages]
(mapv (fn [msg]
(if (= msgid (:id msg))
(update msg :reactions with-reaction emoji nick on?)
msg))
msgs))
m)))))
(defn edit-message!
"Rewrite a message in place, and say so. `msgid` names the line as it was
first sent: a message keeps the id it was born with across every revision,
which is what keeps its reactions, replies and pins attached to it.
Only the sender may rewrite their own line, so an edit whose nick is not the
one on the message is dropped — the server checks authorship too, and a
client that believed the wire alone would let a hostile relay put words in
somebody's mouth.
Answers what became of it: `:applied`, `:refused` for one that was not the
sender's to make, or `:absent` when no line here has that id — an edit of
something older than the backlog we asked for, which is the one case the
caller shows as a line of its own rather than losing what it says."
[channel msgid from text]
(if-not (and channel msgid)
:absent
(let [found? (atom nil)]
(swap! channels
(fn [m]
(if-let [msgs (get-in m [channel :messages])]
(assoc-in m [channel :messages]
(mapv (fn [msg]
(if (= msgid (:id msg))
(if (= (str/lower-case (or (:from msg) ""))
(str/lower-case (or from "")))
(do (reset! found? :applied)
(assoc msg
:text text
:images (media/image-urls text)
:edited? true))
;; Somebody else's line. The server
;; refuses this too, so it is either a
;; peer talking to us directly or one
;; lying — and neither gets to put words
;; under a name that is not theirs.
(do (reset! found? :refused) msg))
msg))
msgs))
m)))
;; The revision may link a picture the original did not.
(when (= :applied @found?)
(doseq [url (media/image-urls text)]
(media/fetch! url #(swap! media-tick inc))))
(or @found? :absent))))
;; --- who is in the room ------------------------------------------------------
;; A channel's `:users` is nick -> mode prefix ("@", "+", or ""). The list is
;; the server's: NAMES on the way in, and every JOIN, PART, QUIT, KICK and NICK
;; after it. Nothing here asks who is there — being told is what membership is.
(def ^:private mode-prefixes
"The characters a server puts in front of a nick in NAMES, and in the same
order the panel sorts them: owner, admin, op, half-op, voice."
"~&@%+")
(defn- split-prefix
"One NAMES entry into `[prefix nick]`. A nick never starts with one of these,
so what is in front of it is a mode and not part of the name."
[entry]
(if (and (seq entry) (str/index-of mode-prefixes (subs entry 0 1)))
[(subs entry 0 1) (subs entry 1)]
["" entry]))
(defn- names-line
"Fold one 353 into the channel's pending list. Pending rather than live: the
reply comes in as many lines as it takes and ends with 366, and replacing
`:users` on each of them would empty the panel and refill it a name at a
time."
[channel names]
(swap! channels
(fn [m]
(reduce (fn [m entry]
(let [[prefix nick] (split-prefix entry)]
(assoc-in m [channel :names-acc nick] prefix)))
(ensure-channel m channel)
(remove str/blank? (str/split (or names "") #" "))))))
(defn- names-end!
"366: the pending list becomes the list."
[channel]
(swap! channels
(fn [m]
(if-let [acc (get-in m [channel :names-acc])]
(-> m (assoc-in [channel :users] acc)
(update channel dissoc :names-acc))
m))))
(defn- add-user! [channel nick]
(when (and channel nick)
(swap! channels #(-> (ensure-channel % channel)
(update-in [channel :users] (fnil assoc {}) nick "")))))
(defn- remove-user! [channel nick]
(when (and channel nick)
(swap! channels #(update-in % [channel :users] dissoc nick))))
(defn- remove-user-everywhere!
"A QUIT names no channel — the person left the server, so they left every
room this client is watching them in."
[nick]
(swap! channels
(fn [m]
(reduce-kv (fn [m k v] (assoc m k (update v :users dissoc nick)))
{} m))))
(defn- rename-user!
"A NICK, in every channel the old name was in. Their modes come with them:
renaming is not leaving."
[old new]
(swap! channels
(fn [m]
(reduce-kv (fn [m k v]
(assoc m k
(if-let [prefix (get (:users v) old)]
(update v :users #(-> % (dissoc old) (assoc new prefix)))
v)))
{} m))))
(defn- apply-mode!
"A channel MODE, for the letters that change how someone is listed. `params`
is the mode string and whoever it was applied to, in order; anything else in
it — a key, a limit, a ban — names no member and is skipped."
[channel modes args]
(let [letters {\q "~" \a "&" \o "@" \h "%" \v "+"}]
(loop [chars (seq modes) args args adding? true]
(when-let [c (first chars)]
(case c
\+ (recur (rest chars) args true)
\- (recur (rest chars) args false)
(if-let [prefix (letters c)]
(do (when-let [nick (first args)]
(swap! channels
(fn [m]
(if (get-in m [channel :users nick])
(assoc-in m [channel :users nick] (if adding? prefix ""))
m))))
(recur (rest chars) (rest args) adding?))
;; A mode that takes an argument without naming a member still eats
;; one, and reading the next letter's nick out of the wrong place
;; would put a mode on a stranger. Only the setting form takes one.
(recur (rest chars) (if adding? (rest args) args) adding?)))))))
(def ^:private prefix-rank
(into {"" (count mode-prefixes)}
(map-indexed (fn [i c] [(str c) i]) mode-prefixes)))
(defn member-list
"Who is in `channel`, as `{:nick :prefix}`, ops first and then alphabetically
— the order every other client lists them in, and the one a reader scanning
for a name expects."
[channel]
(->> (get-in @channels [channel :users])
(map (fn [[nick prefix]] {:nick nick :prefix prefix}))
(sort-by (juxt #(prefix-rank (:prefix %) 99) #(str/lower-case (:nick %))))
vec))
(defn member-count [channel]
(count (get-in @channels [channel :users])))
(defn request-names!
"Ask who is in a channel we are already in. freeq re-joins an authenticated
user's channels at registration, which happens without a JOIN reaching this
client — and so without the NAMES that follows one."
[channel]
(when (and @conn channel (str/starts-with? channel "#")
(empty? (get-in @channels [channel :users])))
(irc/send-line! @conn (str "NAMES " channel))))
(declare join! join-call!)
;; --- calls -------------------------------------------------------------------
;; Signaling only. The audio and video themselves are `frq.av`'s, and behind it
;; libjoltmoq's; what happens here is that the server's broadcasts become state
;; the screens can read, and a press becomes a TAGMSG.
(defn apply-call-state!
"A `+freeq.at/av-state` broadcast: fold it in, and say so in the buffer.
The system line is worth the space — a call is the one thing that happens in
a channel while nobody types, and without a line saying so the only trace of
someone joining is a number quietly changing in a banner."
[channel st]
(av/apply-state! channel st)
;; And try to dial. The token may already be in hand — from this join, or
;; from the last time we were in this same session — in which case the
;; server's agreement that we are in the call is the last thing we were
;; waiting for. `try-start-media!` refuses if there is nothing to dial with
;; or a call is already up, so calling it on every state change is safe.
(when (av/in-call? channel)
(av/try-start-media! @form-host))
(let [line (av/state-message st)]
(when (seq line)
(push-message! channel "*" line))))
(defn apply-call-error!
"A `+freeq.at/av-error`. Most say the call failed; one says we lost a race.
`start-collision` means our `av-start` and someone else's crossed and theirs
won. The server names the winning session, so the answer is to join that one
rather than to report an error for something the person asked for and can
have — they wanted to be in a call in this room, and there is one."
[tags code]
(let [reason (or (irc/tag-value tags "+freeq.at/av-reason") code)
session-id (irc/tag-value tags "+freeq.at/av-id")
lc @av/local-call
channel (:channel lc)]
(if (and (= "start-collision" code) (seq session-id) channel
(or (:awaiting-start? lc) (str/blank? (:session-id lc))))
(do
(push-message! channel "*" "Call already open — joining it instead")
(av/stop-media!)
(join-call! channel session-id))
(do
(when channel
(push-message! channel "*" (str "Call error: " reason)))
;; Only tear down a call the error is actually about. A `join-failed`
;; naming someone else's session is not ours to act on.
(when (and lc
(or (str/blank? (or session-id ""))
(str/blank? (:session-id lc))
(= session-id (:session-id lc))))
(av/stop-media!))))))
(defn apply-msg!
"Fold one parsed IRC message into the state."
[msg]
(let [{:keys [command params prefix]} msg
from (irc/nick-of prefix)]
(case command
"001" (do (reset! status (if @session
(str "Connected as " (:handle @session))
(str "Connected as " @form-nick)))
(reset! connecting? false)
(reset! screen :chats)
;; Back where the reader left off. The list is still what a
;; connect lands on underneath, so Back from the reopened
;; channel goes to the chats rather than out of the app.
(if-let [last-ch (first (channel-order))]
(open-channel! last-ch)
(join! auto-join)))
"PRIVMSG" (let [[target text] params
;; The server's clock when it offers one: a replayed
;; backlog is hours or weeks old, and stamping it with
;; the moment it arrived would say it all happened now.
at (or (clock/parse-time-tag (:tags msg)) (clock/now-ms))
tags (:tags msg)
;; a DM addressed to us belongs in a buffer named for the
;; sender, not for our own nick — except when the sender
;; is us: `echo-message` sends our own DM back, and the
;; buffer it belongs to is the one we sent it to.
buffer (cond
(str/starts-with? (or target "") "#") target
(= from @form-nick) target
:else from)
;; What this message rewrites, when it is a rewrite. The
;; server canonicalises the name to `+draft/edit`.
edit-of (irc/tag-value tags "+draft/edit")
;; And what the server says about a line it has already
;; collapsed: replay sends one row per message, carrying
;; the current text and no `+draft/edit` to hint that it
;; is not the original. This tag is the only trace.
replayed-edit? (= "1" (irc/tag-value tags "+freeq.at/edited"))]
(if edit-of
;; A revision is not a new line: it replaces the one it
;; names, under that line's own id — never the revision's
;; wire msgid, which nothing else refers to.
(when (= :absent (edit-message! buffer edit-of from text))
;; The original is outside the backlog we hold, so show
;; the current text rather than dropping what was said.
(push-message! buffer from text
{:at at
:did (:account msg)
:id edit-of
:edited? true
:reply-to (or (irc/tag-value tags "+reply")
(irc/tag-value tags "+draft/reply"))}))
(push-message! buffer from text
{:at at
:did (:account msg)
:id (irc/tag-value tags "msgid")
:edited? replayed-edit?
;; The server canonicalises +draft/reply to
;; +reply; a client that sent the draft
;; name may still reach us before it does.
:reply-to (or (irc/tag-value tags "+reply")
(irc/tag-value tags "+draft/reply"))
:reactions (parse-reactions
(irc/tag-value tags "+freeq.at/reactions"))})))
;; A message that is only tags. A reaction is the one this client reads:
;; `+react` puts an emoji on the message `+reply` names, and the server's
;; own `+freeq.at/unreact` takes it off again.
"TAGMSG" (let [tags (:tags msg)
target (first params)
buffer (if (str/starts-with? (or target "") "#") target from)
msgid (or (irc/tag-value tags "+reply")
(irc/tag-value tags "+draft/reply"))
add (or (irc/tag-value tags "+react")
(irc/tag-value tags "+draft/react"))
remove-it (irc/tag-value tags "+freeq.at/unreact")
call-state (av/parse-state tags)
;; The token is directed at our own nick rather than at
;; the channel, so `buffer` is a DM key here and says
;; nothing about which call it is for. The session id in
;; the tag is what does.
token (irc/tag-value tags "+freeq.at/av-token")
call-error (irc/tag-value tags "+freeq.at/av-error")]
(cond
add (update-reaction! buffer msgid add from true)
remove-it (update-reaction! buffer msgid remove-it from false)
call-state (apply-call-state! buffer call-state)
token (av/apply-token! @form-host
(irc/tag-value tags "+freeq.at/av-id")
token)
call-error (apply-call-error! tags call-error)
:else nil))
"JOIN" (let [ch (first params)]
(if (= from @form-nick)
(let [fresh? (empty? (get-in @channels [ch :messages]))]
(swap! channels #(-> (ensure-channel % ch)
(assoc-in [ch :joined?] true)
(assoc-in [ch :joining?] false)))
;; Only on the way in to an empty buffer. A reconnect joins
;; every channel again, and saying so on top of the backlog
;; already there is just a second line of noise.
(when fresh? (push-message! ch "*" (str "Joined " ch))))
(do (add-user! ch from)
(when-not @hide-join-part?
(push-message! ch "*" (str from " joined"))))))
;; NAMES, a line at a time. The channel is the parameter that names one:
;; the reply is `<us> <symbol> <channel> :<names>`, and a server that
;; leaves the symbol out shifts everything before the list along by one.
"353" (let [ch (first (filter #(str/starts-with? (or % "") "#") params))]
(when ch (names-line ch (last params))))
;; End of NAMES. A plain JOIN is replayed history before this arrives, so
;; a channel that reaches here with nothing in it was restored rather
;; than joined — freeq re-joins an authenticated user's channels at
;; registration and leaves the backlog for the client to ask for.
"366" (let [ch (second params)
said (remove :system? (get-in @channels [ch :messages]))]
(names-end! ch)
(when (and ch @conn (empty? said))
(irc/send-line! @conn
(str "CHATHISTORY LATEST " ch " * " history-limit))))
"PART" (let [ch (first params)]
(if (= from @form-nick)
(swap! channels #(-> % (assoc-in [ch :joined?] false)
(assoc-in [ch :joining?] false)
(assoc-in [ch :users] {})))
(do (remove-user! ch from)
(when-not @hide-join-part?
(push-message! ch "*" (str from " left"))))))
"KICK" (let [[ch who] params]
(if (= who @form-nick)
(swap! channels #(-> % (assoc-in [ch :joined?] false)
(assoc-in [ch :joining?] false)
(assoc-in [ch :users] {})))
(remove-user! ch who))
(push-message! ch "*" (str who " was kicked by " from)))
;; A QUIT and a NICK name no channel, so both are folded into every
;; buffer the person was listed in — and said out loud only where they
;; were, which is what keeps a stranger's rename out of a quiet room.
"QUIT" (let [rooms (keep (fn [[k v]] (when (get (:users v) from) k)) @channels)]
(when-not @hide-join-part?
(doseq [ch rooms]
(push-message! ch "*" (str from " quit"))))
(remove-user-everywhere! from))
"NICK" (let [new-nick (last params)
rooms (keep (fn [[k v]] (when (get (:users v) from) k)) @channels)]
(when (= from @form-nick) (reset! form-nick new-nick))
(doseq [ch rooms]
(push-message! ch "*" (str from " is now " new-nick)))
(rename-user! from new-nick))
"MODE" (let [[target modes & args] params]
(when (str/starts-with? (or target "") "#")
(apply-mode! target modes args)))
("NOTICE" "372" "375" "376" "002" "003" "004")
(reset! status (or (last params) @status))
;; 473 invite-only, 474 banned, 475 keyed, 477 needs registration,
;; 471 full, 403 no such channel. The channel is params[1]; clearing its
;; flags is what lets a later attempt send a JOIN at all.
("473" "474" "475" "477" "403" "471")
(let [ch (second params)
why (last params)]
(when ch
(swap! channels #(-> (ensure-channel % ch)
(assoc-in [ch :joined?] false)
(assoc-in [ch :joining?] false)))
(push-message! ch "*" (str "Could not join " ch " — " why)))
;; Deliberately not the global banner: it outlives the screen it was
;; about, and the reason is in the channel's own buffer where it
;; belongs. The banner is for what stops the whole app — a failed
;; connection or a refused sign-in.
(when-not ch (reset! error (str "Cannot join: " why))))
;; What the server refused and why, in the reader's words. An edit or a
;; reaction it will not take is otherwise silent: the line on screen
;; simply never changes, which reads as the app having lost it.
"FAIL" (let [[what _code] params]
(reset! error (str (or what "Request") " refused — "
(or (last params) "no reason given"))))
"903" (reset! status (str "Signed in as " (:handle @session)))
("904" "905" "906") (do (reset! session nil)
;; The broker token may still be good — but a
;; refusal is as likely to mean it is not, and a
;; stale one would fail the same way every time,
;; including across restarts if it were kept.
(reset! broker-token nil)
(store/clear-session!)
(reset! error (str "Bluesky sign-in refused: "
(or (last params) "no reason given"))))
;; The signing key belonged to that connection: the server forgets it
;; when the session ends, and signing with it afterwards would be
;; signing with a key nobody can check.
"*DISCONNECTED*" (do (msgsig/forget!)
(reset! conn nil)
(reset! connecting? false)
(swap! channels
#(reduce-kv (fn [m k v]
(assoc m k (assoc v :joined? false :joining? false :users {})))
{} %))
(reset! status "Disconnected"))
"*ERROR*" (do (reset! error (first params))
(reset! connecting? false))
nil)))
(def plain-port 6667)
(defn- describe
"What went wrong, in words. A jolt condition prints as #object[:object], so
the message and the ex-data are what has to be dug out by hand."
[e]
(let [msg (ex-message e)]
(if (seq msg)
msg
;; A raw host condition prints as #object[:object] and says nothing, so
;; its type is the only thing left worth showing.
(str (type e) ": " (str e)))))
(defn- dial! [host port nick tls? sess]
;; stderr is the only console on Android — this line lands in logcat.
(binding [*out* *err*]
(println "frq: dialing" host port (if tls? "tls" "plain")))
(reset! conn (irc/connect! host port nick apply-msg! tls? sess)))
(defn- connect-blocking!
"Sign in if asked to, then dial. Blocking throughout — a browser handoff can
take a minute, and the TLS handshake is not instant either."
[]
(reset! error nil)
(reset! connecting? true)
(reset! status (str "Connecting to " @form-host ":" @form-port "…"))
(let [host @form-host
port (parse-long (str/trim @form-port))
mode @auth-mode
sess (case mode
;; OAuth: the browser does the talking, we wait on loopback. A
;; broker token in hand skips the browser entirely.
:bluesky
(let [handle (str/trim @form-handle)
browser! (fn []
(reset! status "Opening your browser to sign in…")
(oauth/await-callback!
oauth/default-broker handle
(fn [url]
(reset! login-url url)
(oauth/open-browser! url)
(reset! status "Waiting for the browser…"))))
tokens (if-let [bt @broker-token]
;; A saved token that the broker no longer honours
;; is worth exactly one attempt: drop it and go
;; through the browser, rather than failing the
;; same way on every future Connect.
(try (reset! status "Resuming your session…")
(oauth/refresh-session oauth/default-broker bt)
(catch Exception _
(reset! broker-token nil)
(store/clear-session!)
(reset! status "Saved session expired — signing in again…")
(browser!)))
(browser!))
s (assoc tokens :kind :web-token)]
(reset! login-url nil)
(reset! broker-token (:broker-token tokens))
;; Saved on every sign-in, not only the first: /session can
;; hand back a rotated broker token, and the old one may stop
;; working the moment it does.
(store/save-session! tokens)
(reset! session s)
(when (seq (:handle tokens)) (reset! form-handle (:handle tokens)))
s)
:app-password
(do (reset! status (str "Signing in as " (str/trim @form-handle) "…"))
(let [s (assoc (atproto/create-session (str/trim @form-handle)
@form-app-password)
:kind :pds-session)]
(reset! session s)
;; The password did its work at the PDS; do not keep it.
(reset! form-app-password "")
s))
nil)
;; An authenticated connection still needs a nick — the DID is the
;; identity, the nick is only what the channel calls you.
nick (if sess
(or (:nick sess)
(-> (or (:handle sess) "") (str/split #"\\.") first)
(str/trim @form-nick))
(str/trim @form-nick))]
(when sess (reset! form-nick nick))
(try
(dial! host port nick @form-tls? sess)
(catch Exception e
(binding [*out* *err*] (println "frq: dial failed:" (describe e)))
(if @form-tls?
(do (reset! status (str "TLS unavailable — trying " host ":" plain-port "…"))
(try
(dial! host plain-port nick false sess)
(reset! form-tls? false)
(reset! form-port (str plain-port))
(catch Exception e2
(binding [*out* *err*] (println "frq: plain dial failed:" (describe e2)))
(reset! connecting? false)
(reset! conn nil)
(reset! status "Not connected")
(reset! error (str "Could not connect: " (describe e2))))))
(do (reset! connecting? false)
(reset! conn nil)
(reset! status "Not connected")
(reset! error (str "Could not connect: " (describe e)))))))))
(defn connect!
"Start connecting. The work happens on another thread: the OAuth wait sits on
a loopback accept until the browser comes back, and the UI has frames to
paint in the meantime.
A second call while one is in flight is ignored. Dialling twice does not just
waste a socket: the server treats the second session as a reconnect of the
first, and a reconnect is not replayed the channel history a fresh join gets,
so the second connection — the one the UI ends up holding — shows an empty
channel."
[]
(when-not (or @connecting? @conn)
(reset! error nil)
(reset! connecting? true)
(future
(try (connect-blocking!)
(catch Exception e
(reset! connecting? false)
(reset! conn nil)
(reset! status "Not connected")
(reset! error (str "Could not connect: " (describe e))))))))
(defn restore-session!
"Pick up a saved sign-in at startup. Only the durable broker token comes
back; the connection still mints a fresh web-token from it."
[]
(when-let [saved (store/load-session)]
(reset! broker-token (:broker-token saved))
(when (seq (:handle saved)) (reset! form-handle (:handle saved)))
(when (seq (:nick saved)) (reset! form-nick (:nick saved)))
(reset! auth-mode :bluesky)
(reset! status (str "Signed in as " (:handle saved) " — Connect to resume"))
saved))
(defn forget-session!
"Drop the saved sign-in, on disk and in memory."
[]
(store/clear-session!)
(reset! broker-token nil)
(reset! session nil)
(reset! auth-mode :guest)
(reset! status "Not connected"))
(defn disconnect! []
(when-let [c @conn] (irc/close! c))
(reset! conn nil)
(reset! session nil)
;; The buffers survive, the memberships do not — leaving `joined?` set would
;; have the next Open show a channel nobody is in.
(swap! channels #(reduce-kv (fn [m k v]
(assoc m k (assoc v :joined? false :joining? false :users {})))
{} %))
(reset! status "Not connected")
(reset! screen :connect))
(defn open-dm!
"Open a conversation with one person. There is nothing to join — a DM buffer
is a place to type at somebody, and it exists as soon as it is asked for.
Our own nick is not one of them: a buffer talking to yourself would take the
place in the list of one that could answer."
[nick]
(let [nick (str/trim (or nick ""))]
(when (and (seq nick) (not= nick @form-nick))
(open-channel! nick))))
(defn join! [name]
;; Deliberately not clearing `error` here: joining is what follows a
;; successful registration, and a SASL refusal that arrived moments earlier
;; is the one thing the user most needs to still be on screen.
;;
;; `@nick` opens a DM instead. One box for both: what the reader wants is to
;; be somewhere, and the sigil says where — the same way it does on the wire.
(let [name (str/trim (or name ""))]
(if (str/starts-with? name "@")
(open-dm! (subs name 1))
(let [ch (normalize-channel name)]
(when (seq ch)
(open-channel! ch))))))
;; ------------------------------------------------------------------ pasting
;; The picture waiting to go out with the next line, or nil:
;;
;; {:path the copy on disk, which is what the preview paints
;; :url where freeq serves it, once the upload has landed
;; :status :uploading | :ready}
;;
;; Held apart from the draft rather than written into it. A link pasted into
;; the entry is a line of unreadable text in the middle of whatever the reader
;; was typing, and it puts their cursor somewhere they did not put it. The
;; picture is a picture until it is sent; the draft stays theirs.
;;
;; One at a time — a second paste replaces the first, which is what a reader
;; who pasted the wrong thing means by pasting the right one.
(defonce attachment (atom nil))
;; Each paste gets a file of its own rather than overwriting the last: the
;; preview is painted from the file, and an upload may still be reading it.
(defonce ^:private paste-count (atom 0))
(defn- paste-path []
(let [n (swap! paste-count inc)]
(str (media/cache-dir) "/outgoing/paste-" n ".png")))
(defn- discard-file!
"Drop a paste's copy on disk. Nothing else keeps it: the picture that matters
after sending is the one the server serves back, which the media cache
fetches like any other."
[path]
(when path (try (host/delete-file! path) (catch Exception _ nil))))
(defn clear-attachment!
"Drop the pasted picture without sending it."
[]
(when-let [a @attachment]
(reset! attachment nil)
(discard-file! (:path a))))
(defn- attach!
"Hold the picture already written to `path` — a copy of ours under
`outgoing/` — against the next line, and start its upload.
The upload runs off the UI thread and starts at once rather than at send, so
by the time a line is written the picture is usually already up. A failure
lands in `error` like any other, and takes the attachment with it — there is
nothing to send and nothing to show.
`filename` is what the server files it under; it says which gesture the
picture came in by, and nothing else depends on it."
[path filename]
(let [did (:did @session)
host-name @form-host
channel @current]
(reset! error nil)
(clear-attachment!)
(reset! attachment {:path path :status :uploading})
(future
(try
(let [url (upload/upload! host-name did channel path filename)]
;; Only if this is still the picture on screen: a reader who attached
;; another, or cleared it, has said what they want, and an upload
;; landing afterwards does not get to undo that.
(swap! attachment #(if (= (:path %) path)
(assoc % :url url :status :ready)
%))
(when-not (= (:path @attachment) path) (discard-file! path)))
(catch Exception e
(swap! attachment #(if (= (:path %) path) nil %))
(discard-file! path)
(reset! error (or (ex-message e) (str e))))))))
(defn paste-image!
"Take the picture on the clipboard and hold it against the next line.
IRC has nowhere to put an image, so a link is the whole of what sending one
means — but that is a fact about the wire, not something the reader should
have to type around. The picture is attached: shown under the draft while
they write whatever they are sending it with, and turned into a link only on
the way out."
[]
(let [path (paste-path)]
(host/mkdirs! (str (media/cache-dir) "/outgoing"))
(if-not (vidya/clipboard-image-png! path)
;; Android has no clipboard of pictures to read at all, which is the
;; other half of why the picker below exists.
(reset! error "No picture on the clipboard.")
(attach! path "paste.png"))))
;; ------------------------------------------------------------------ picking
;; Where the picker is looking, or nil when it is closed. A path, so the
;; browsing is just this cell moving.
(defonce image-picker (atom nil))
(defn- readable-dir? [path]
(try (and (host/file-exists? path) (host/directory? path))
(catch Exception _ false)))
(defn picker-roots
"The places worth opening the picker on, on whichever platform this is.
Only the ones that are actually there: a phone has no ~/Pictures and a
desktop no /sdcard, and a list of directories that are not there is a list of
dead ends. On Android everything outside the app's own storage is behind a
runtime permission this activity has no code to ask for, so what survives
this filter there is usually the app's own files — which is the honest
answer, not a bug to paper over."
[]
(let [home (or (host/getenv "HOME") "")
under (fn [base] (when (seq base)
(map #(str base "/" %)
["Pictures" "Downloads" "Download" "DCIM"])))]
(vec (distinct (filter readable-dir?
(concat (under home)
(under "/sdcard")
(under "/storage/emulated/0")
[(media/cache-dir) home]))))))
(defn- png? [name]
(str/ends-with? (str/lower-case (str name)) ".png"))
(defn picker-entries
"What `dir` holds, as `{:dirs [...] :files [...]}` of full paths.
PNG only, for the same reason the media cache reads PNG only: it is what the
tree backend paints and what the upload sends. An unreadable directory —
which on Android is most of them — answers empty rather than throwing.
Hidden entries are left out: nothing a reader means to send lives in one, and
a home directory is unusable as a list with them in it."
[dir]
(let [names (try (sort (host/list-dir dir)) (catch Exception _ nil))
keep (remove #(str/starts-with? (str %) ".") names)
path (fn [n] (str dir "/" n))]
{:dirs (vec (filter readable-dir? (map path keep)))
:files (vec (map path (filter png? keep)))}))
(defn parent-dir
"The directory above `dir`, or nil at the top."
[dir]
(let [up (str/join "/" (butlast (str/split (str dir) #"/")))]
(when (and (seq up) (not= up dir) (readable-dir? up)) up)))
;; ------------------------------------------- the platform's own chooser
;; Polling, because a chooser is another app's screen: it takes the reader away
;; and gives nothing back through a handler here. `choosing` is what the poll
;; runs on, and the count is what ends it — a reader who backs out without
;; choosing tells us nothing at all, so the alternative is a poll that outlives
;; the app's interest in the answer.
(defonce ^:private choosing (atom nil))
(def ^:private choose-poll-ms 300)
(def ^:private choose-poll-limit
"Five minutes of asking. Long enough for someone who wandered off mid-choice,
short enough that a cancelled chooser is not still being polled for at
bedtime."
1000)
(defn- take-chosen!
"Attach the picture the chooser has written, if it has written one yet."
[]
(let [path (paste-path)]
(host/mkdirs! (str (media/cache-dir) "/outgoing"))
(when (vidya/picked-image! path)
(reset! choosing nil)
(attach! path "picture.png")
true)))
(defn- poll-chosen! []
(when-let [left @choosing]
(when-not (take-chosen!)
(if (pos? left)
(do (reset! choosing (dec left))
(vidya/after! choose-poll-ms poll-chosen!))
(reset! choosing nil)))))
(defn choose-image!
"Open the platform's own picture chooser, where there is one; true when it
opened.
Preferred to browsing on a phone, and not only for the taste of it: what the
chooser hands back is a grant for the one picture the reader chose, so the
app needs no permission over their pictures at all — and without such a
permission, browsing finds almost nothing to show. False where there is no
chooser, which is every desktop, and there browsing is the answer."
[]
(when (vidya/pick-image!)
(reset! error nil)
(reset! choosing choose-poll-limit)
(vidya/after! choose-poll-ms poll-chosen!)
true))
(defn open-image-picker!
"Ask for a picture, whichever way this platform has of choosing one.
The platform's own chooser where there is one — it needs no permission and
knows where the reader's pictures actually are — and otherwise this app's
own browsing screen, which is what a desktop gets."
[]
(when-not (choose-image!)
(reset! error nil)
(reset! image-picker (or (first (picker-roots)) "/"))))
(defn close-image-picker! [] (reset! image-picker nil))
(defn browse! [dir] (when (readable-dir? dir) (reset! image-picker dir)))
(defn- copy-file!
"Copy `from` to `to`, byte for byte."
[from to]
(let [in (java.io.FileInputStream. from)]
(try
(let [out (java.io.FileOutputStream. to)]
(try (.write out (.readAllBytes in))
(finally (.close out))))
(finally (try (.close in) (catch Exception _ nil))))))
(defn pick-image!
"Attach the picture at `path` and close the picker.
Copied into `outgoing/` first rather than attached where it lies: the send
drops the attachment's file when it is done with it, and what it drops has to
be ours — not the reader's own picture, sitting in their pictures folder."
[path]
(let [copy (paste-path)]
(try
(host/mkdirs! (str (media/cache-dir) "/outgoing"))
(copy-file! path copy)
(close-image-picker!)
(attach! copy (or (last (str/split (str path) #"/")) "picture.png"))
(catch Exception e
(discard-file! copy)
(reset! error (str "Could not read that picture: " (or (ex-message e) e)))))))
(defn- dm-peer-did
"The DID of whoever this DM buffer is with, from the last thing they said.
nil for a channel, and for a conversation where nobody with a DID has spoken
— a signature over a DM needs both sides named, and there is nothing to name."
[channel]
(when-not (str/starts-with? (or channel "") "#")
(->> (get-in @channels [channel :messages])
(remove #(= @form-nick (:from %)))
(keep :did)
last)))
(defn mine?
"Whether we are the one who said this. Nick against nick, which is what the
server itself falls back to for an account with no DID — and an edit it would
refuse is one not worth offering."
[m]
(and (not (:system? m))
(seq (or (:from m) ""))
(= (str/lower-case (:from m))
(str/lower-case (or @form-nick "")))))
(defn start-edit!
"Put a message back in the box to be rewritten.
The old text is the starting point rather than an empty line: an edit is
usually a word, and retyping the sentence around it is not what was asked
for. Whatever was half-typed is dropped — a draft and an edit are two things
to say, and the box holds one."
[channel m]
(when (and (:id m) (mine? m))
(reset! replying-to nil)
(reset! editing {:channel channel :id (:id m)})
(reset! draft (or (:text m) ""))))
(defn cancel-edit!
"Leave the message as it was said. The box empties with it: what is in it is
a copy of the line on screen, and leaving that behind would look like a draft
the reader wrote."
[]
(reset! editing nil)
(reset! draft ""))
(defn send-draft!
"Send the draft, with whatever picture is attached to it.
The picture becomes its link, at the end of the line: what goes on the wire
is the text the reader wrote and a URL after it, which is what every other
client in the channel knows how to show. A line that is only a picture is
only the link.
A picture still on its way up holds the send rather than losing it: the line
is left in the box, said so, and the reader presses send again a moment
later. Sending the text without its picture would be the one outcome nobody
asked for."
[]
(let [text (str/trim @draft)
target @current
reply-to @replying-to
edit @editing
{:keys [url status path] :as att} @attachment]
(cond
(not target) nil
(= :uploading status) (reset! error "The picture is still uploading.")
;; A rewrite replaces what was said, and what was said is a line of text:
;; there is no wire form for adding a picture to a message already sent,
;; so the attachment is held back rather than silently dropped.
(and edit att) (reset! error "Finish the edit before sending a picture.")
(and edit (str/blank? text)) nil
edit
(do (when-let [c @conn]
(irc/edit! c (:channel edit) (:id edit) text
(dm-peer-did (:channel edit))))
;; Same reason as a new message: the server's echo is the copy that
;; every other client sees, and folding this one in as well would
;; rewrite the line twice. Without echo-message nothing comes back,
;; so the rewrite has to be applied here or it never shows.
(when-not (some-> @conn (irc/cap-acked? "echo-message"))
(edit-message! (:channel edit) (:id edit) @form-nick text))
(reset! editing nil)
(reset! draft ""))
(and (str/blank? text) (not url)) nil
:else
(let [line (str/trim (str text (when url (str " " url))))]
;; Saying something is a way of asking to see it.
(jump-to-present!)
(when-let [c @conn] (irc/privmsg! c target line (:id reply-to)))
;; Only when the server will not send the line back itself. Its copy
;; carries the msgid, and a message with no id is one nobody can react
;; or reply to; echoing locally as well would put the line up twice.
(when-not (some-> @conn (irc/cap-acked? "echo-message"))
(push-message! target @form-nick line {:reply-to (:id reply-to)}))
(reset! replying-to nil)
(reset! draft "")
(when att
(reset! attachment nil)
;; The picture on screen from here on is the one fetched back from
;; the link, like everyone else's.
(discard-file! path))))))
(defn open-picker!
"Choose an emoji for this message. Opening it fresh — no leftover search from
the last time, which would be a screen of somebody else's question."
[channel m]
(when (:id m)
(reset! emoji-search "")
(reset! emoji-group nil)
(reset! reacting {:channel channel :id (:id m)})))
(defn close-picker! [] (reset! reacting nil))
(def emoji-groups
"Unicode's own grouping, which is what the picker's tabs are."
emoji/groups)
(def picker-limit
"How many glyphs the picker will lay out at once — twelve rows of the nine it
fits across. It stands inside the message list, so what it shows pushes the
conversation down; a group that has more says so, and the search box is how
you reach the rest."
108)
(defn picker-emoji
"What the picker is showing right now: the popular row, one group, or
whatever the search matches — by name, so \"cat\" finds the cat and the cat
face, and by the emoji itself, so pasting one finds it."
[]
(let [q (str/lower-case (str/trim @emoji-search))
;; A blank group is no group: the popular row is what nothing selected
;; means, and an empty string would filter the catalog down to nothing.
group (when (seq (or @emoji-group "")) @emoji-group)]
(cond
(seq q) (->> emoji/catalog
(filter (fn [[glyph name _]]
(or (str/includes? (str/lower-case name) q)
(str/includes? glyph q))))
vec)
group (vec (filter (fn [[_ _ g]] (= g group)) emoji/catalog))
:else (mapv (fn [glyph] [glyph glyph nil]) emoji/popular))))
(defn my-reaction?
"Whether this nick is already on that emoji — which is what makes a second
click take it off rather than send the same reaction twice."
[m emoji]
(boolean (some #{@form-nick} (get (:reactions m) emoji))))
;; The pill the pointer is resting on, or nil — `{:id msgid :emoji glyph}`.
;; One at a time, and named by the message as well as the glyph: the same emoji
;; is a pill under many messages, and only the one under the pointer carries a
;; card.
(defonce reaction-hover (atom nil))
(defn hover-reaction!
"The pointer has come to rest on a pill."
[msgid emoji]
(reset! reaction-hover {:id msgid :emoji emoji}))
(defn unhover-reaction!
"The pointer has left that pill. Guarded by which one is being left, so
crossing straight from one pill to the next — both edges in a frame — cannot
take down the card that has just been raised."
[msgid emoji]
(swap! reaction-hover #(when-not (= {:id msgid :emoji emoji} %) %)))
(defn hovering-reaction?
"Whether this is the pill the card belongs to."
[msgid emoji]
(= {:id msgid :emoji emoji} @reaction-hover))
(defn toggle-reaction!
"Put my emoji on a message, or take it off if it is already mine.
Applied here as well as sent: the server relays a TAGMSG to everyone in the
channel *except* the client that sent it, so without this the pill would only
appear once someone else reacted too."
[channel m emoji]
(when-let [msgid (:id m)]
(let [on? (not (my-reaction? m emoji))
;; Who the DM is with, for the signature: freeq names a DM by both
;; DIDs rather than by a nick, and nothing else in a buffer says
;; which account the other side is. nil in a channel, which is named
;; by itself.
peer (dm-peer-did channel)]
(when-let [c @conn]
(if on?
(irc/react! c channel msgid emoji peer)
(irc/unreact! c channel msgid emoji peer)))
(update-reaction! channel msgid emoji @form-nick on?))))
(defn start-call!
"Open a call on this channel.
Optimistic: the controls appear on the press. What comes back settles it —
an `av-state` says the room has a call, an `av-token` starts the media, and
a `start-collision` means someone beat us to it and we join theirs instead."
[channel]
(when-let [c @conn]
(let [nick (or (:nick @session) @form-nick)
instance (av/begin! {:channel channel
:nick nick
:muted? false
:speaker-muted? false
;; Audio first, always. A call that opened with
;; the camera on would be a call that showed
;; someone's room before they had agreed to.
:camera? false})]
(irc/tagmsg! c channel (av/start-tags instance nil)))))
(defn join-call!
"Join the call already open on this channel."
[channel session-id]
(when-let [c @conn]
(let [nick (or (:nick @session) @form-nick)
instance (av/begin! {:channel channel
:session-id session-id
:nick nick
:muted? false
:speaker-muted? false
:camera? false})]
(irc/tagmsg! c channel (av/join-tags session-id instance)))))
(defn announce-leave!
"Tell the room this device is out of a call it did not choose to leave.
freeq counts a participant until an `av-leave` says otherwise, so a media
plane that fails silently leaves a ghost behind — and the next Join adds
another beside it. Registered with `frq.av` at startup, because that
namespace has no connection to send on."
[{:keys [channel session-id instance]}]
(when (and @conn (seq (or session-id "")))
(irc/tagmsg! @conn channel (av/leave-tags session-id instance))))
(defn leave-call!
"Leave the call, telling the room and the SFU both.
The media plane goes down first and on its own account: the person pressed
leave, so the microphone should be shut whether or not the TAGMSG gets out."
[]
(when-let [{:keys [channel session-id instance]} @av/local-call]
(av/stop-media!)
(when-let [c @conn]
(when (seq session-id)
(irc/tagmsg! c channel (av/leave-tags session-id instance))))))
(defn channel-list
"Buffers most recently opened first, filtered by the search box.
A conversation list is read from the top, and the one you were just in is the
one you are most likely to want again. Buffers never opened — a DM that
arrived, a channel someone mentioned — sort under those, by name, rather than
jumping the queue."
[]
(let [q (str/lower-case (str/trim @search))]
(->> (vals @channels)
(filter #(or (str/blank? q)
(str/includes? (str/lower-case (:name %)) q)))
(sort-by (juxt #(- (:accessed % 0)) :name))
vec)))
(defn channel-order
"The buffer names, most recently opened first — what gets written to disk.
Buffers never opened are left out: a DM that arrived once and was never read
is not a place this client has been, and neither is a channel someone
mentioned. One that was opened is, whether it is a room or a person."
[]
(->> (vals @channels)
(filter #(pos? (:accessed % 0)))
(sort-by #(- (:accessed % 0)))
(mapv :name)))
(defn restore-channels!
"Bring back the channels of earlier runs, in the order they were last used.
Empty buffers, not memberships: opening one is what joins it, and a list of
rooms is the part worth keeping — the messages in them come from the server.
The tick is seeded so this run's first open still sorts above all of them."
[]
(when-let [saved (seq (store/load-channels))]
(let [ordered (reverse saved)] ; oldest first, so ticks ascend
(swap! channels
(fn [m]
(reduce (fn [acc name]
(if (contains? acc name)
acc
(assoc acc name {:name name :messages [] :unread 0
:joined? false :joining? false
:users {}
:accessed (swap! access-tick inc)})))
m
ordered))))
(count saved)))
(defn message-by-id
"The message a reply points at, if this buffer still holds it."
[channel id]
(when id
(first (filter #(= id (:id %)) (get-in @channels [channel :messages])))))
(defn react-from-picker!
"Put the chosen emoji on the message the picker was opened for, and close it.
One choice and back to the conversation: a picker left open would be asking a
question that has been answered."
[emoji]
(when-let [{:keys [channel id]} @reacting]
(when-let [m (message-by-id channel id)]
(toggle-reaction! channel m emoji))
(close-picker!)))
;; The message a "go to" is currently aiming at. Set for the frame that scrolls
;; to it and taken off again — a scroll target that stays set would pin the
;; view there and take scrolling away from the reader.
(defonce jump-to (atom nil))
;; The message a jump has just landed on. It outlives the scroll: arriving at a
;; screenful of messages says nothing about which one was asked for, so the one
;; that was answers for itself until the reader has had time to see it.
(defonce highlight (atom nil))
(defn last-preview [buffer]
(if-let [m (last (:messages buffer))]
(str (:from m) ": " (:text m))
"No messages yet"))
|