- do not climb the thread (probably colud be changed by a command line switch in the future)

when fetching messages.
- configurable color for root of rendered trees.

etc/default-theme.conf

@@ -177,17 +177,29 @@ thread-window.message.favourite.value              = "★"
 thread-window.message.favourite.foreground         = yellow
 
 # text to signal that this message is marked as sensible
-thread-window.message.sensitive.value              = "⚠ "
+thread-window.message.sensitive.value              = "⚠"
 
 # color of the text that signals that this message is marked as sensible
+
 thread-window.message.sensitive.foreground         = blue
 
 # text that signals that you boosted this message
 thread-window.message.boosted.value                = "♻"
 
 # color of the text that signals that you boosted this message
+
 thread-window.message.boosted.foreground           = cyan
 
+# text to signal that this message is  the root (on the server) of the
+# thread
+
+thread-window.message.root.value                   = "↓ "
+
+# color of the text that signals that this message is the root (on the server)
+# of the thread
+
+thread-window.message.root.foreground              = blue
+
 # the messages are organized in trees
 
 # color of the branch of the tree (the segments that connect messages)
@@ -208,6 +220,11 @@ thread-window.tree.data.foreground                 = white
 
 thread-window.tree.data-leaf.foreground            = white
 
+# color of the  subject  of  the message  (AKA  sensistive text)  for
+# message with no parents
+
+thread-window.tree.root.foreground                 = yellow
+
 # arrow that point to a message
 
 thread-window.tree.arrow.value                     = "🞂 "
@@ -308,6 +325,8 @@ keybindings-window.tree.branch.foreground          = red
 
 keybindings-window.tree.arrow.foreground           = magenta
 
+keybindings-window.tree.root.foreground            = #ffff00
+
 keybindings-window.tree.data.foreground            = white
 
 keybindings-window.tree.data-leaf.foreground       = cyan

src/api-client.lisp

@@ -318,8 +318,10 @@ authorizations was performed with success."
                                           :since-id   since-id
                                           :min-id     min-id
                                           :limit      limit))
-         (trees             (flatten (loop for node-status in timeline-statuses collect
+         (trees             (if command-line:*update-timeline-climb-message-tree*
-                                          (expand-status-tree node-status))))
+                                (flatten (loop for node-status in timeline-statuses collect
+                                              (expand-status-tree node-status)))
+                                timeline-statuses))
          (event             (make-instance 'program-events:save-timeline-in-db-event
                                            :payload       trees
                                            :kind          kind
@@ -368,8 +370,12 @@ authorizations was performed with success."
     (let* ((timeline-statuses         (get-timeline-tag tag
                                                         :min-id min-id
                                                         :limit  limit))
-           (trees                     (flatten (loop for node-status in timeline-statuses collect
+           (trees                     (if command-line:*update-timeline-climb-message-tree*
-                                                    (expand-status-tree node-status))))
+                                          (flatten (loop
+                                                      for node-status in timeline-statuses
+                                                      collect
+                                                        (expand-status-tree node-status)))
+                                          timeline-statuses))
            (save-timeline-in-db-event (make-instance 'program-events:save-timeline-in-db-event
                                                      :payload       trees
                                                      :timeline-type db:+federated-timeline+

src/command-line.lisp

@@ -81,6 +81,8 @@
 
 (defparameter *notify-mentions*                    nil)
 
+(defparameter *update-timeline-climb-message-tree* nil)
+
 (defun exit-on-error (e)
   (format *error-output* "~a~%" e)
   (os-utils:exit-program 1))

src/mtree-utils.lisp

@@ -600,7 +600,7 @@
                              (cat-line " ")))
                    (cond
                      ((rootp node)
-                      (append-build-element (cons :data data)))
+                      (append-build-element (cons :data-root data)))
                      ((last-child-p node child-pos)
                       (push indent-level empty-levels)
                       (build-element last-child-char data node))

src/package.lisp

@@ -873,6 +873,7 @@
    :+key-background+
    :+key-foreground+
    :+key-width+
+   :+key-root+
    :+key-height+
    :+key-value+
    :+key-new-message-mark+
@@ -1044,6 +1045,7 @@
    :*check-follow-requests*
    :*reset-timeline-pagination*
    :*notify-mentions*
+   :*update-timeline-climb-message-tree*
    :manage-opts))
 
 (defpackage :specials

src/software-configuration.lisp

@@ -321,6 +321,7 @@
                    left
                    right
                    stopper
+                   root
                    width
                    height
                    error
@@ -678,6 +679,11 @@
                            tree-win-holder
                            +key-tree+
                            +key-data-leaf+
+                           +key-foreground+)
+          (access:accesses *software-configuration*
+                           tree-win-holder
+                           +key-tree+
+                           +key-root+
                            +key-foreground+)))
 
 (defun tree-config-rendering-values (tree-win-holder)
@@ -711,12 +717,13 @@
   (let ((tree-color-map ()))
     (flet ((add-color-pair (key color)
              (setf tree-color-map (acons key color tree-color-map))))
-      (multiple-value-bind (branch-color arrow-color data-color leaf-color)
+      (multiple-value-bind (branch-color arrow-color data-color leaf-color root-color)
           (swconf:tree-config-colors window-key)
         (add-color-pair :branch    branch-color)
         (add-color-pair :arrow     arrow-color)
         (add-color-pair :data      data-color)
-        (add-color-pair :data-leaf leaf-color))
+        (add-color-pair :data-leaf leaf-color)
+        (add-color-pair :data-root root-color))
       tree-color-map)))
 
 (defun thread-message-symbol-lookup (field key)

src/thread-window.lisp

@@ -33,6 +33,10 @@
     :initform "!"
     :initarg  :sensitive-text
     :accessor sensitive-text)
