cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-01 04:26:47 +01:00
Code Issues

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

Browse Source 
when fetching messages.
- configurable color for root of rendered trees.
This commit is contained in:
cage 2020-06-12 18:10:01 +02:00
parent a04c42b5ef
commit 387cd85c0a
8 changed files with 90 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
etc/default-theme.conf
View File

@ -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

14
src/api-client.lisp
View File

@ -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
(expand-status-tree node-status))))
(trees (if command-line:*update-timeline-climb-message-tree*
(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
(expand-status-tree node-status))))
(trees (if command-line:*update-timeline-climb-message-tree*
(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+

16
src/command-line.lisp
View File

@ -67,19 +67,21 @@
:long "notify-mentions")))
(defparameter *start-folder* nil)
(defparameter *start-folder* nil)
(defparameter *start-timeline* nil)
(defparameter *start-timeline* nil)
(defparameter *update-timeline* nil)
(defparameter *update-timeline* nil)
(defparameter *script-file* nil)
(defparameter *script-file* nil)
(defparameter *check-follow-requests* nil)
(defparameter *check-follow-requests* nil)
(defparameter *reset-timeline-pagination* nil)
(defparameter *reset-timeline-pagination* nil)
(defparameter *notify-mentions* nil)
(defparameter *notify-mentions* nil)
(defparameter *update-timeline-climb-message-tree* nil)
(defun exit-on-error (e)
(format *error-output* "~a~%" e)

2
src/mtree-utils.lisp
View File

@ -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))

2
src/package.lisp
View File

@ -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

11
src/software-configuration.lisp
View File

@ -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)

49
src/thread-window.lisp
View File

@ -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))
@ -464,11 +478,12 @@ db:renumber-timeline-message-index."
(padded-author (append-space (text-utils:right-padding author
max-author-length))))
(make-instance 'row-prefix
:index padded-index
:creation-date formatted-date
:author padded-author
:redp redp
:deletedp deletedp)))))
:index padded-index
:creation-date formatted-date
:author padded-author
:redp redp
: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)
@ -515,7 +532,8 @@ db:renumber-timeline-message-index."
(message (make-tui-string ""))
(raw-selected-message "")
(raw-deleted-message "")
(redp (redp message-prefix-info))
(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)
(selected-bg selected-bg)
(with-accessors ((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)
(selected-bg selected-bg)
(with-accessors ((selected-bg selected-bg)
(selected-fg selected-fg)
(row-selected-index row-selected-index)
(timeline-type timeline-type)

3
src/tui-utils.lisp
View File

@ -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)))))