Clean up the main-window file. Much better now.

This commit is contained in:
Robert C. Martin 2022-05-05 15:14:30 -05:00
parent 7d6945a8f7
commit c94bafd84a
5 changed files with 180 additions and 167 deletions

View File

@ -1,7 +1,7 @@
(ns more-speech.ui.swing.main-window-spec
(ns more-speech.ui.swing.article-tree-spec
(:require [speclj.core :refer :all]
[more-speech.ui.swing.main-window :refer :all]
)
[more-speech.ui.swing.article-tree :refer :all]
)
(:import (javax.swing.tree DefaultMutableTreeNode)))
(describe "header tree"
@ -39,37 +39,37 @@
(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)))
(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))))
(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)))
(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)))
))

View File

@ -32,7 +32,7 @@
(defn ^:export -main [& _args]
(let [keys (read-string (slurp "private/keys"))
event-agent (events/make-event-agent keys send-chan)
handler (swing/setup-jframe event-agent)
handler (swing/setup-main-window event-agent)
]
(send event-agent set-event-handler handler)
(protocol/get-events event-agent))

View File

@ -53,14 +53,5 @@
content (abbreviate content 50)]
(format "%20s %s %s\n" name time content))))
(defn format-article [event-state {:keys [id pubkey created-at content]}]
(let [nicknames (:nicknames event-state)
time (format-time created-at)
name (format-user-id nicknames pubkey)
article (reformat-article content 80)
formatted-id (abbreviate (util/num->hex-string id) 10)]
(format "%s %20s %s\n%s" time name formatted-id article))
)
(defn format-reply [event]
(prepend> (reformat-article (:content event) 80)))

View File

