The beginnings of multiple tabs and filters in each tab. Clicking on the citing/root when a filtered tab is selected does not work properly because the id-click method defaults to using the #all tab. Icky at best.

This commit is contained in:
Robert C. Martin 2022-05-24 14:46:05 -05:00
parent 1ddd1d7133
commit a94ae06f36
7 changed files with 62 additions and 32 deletions

View File

@ -29,10 +29,12 @@
_ (relays/load-relays-from-file "private/relays")
read-event-ids (read-string (slurp "private/read-event-ids"))
nicknames (read-string (slurp "private/nicknames"))
tabs (read-string (slurp "private/tabs"))
event-agent (events/make-event-agent {:keys keys
:send-chan send-chan
:nicknames nicknames
:read-event-ids read-event-ids
:tabs tabs
})
handler (swing/setup-main-window event-agent)
]

View File

@ -39,11 +39,14 @@
:nicknames {}
:keys {}
:read-event-ids #{}
:tabs {}
}
event-agent-map)))
(defn add-read-event [event-state id]
(update event-state :read-event-ids conj id))
(defn select-event [event-state id]
(-> event-state
(update :read-event-ids conj id)
(assoc :selected-event id)))
(defn to-json [o]
(json/write-str o :escape-slash false :escape-unicode false))

View File

@ -48,15 +48,15 @@
:editable? false
:id :article-area))
(defn make-control-panel [event-agent header-tree]
(defn make-control-panel [event-agent]
(let [reply-button (button :text "Reply")
create-button (button :text "Create")]
(listen reply-button :action
(fn [_]
(edit-window/make-edit-window :reply event-agent header-tree)))
(edit-window/make-edit-window :reply event-agent)))
(listen create-button :action
(fn [_] (edit-window/make-edit-window :send event-agent nil)))
(fn [_] (edit-window/make-edit-window :send event-agent)))
(flow-panel :items [reply-button create-button])))
(defn id-click [e]

View File

@ -10,12 +10,11 @@
(declare render-event select-article)
(defn make-article-tree [event-agent main-frame]
(defn make-header-tree [event-agent main-frame]
(let [header-tree (tree :renderer (partial render-event event-agent)
:root-visible? false
:expands-selected-paths? true
:model (DefaultTreeModel. (DefaultMutableTreeNode. "Empty"))
:id :header-tree)]
:model (DefaultTreeModel. (DefaultMutableTreeNode. "Empty")))]
(listen header-tree :selection (partial select-article event-agent main-frame))
header-tree))
@ -26,7 +25,7 @@
(let [selected-node (last (selection e))
selected-id (.getUserObject selected-node)
event-state @event-agent]
(send event-agent events/add-read-event selected-id)
(send event-agent events/select-event selected-id)
(article-panel/load-article-info event-state selected-id main-frame))))
(defn render-event [event-agent widget info]
@ -45,22 +44,38 @@
(declare add-references resolve-any-orphans)
(defn should-add-event? [tree event]
(let [tab-data (config tree :user-data)
selected (:selected tab-data)
_blocked (:blocked tab-data)]
(or
(empty? selected)
(some #(= % (:pubkey event)) selected)))
)
(defn add-event [ui-context event]
(let [frame (:frame @ui-context)
event-state @(:event-agent @ui-context)
event-map (:text-event-map event-state)
event-id (:id event)
tree (select frame [:#header-tree])
model (config tree :model)
root (.getRoot model)
insertion-point (find-chronological-insertion-point root event-id event-map)
child (DefaultMutableTreeNode. event-id)]
(.insertNodeInto model child root insertion-point)
(.makeVisible tree (TreePath. (.getPath child)))
(swap! ui-context update-in [:node-map event-id] conj child)
(resolve-any-orphans ui-context event-id)
(add-references ui-context event)
))
tabs (:tabs event-state)]
(loop [tab-names (keys tabs)]
(if (empty? tab-names)
nil
(let [tree-id (keyword (str "#" (name (first tab-names))))
tree (select frame [tree-id])]
(when (should-add-event? tree event)
(let [model (config tree :model)
root (.getRoot model)
insertion-point (find-chronological-insertion-point root event-id event-map)
child (DefaultMutableTreeNode. event-id)]
(.insertNodeInto model child root insertion-point)
(.makeVisible tree (TreePath. (.getPath child)))
(swap! ui-context update-in [:node-map event-id] conj child)
(resolve-any-orphans ui-context event-id)
(add-references ui-context event)
))
(recur (rest tab-names)))))))
(defn resolve-any-orphans [ui-context parent-id]
(let [parent-node (first (get-in @ui-context [:node-map parent-id]))

View File

@ -45,7 +45,7 @@
(defn id-click [ui-context id]
(let [frame (:frame @ui-context)
tree (select frame [:#header-tree])
tree (select frame [:#all]) ;hack need to find a better solution.
model (config tree :model)
root-node (.getRoot model)
node (find-header-node root-node id)]

View File

@ -4,7 +4,7 @@
[more-speech.ui.formatters :as formatters])
(:use [seesaw core]))
(defn make-edit-window [kind event-agent header-tree]
(defn make-edit-window [kind event-agent]
(let [reply? (= kind :reply)
event-state @event-agent
subject-label (label "Subject:")
@ -18,12 +18,8 @@
:font config/default-font)
send-button (button :text "Send")
event-map (:text-event-map event-state)
selected-id (if reply?
(.getUserObject (last (selection header-tree)))
nil)
event (if reply?
(get event-map selected-id)
nil)]
selected-id (if reply? (:selected-event @event-agent) nil)
event (if reply? (get event-map selected-id) nil)]
(when reply?
(let [subject (formatters/get-subject (:tags event))
prefix (if (empty? subject) "" "Re: ")]

View File

@ -23,18 +23,32 @@
(declare timer-action)
(defn make-tabs [event-agent main-frame]
(let [tabs (:tabs @event-agent)]
(loop [tab-names (keys tabs)
header-tree-tabs []]
(if (empty? tab-names)
header-tree-tabs
(let [tab-name (first tab-names)
header-tree (article-tree/make-header-tree event-agent main-frame)
_ (config! header-tree
:user-data (get tabs tab-name)
:id tab-name)
tab-data {:title (name tab-name)
:content (scrollable header-tree)}]
(recur (rest tab-names) (conj header-tree-tabs tab-data)))
)))
)
(defn make-main-window [event-agent]
(let [main-frame (frame :title "More Speech" :size [1000 :by 1000])
article-area (article-panel/make-article-area)
header-tree (article-tree/make-article-tree event-agent main-frame)
header-tab-panel (tabbed-panel :tabs [{:title "All"
:content (scrollable header-tree)}])
header-tab-panel (tabbed-panel :tabs (make-tabs event-agent main-frame))
relay-panel (relay-panel/make-relay-panel)
header-panel (left-right-split (scrollable relay-panel)
header-tab-panel)
article-panel (border-panel :north (article-panel/make-article-info-panel)
:center (scrollable article-area)
:south (article-panel/make-control-panel event-agent header-tree))
:south (article-panel/make-control-panel event-agent))
main-panel (top-bottom-split
header-panel
article-panel