nostr/more-speech
1
0
Fork 0
mirror of https://github.com/unclebob/more-speech.git synced 2024-09-30 10:30:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added incremental article threading. Also added try/catch to name-event in case someone sends an ill-formatted message.

Browse Source
This commit is contained in:
Robert C. Martin 2022-05-02 09:22:09 -05:00
parent c9c31633b3
commit b21203bd5d
6 changed files with 152 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
spec/more_speech/nostr/events_spec.clj
View File

@ -5,7 +5,7 @@
(defrecord event-handler-dummy []
event-handler
(handle-text-event [_ _event])
(handle-text-event [_ _event-id])
)
(declare now event state)

75
spec/more_speech/ui/swing/main_window_spec.clj Normal file
View File

@ -0,0 +1,75 @@
(ns more-speech.ui.swing.main-window-spec
(:require [speclj.core :refer :all]
[more-speech.ui.swing.main-window :refer :all]
)
(:import (javax.swing.tree DefaultMutableTreeNode)))
(describe "header tree"
(context "finding nodes"
(it "finds nothing in an empty tree"
(let [root (DefaultMutableTreeNode.)
found-node (find-header-node root 1)]
(should-be-nil found-node)))
(it "finds nothing in non-empty tree"
(let [root (DefaultMutableTreeNode.)
child (DefaultMutableTreeNode. 2)
_ (.add ^DefaultMutableTreeNode root child)
found-node (find-header-node root 1)]
(should-be-nil found-node)))
(it "finds node in one-node tree"
(let [root (DefaultMutableTreeNode.)
child (DefaultMutableTreeNode. 1)
_ (.add ^DefaultMutableTreeNode root child)
found-node (find-header-node root 1)]
(should-not-be-nil found-node)
(should= 1 (.getUserObject found-node))))
(it "finds node in multi-node non-branching tree"
(let [root (DefaultMutableTreeNode.)
child1 (DefaultMutableTreeNode. 1)
child2 (DefaultMutableTreeNode. 2)
child3 (DefaultMutableTreeNode. 3)
_ (.add ^DefaultMutableTreeNode root child1)
_ (.add ^DefaultMutableTreeNode root child2)
_ (.add ^DefaultMutableTreeNode root child3)
found-node (find-header-node root 2)]
(should-not-be-nil found-node)
(should= 2 (.getUserObject found-node))))
(it "does not find node in multi-node non-branching tree"
(let [root (DefaultMutableTreeNode.)
child1 (DefaultMutableTreeNode. 1)
child2 (DefaultMutableTreeNode. 2)
child3 (DefaultMutableTreeNode. 3)
_ (.add ^DefaultMutableTreeNode root child1)
_ (.add ^DefaultMutableTreeNode root child2)
_ (.add ^DefaultMutableTreeNode root child3)
found-node (find-header-node root 4)]
(should-be-nil found-node)))
(it "finds node in multi-node branching tree"
(let [root (DefaultMutableTreeNode.)
child1 (DefaultMutableTreeNode. 1)
child2 (DefaultMutableTreeNode. 2)
child3 (DefaultMutableTreeNode. 3)
_ (.add ^DefaultMutableTreeNode root child1)
_ (.add ^DefaultMutableTreeNode child1 child2)
_ (.add ^DefaultMutableTreeNode root child3)
found-node (find-header-node root 2)]
(should-not-be-nil found-node)
(should= 2 (.getUserObject found-node))))
(it "Does not find node in multi-node branching tree"
(let [root (DefaultMutableTreeNode.)
child1 (DefaultMutableTreeNode. 1)
child2 (DefaultMutableTreeNode. 2)
child3 (DefaultMutableTreeNode. 3)
_ (.add ^DefaultMutableTreeNode root child1)
_ (.add ^DefaultMutableTreeNode child1 child2)
_ (.add ^DefaultMutableTreeNode root child3)
found-node (find-header-node root 4)]
(should-be-nil found-node)))
))

1
src/more_speech/core.clj
View File

@ -1,4 +1,5 @@
;;Stories
;; - validate incoming messages.
;; - Add author/date, etc. to replies.
;; - Start checking sdefs in update.
;; - Clean up java schnorr library.

37
src/more_speech/nostr/events.clj
View File