@ -0,0 +1,106 @@
(ns more-speech.ui.swing.article-tree
(:require [more-speech.nostr.events :as events]
[more-speech.ui.formatters :as formatters]
[more-speech.nostr.elliptic-signature :as ecc]
[more-speech.ui.config :as config])
(:use [seesaw core font tree])
(:import (javax.swing.tree DefaultMutableTreeNode DefaultTreeModel TreePath)))
(declare render-event select-article)
(defn make-article-tree [event-agent main-frame]
(let [header-tree (tree :renderer (partial render-event event-agent)
:root-visible? false
:model (DefaultTreeModel. (DefaultMutableTreeNode. "Empty"))
:id :header-tree)]
(listen header-tree :selection (partial select-article event-agent main-frame))
header-tree))
(defn select-article [event-agent main-frame e]
(when (last (selection e))
(let [selected-id (.getUserObject (last (selection e)))
event-state @event-agent
nicknames (:nicknames event-state)
format-user (partial formatters/format-user-id nicknames)
text-map (:text-event-map event-state)
event (get text-map selected-id)
[_ _ referent] (events/get-references event)
reply-to (select main-frame [:#reply-to])
citing (select main-frame [:#citing])
article-area (select main-frame [:#article-area])]
(text! article-area (formatters/reformat-article (:content event) 80))
(text! (select main-frame [:#author-id])
(format-user (:pubkey event)))
(text! (select main-frame [:#created-at])
(formatters/format-time (:created-at event)))
(if (some? referent)
(let [replied-event (get text-map referent)]
(text! reply-to (format-user (:pubkey replied-event)))
(text! citing (formatters/abbreviate (ecc/num32->hex-string referent) 32)))
(do (text! reply-to "")
(text! citing "")))
)))
(defn render-event [event-agent widget info]
(config! widget :font config/default-font)
(if (seqable? (:value info))
(text! widget "Articles")
(let [event-state @event-agent
nicknames (:nicknames event-state)
event-map (:text-event-map event-state)
node (:value info)
event-id (.getUserObject node)
event (get event-map event-id)]
(text! widget (formatters/format-header nicknames event)))))
(declare add-references)
(defn add-event [ui-context 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. event-id)]
(.insertNodeInto model child root child-count)
(.makeVisible tree (TreePath. (.getPath child)))
(swap! ui-context update-in [:node-map event-id] conj child)
(add-references ui-context event)
))
;; at the moment an event can appear in several places in the tree.
;; it can be in the reply chain of an event, and it can stand alone.
;; The node-map holds the list of nodes that correspond to the id of
;; an event.
(defn add-references [ui-context event]
(let [[_ _ referent] (events/get-references event)
id (:id event)]
(if (nil? referent)
nil
(loop [nodes (get-in @ui-context [:node-map referent])]
(if (empty? nodes)
nil
(let [node (first nodes)
child (DefaultMutableTreeNode. id)]
(.add ^DefaultMutableTreeNode node child)
(swap! ui-context update-in [:node-map id] conj child)
(recur (rest nodes))))))))
(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)))
))
)))

View File

@ -3,107 +3,41 @@
[more-speech.ui.formatters :as formatters]
[more-speech.nostr.events :as events]
[more-speech.ui.config :as config]
[more-speech.nostr.elliptic-signature :as ecc])
[more-speech.ui.swing.article-tree :as article-tree])
(:use [seesaw core font tree])
(:import [javax.swing.tree
DefaultMutableTreeNode
DefaultTreeModel
TreePath]
(javax.swing Timer)))
(declare add-event)
(defrecord seesawHandler []
events/event-handler
(events/handle-text-event [_handler event]
(invoke-later (add-event event))))
(:import (javax.swing Timer)))
(def ui-context (atom {:frame nil
:event-agent nil
:node-map {}}))
(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. event-id)]
(.insertNodeInto model child root child-count)
(.makeVisible tree (TreePath. (.getPath child)))
(swap! ui-context update-in [:node-map event-id] conj child)
(add-references event)
))
(defrecord seesawHandler []
events/event-handler
(events/handle-text-event [_handler event]
(invoke-later (article-tree/add-event ui-context event))))
;; at the moment an event can appear in several places in the tree.
;; it can be in the reply chain of an event, and it can stand alone.
;; The node-map holds the list of nodes that correspond to the id of
;; an event.
(declare make-main-window)
(defn add-reference [reference id]
(loop [nodes (get-in @ui-context [:node-map reference])]
(if (empty? nodes)
nil
(let [node (first nodes)
child (DefaultMutableTreeNode. id)]
(.add ^DefaultMutableTreeNode node child)
(swap! ui-context update-in [:node-map id] conj child)
(recur (rest nodes))))))
(defn add-references [event]
(let [[_ _ referent] (events/get-references event)]
(if (nil? referent)
nil
(add-reference referent (:id event)))))
(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)
(defn setup-jframe [event-agent]
(invoke-now (display-jframe event-agent))
(defn setup-main-window [event-agent]
(invoke-now (make-main-window event-agent))
(->seesawHandler))
(declare make-edit-window
make-article-info-panel
make-article-area
make-control-panel
timer-action)
(defn display-jframe [event-agent]
(defn make-main-window [event-agent]
(let [main-frame (frame :title "More Speech" :size [1000 :by 1000])
article-info-panel (grid-panel :rows 2 :columns 2
:items [(label :id :author-id)
(label :id :created-at)
(label :id :reply-to)
(label :id :citing)])
article-area (text :multi-line? true
:font config/default-font
:editable? false)
header-tree (tree :renderer (partial render-event event-agent)
:root-visible? false
:model (DefaultTreeModel. (DefaultMutableTreeNode. "Empty"))
:id :header-tree)
reply-button (button :text "Reply")
create-button (button :text "Create")
control-panel (flow-panel :items [reply-button create-button])
article-panel (border-panel :north article-info-panel
article-area (make-article-area)
header-tree (article-tree/make-article-tree event-agent main-frame)
article-panel (border-panel :north (make-article-info-panel)
:center (scrollable article-area)
:south control-panel)
main-panel (top-bottom-split (scrollable header-tree) article-panel)
:south (make-control-panel event-agent header-tree))
main-panel (top-bottom-split
(scrollable header-tree)
article-panel)
timer (Timer. 100 nil)]
(config! main-frame :content main-panel)
(swap! ui-context assoc :frame main-frame :event-agent event-agent)
@ -117,57 +51,39 @@
[:closed])
(.dispose main-frame)))
(listen header-tree :selection
(fn [e]
(when (last (selection e))
(let [selected-id (.getUserObject (last (selection e)))
event-state @event-agent
nicknames (:nicknames event-state)
format-user (partial formatters/format-user-id nicknames)
text-map (:text-event-map event-state)
event (get text-map selected-id)
[_ _ referent] (events/get-references event)
reply-to (select main-frame [:#reply-to])
citing (select main-frame [:#citing])]
(text! article-area (formatters/format-article event-state event))
(text! (select main-frame [:#author-id])
(format-user (:pubkey event)))
(text! (select main-frame [:#created-at])
(formatters/format-time (:created-at event)))
(if (some? referent)
(let [replied-event (get text-map referent)]
(text! reply-to (format-user (:pubkey replied-event)))
(text! citing (formatters/abbreviate (ecc/num32->hex-string referent) 32)))
(do (text! reply-to "")
(text! citing "")))
))))
(show! main-frame)
(.start timer)))
(defn make-article-info-panel []
(grid-panel
:rows 2 :columns 2
:items [(label :id :author-id)
(label :id :created-at)
(label :id :reply-to)
(label :id :citing)]))
(defn make-article-area []
(text :multi-line? true
:font config/default-font
:editable? false
:id :article-area))
(defn make-control-panel [event-agent header-tree]
(let [reply-button (button :text "Reply")
create-button (button :text "Create")]
(listen reply-button :action
(fn [_]
(make-edit-window :reply event-agent header-tree)))
(listen create-button :action
(fn [_] (make-edit-window :send event-agent nil)))
(show! main-frame)
(.start timer)))
(flow-panel :items [reply-button create-button])))
(defn timer-action [_]
;nothing for now.
)
(defn render-event [event-agent widget info]
(config! widget :font config/default-font)
(if (seqable? (:value info))
(text! widget "Articles")
(let [event-state @event-agent
nicknames (:nicknames event-state)
event-map (:text-event-map event-state)
node (:value info)
event-id (.getUserObject node)
event (get event-map event-id)]
(text! widget (formatters/format-header nicknames event)))
))
(defn make-edit-window [kind event-agent header-tree]
(let [reply? (= kind :reply)