- fixed tags usage histogram.

src/api-client.lisp

@@ -477,6 +477,14 @@ become an emty string (\"\")
             ""
             nil))))
 
+(defun-api-call tag-information (tag)
+  "Get-information about a `tag' (returns a tooter:tag object)"
+  (tooter:tag-information *client* tag))
+
+(defun-api-call tag-history (tag)
+  (when-let ((tag-info (tooter:tag-information *client* tag)))
+    (tooter:history tag-info)))
+
 (defun-api-call update-subscribed-tags (all-tags all-paginations &key (limit 20))
   "Update all tage in the list `all-tags'"
   (loop

src/db.lisp

@@ -1227,7 +1227,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
                                     (from +table-tag-histogram+)
                                     (where (:and (:= :day  actual-day)
                                                  (:= :tag   tag)
-                                                 (:> :count use-count)))))))
+                                                 (:< :count use-count)))))))
       (cond
         ((not entry-exists-p)
          (query (make-insert +table-tag-histogram+

src/package.lisp

@@ -1703,6 +1703,7 @@
    :notify-fetched-new-tag-messages-event
    :tag-mark-got-messages-event
    :refresh-tag-window-event
+   :update-tags-histograms-event
    :update-conversations-event
    :change-conversation-name-event
    :old-name
@@ -1820,6 +1821,8 @@
    :update-timeline
    :tag->folder-name
    :tag-name
+   :tag-information
+   :tag-history
    :update-subscribed-tags
    :fetch-remote-status
    :get-remote-status

src/program-events.lisp

@@ -984,6 +984,14 @@
 (defmethod process-event ((object refresh-tag-window-event))
   (tags-window:resync-rows-db specials:*tags-window*))
 
+(defclass update-tags-histograms-event (program-event) ())
+
+(defmethod process-event ((object update-tags-histograms-event))
+  (loop for subscribed-tag in (db:all-subscribed-tags-name :as-folder-name nil) do
+    (when-let ((tag-history (api-client:tag-history subscribed-tag)))
+      (loop for history-entry in tag-history do
+        (db:update-db history-entry :tag (db:folder-name->tag subscribed-tag))))))
+
 (defclass update-conversations-event (program-event
                                       event-with-timeline-and-folder)
   ())

src/ui-goodies.lisp

@@ -1054,10 +1054,14 @@ It an existing file path is provided the command will refuse to run."
                      (make-instance 'notify-fetched-new-tag-messages-event))
                    (update-subscribed-event
                      (make-instance 'update-last-refresh-subscribe-tags-event))
-                   (refresh-window-event  (make-instance 'refresh-tag-window-event)))
+                   (update-tag-histogram-events
+                     (make-instance 'update-tags-histograms-event))
+                   (refresh-window-event
+                     (make-instance 'refresh-tag-window-event)))
                (push-event update-got-message-event)
                (push-event notify-event)
                (push-event update-subscribed-event)
+               (push-event update-tag-histogram-events)
                (push-event refresh-window-event))))
       (notify (_ "Downloading tags messages"))
       (update)