+   (root-text
+    :initform "*"
+    :initarg  :root-text
+    :accessor root-text)
    (favourite-text-off
     :initform "~+1"
     :initarg  :favourite-text-off
@@ -45,6 +49,10 @@
     :initform "!"
     :initarg  :sensitive-text-off
     :accessor sensitive-text-off)
+   (root-text-off
+    :initform "*"
+    :initarg  :root-text-off
+    :accessor root-text-off)
    (read-fg
     :initform :black
     :initarg  :read-fg
@@ -236,7 +244,8 @@
                                       :attributes (attribute-invisible))))))
       (set-symbol 'favourite-text 'favourite-text-off swconf:+key-favourite+)
       (set-symbol 'sensitive-text 'sensitive-text-off swconf:+key-sensitive+)
-      (set-symbol 'boosted-text   'boosted-text-off   swconf:+key-boosted+))
+      (set-symbol 'boosted-text   'boosted-text-off   swconf:+key-boosted+)
+      (set-symbol 'root-text      'root-text-off      swconf:+key-root+))
     (win-move object
               (- (win-width *main-window*)
                  (win-width object))
@@ -440,7 +449,11 @@ db:renumber-timeline-message-index."
    (deletedp
     :initform nil
     :initarg  :deletedp
-    :accessor deletedp)))
+    :accessor deletedp)
+   (root-message-p
+    :initform nil
+    :initarg  :root-message-p
+    :accessor root-message-p)))
 
 (defun make-message-row-prefix (window fields index max-index max-author-length)
   (with-accessors ((favourite-text      favourite-text)
@@ -456,6 +469,7 @@ db:renumber-timeline-message-index."
              (created-at          (db-utils:db-getf  fields :created-at))
              (redp                (db-utils:db-getf  fields :redp))
              (deletedp            (db-utils:db-getf  fields :deletedp))
+             (rootp               (not (db-utils:db-getf  fields :in-reply-to-id)))
              (encoded-date        (db-utils:encode-datetime-string created-at))
              (formatted-date      (append-space (format-time encoded-date date-format)))
              (padding-index-count (num:count-digit max-index))
@@ -468,7 +482,8 @@ db:renumber-timeline-message-index."
                        :creation-date  formatted-date
                        :author         padded-author
                        :redp           redp
-                       :deletedp      deletedp)))))
+                       :deletedp       deletedp
+                       :root-message-p rootp)))))
 
 (defun pad-row-prefix (prefixes)
   (flet ((find-max (slot)
@@ -493,6 +508,8 @@ db:renumber-timeline-message-index."
                    (boosted-text-off   boosted-text-off)
                    (sensitive-text     sensitive-text)
                    (sensitive-text-off sensitive-text-off)
+                   (root-text          root-text)
+                   (root-text-off      root-text-off)
                    (read-fg            read-fg)
                    (read-bg            read-bg)
                    (read-attribute     read-attribute)
@@ -516,6 +533,7 @@ db:renumber-timeline-message-index."
            (raw-selected-message "")
            (raw-deleted-message  "")
            (redp                 (redp           message-prefix-info))
+           (rootp                (root-message-p message-prefix-info))
            (fg                   (if redp
                                     read-fg
                                     unread-fg))
@@ -584,6 +602,15 @@ db:renumber-timeline-message-index."
               (deleted-message-invisible-text sensitive-text-off)
               (selected-message-invisible-text sensitive-text-off)
               (message-cat sensitive-text-off)))
+        (if rootp
+            (progn
+              (deleted-message-cat root-text)
+              (selected-message-cat root-text)
+              (message-cat root-text))
+            (progn
+              (deleted-message-invisible-text root-text-off)
+              (selected-message-invisible-text root-text-off)
+              (message-cat root-text-off)))
         (message-cat rendered-tree-line)
         (selected-message-cat rendered-tree-line)
         (deleted-message-cat rendered-tree-line)
@@ -665,8 +692,7 @@ db:renumber-timeline-message-index."
     object)
 
 (defmethod go-message-down ((object thread-window))
-  (with-accessors ((tree-color-map     tree-color-map)
+  (with-accessors ((selected-bg        selected-bg)
-                   (selected-bg        selected-bg)
                    (selected-fg        selected-fg)
                    (row-selected-index row-selected-index)
                    (timeline-type      timeline-type)
@@ -690,8 +716,7 @@ db:renumber-timeline-message-index."
         (draw object)))))
 
 (defmethod go-message-up ((object thread-window))
-  (with-accessors ((tree-color-map     tree-color-map)
+  (with-accessors ((selected-bg        selected-bg)
-                   (selected-bg        selected-bg)
                    (selected-fg        selected-fg)
                    (row-selected-index row-selected-index)
                    (timeline-type      timeline-type)

src/tui-utils.lisp

@@ -108,7 +108,8 @@
         (:branch    . branch-color)
         (:arrow     . arrow-color)
         (:data      . data-color)
-        (:data-leaf . leaf-color)"
+        (:data-leaf . leaf-color)
+        (:data-root . root-color)"
   (let ((semantic-value (annotated-text-symbol annotated-element))
         (value          (annotated-text-value  annotated-element)))
     (make-tui-string value :fgcolor (cdr (assoc semantic-value color-map)))))