@ -33,7 +33,6 @@
(agent {:chronological-text-events []
:nicknames {}
:text-event-map {}
:update false
:keys keys
:send-chan send-chan}))
@ -58,12 +57,17 @@
(do (prn "unknown event: " event)
event-state))))
(defn process-name-event [event-state {:strs [_id pubkey _created_at _kind _tags content _sig]}]
(let [pubkey (hex-string->num pubkey)
name (get (json/read-str content) "name" "tilt")]
(-> event-state
(update-in [:nicknames] assoc pubkey name)
(assoc :update true))))
(defn process-name-event [event-state {:strs [_id pubkey _created_at _kind _tags content _sig] :as event}]
(try
(let [pubkey (hex-string->num pubkey)
name (get (json/read-str content) "name" "tilt")]
(-> event-state
(update-in [:nicknames] assoc pubkey name)
))
(catch Exception e
(prn 'json-exception-process-name-event-ignored e)
(prn event)
event-state)))
(defn process-tag [[type arg1 arg2]]
[(keyword type) arg1 arg2])
@ -71,11 +75,15 @@
(defn process-tags [tags]
(map process-tag tags))
(defn process-references [state {:keys [id tags] :as _event}]
(let [e-tags (filter #(= :e (first %)) tags)
refs (map second e-tags)
refs (map hex-string->num (take 1 refs)) ;; Hack. Only the first reference is counted.
]
(defn get-references [event]
(let [tags (:tags event)
e-tags (filter #(= :e (first %)) tags)
refs (map second e-tags)
refs (map hex-string->num refs)]
refs))
(defn process-references [state event]
(let [refs (take 1 (get-references event))] ;; Hack. Only the first reference is counted.
(loop [refs refs
state state]
(if (empty? refs)
@ -87,7 +95,7 @@
(update-in
state
(concat referent-path [:references])
conj id))))))))
conj (:id event)))))))))
(defn translate-text-event [event]
(let [id (hex-string->num (get event "id"))
@ -112,8 +120,7 @@
handler (:event-handler event-state)
event-state (-> event-state
(add-event event)
(process-references event)
(assoc :update true))]
(process-references event))]
(handle-text-event handler event)
event-state)
)

2
src/more_speech/nostr/protocol.clj
View File

@ -69,7 +69,7 @@
(prn 'close statusCode reason)
)
(onError [_this _webSocket error]
(prn 'error)
(prn 'websocket-listener-error error)
)
)

61
src/more_speech/ui/swing/main_window.clj
View File

@ -5,9 +5,10 @@
[more-speech.ui.config :as config])
(:use [seesaw core font tree])
(:import [javax.swing.tree
DefaultMutableTreeNode
DefaultTreeModel
TreePath]))
DefaultMutableTreeNode
DefaultTreeModel
TreePath]
(javax.swing Timer)))
(declare add-event)
(defrecord seesawHandler []
@ -17,16 +18,48 @@
(def ui-context (atom nil))
(declare find-header-node add-references)
(defn add-event [event]
(let [frame (:frame @ui-context)
event-id (:id event)
tree (select frame [:#header-tree])
model (config tree :model)
root (.getRoot model)
child-count (.getChildCount root)
child (DefaultMutableTreeNode. (:id event))]
child (DefaultMutableTreeNode. event-id)]
(.insertNodeInto model child root child-count)
(.makeVisible tree (TreePath. (.getPath child))))
)
(.makeVisible tree (TreePath. (.getPath child)))
;(add-references root event)
))
(defn add-references [root event]
(loop [references (events/get-references event)]
(if (empty? references)
nil
(let [reference (first references)
node (find-header-node root reference)]
(when (some? node)
(.add ^DefaultMutableTreeNode node
(DefaultMutableTreeNode. (:id event))))
(recur (rest references))))))
(defn find-header-node [root id]
(loop [children (enumeration-seq (.children root))]
(let [child (first children)]
(cond
(empty? children)
nil
(= id (.getUserObject child))
child
:else
(let [found-child (find-header-node child id)]
(if (some? found-child)
found-child
(recur (rest children)))
))
)))
(declare display-jframe
render-event)
@ -34,7 +67,8 @@
(invoke-now (display-jframe event-agent))
(->seesawHandler))
(declare make-edit-window)
(declare make-edit-window
timer-action)
(defn display-jframe [event-agent]
(let [main-frame (frame :title "More Speech" :size [1000 :by 1000])
article-area (text :multi-line? true
@ -45,10 +79,15 @@
:model (DefaultTreeModel. (DefaultMutableTreeNode. "Empty"))
:id :header-tree)
reply-button (button :text "Reply")
create-button (button :text "Create")]
create-button (button :text "Create")
timer (Timer. 100 nil)]
(reset! ui-context {:frame main-frame :event-agent event-agent})
(listen timer :action timer-action)
(listen main-frame :window-closing
(fn [_]
(.stop timer)
(async/>!! (:send-chan @event-agent)
[:closed])
(.dispose main-frame)))
@ -73,8 +112,12 @@
:north (scrollable header-tree)
:center (scrollable article-area)
:south (flow-panel :items [reply-button create-button])))
(show! main-frame)))
(show! main-frame)
(.start timer)))
(defn timer-action [_]
;nothing for now.
)
(defn render-event [event-agent widget info]
(config! widget :font config/default-font)