- improved rendering for statuses that contains tag: <li> and <blockquote>.

etc/default-theme.conf

@@ -491,6 +491,11 @@ message-window.visibility.private                    = "🔒"
 
 message-window.visibility.direct                     = "📧"
 
+message-window.quote.prefix                          = "🞂 "
+
+message-window.bullet.prefix                         = "• "
+
+
 # this is the window that allow to browse the attachments of a message
 
 open-attach-window.background                        = black

src/chats-list-window.lisp

@@ -66,7 +66,9 @@
                     (_ "~a ~a wrote:~%~a ~a~2%")
                     formatted-created-date
                     username
-                    (html-utils:html->text content)
+                    (html-utils:html->text content
+                                           :quote-prefix (swconf:message-window-quote-prefix)
+                                           :list-item-prefix (swconf:message-window-bullet-prefix))
                     attachment-type)))))))
 
 (defmethod resync-rows-db ((object chats-list-window)

src/html-utils.lisp

@@ -23,8 +23,12 @@
 
 (define-constant +tag-paragraph+     "p" :test #'string=)
 
+(define-constant +tag-list-item+    "li" :test #'string=)
+
 (define-constant +tag-div+         "div" :test #'string=)
 
+(define-constant +tag-blockquote+  "blockquote" :test #'string=)
+
 (define-constant +attribute-url+  "href" :test #'string=)
 
 (define-constant +http-scheme+    "http" :test #'string=)
@@ -96,7 +100,11 @@
 (defun node->link (node)
   (html-utils:attribute-value (html-utils:find-attribute :href node)))
 
-(defun html->text (html &key (add-link-footnotes t) (body-footnotes-separator ""))
+(defparameter *prefix-text-line* "")
+
+(defun html->text (html &key
+                          (add-link-footnotes t) (body-footnotes-separator "")
+                          (quote-prefix "> ") (list-item-prefix "* "))
   "Transform html to text, note that if `add-link-footnotes` is non nil footnotes that marks html link in the text are added aftere the body of the message
 
 This function uses a library that transform html5 text into s-expressions um the form
@@ -122,7 +130,7 @@ Some convenience functions are provided to works with these structures.
                      (when node
                        (cond
                          ((stringp node)
-                          (princ node body-stream))
+                          (princ (strcat *prefix-text-line* node) body-stream))
                          ((consp (car node))
                           (descend (car node)))
                          ((tag= +tag-link+ node)
@@ -148,6 +156,13 @@ Some convenience functions are provided to works with these structures.
                           (format body-stream "~%")
                           (descend-children node)
                           (format body-stream "~%"))
+                         ((tag= +tag-list-item+ node)
+                          (format body-stream list-item-prefix)
+                          (descend-children node)
+                          (format body-stream "~%"))
+                         ((tag= +tag-blockquote+ node)
+                          (let ((*prefix-text-line* quote-prefix))
+                            (descend-children node)))
                          (t
                           (descend-children node))))))
             (descend root)

src/message-rendering-utils.lisp

@@ -119,7 +119,9 @@
 (defun maybe-decrypt-message (message-row message-text &key (notify-cant-decrypt nil))
   (let* ((username      (db:row-message-username message-row))
          (html-stripped (html-utils:html->text (db:row-message-content message-row)
-                                               :add-link-footnotes nil))
+                                               :add-link-footnotes nil
+                                               :quote-prefix (swconf:message-window-quote-prefix)
+                                               :list-item-prefix (swconf:message-window-bullet-prefix)))
          (mention       (find-first-mention-in-message html-stripped))
          (reply-p       (db:row-message-reply-to-id message-row))
          (crypto-key    (cond
@@ -197,7 +199,9 @@
 (defgeneric message-original->text-body (object &key &allow-other-keys))
 
 (defmethod message-original->text-body ((object string) &key &allow-other-keys)
-  (let* ((raw-body (html-utils:html->text object)))
+  (let* ((raw-body (html-utils:html->text object
+                                          :quote-prefix (swconf:message-window-quote-prefix)
+                                          :list-item-prefix (swconf:message-window-bullet-prefix))))
     (emoji-shortcodes:emojify raw-body)))
 
 (defun prepend-crypto-marker (decrypted-text)

src/package.lisp

@@ -773,16 +773,16 @@
    :ipv6-address-p
    :iri-to-parent-path))
 
-(defpackage :link-header-parser
+;; (defpackage :link-header-parser
-  (:use
+;;   (:use
-   :cl
+;;    :cl
-   :alexandria
+;;    :alexandria
-   :esrap
+;;    :esrap
-   :cl-ppcre
+;;    :cl-ppcre
-   :text-utils)
+;;    :text-utils)
-  (:export
+;;   (:export
-   :parse-header
+;;    :parse-header
-   :extract-pagination-current-max-id))
+;;    :extract-pagination-current-max-id))
 
 (defpackage :tour-mode-parser
   (:use
@@ -1466,6 +1466,8 @@
    :message-window-line-mark-values
    :message-windows-visibility-marks
    :message-window-attachments-header
+   :message-window-quote-prefix
+   :message-window-bullet-prefix
    :form-style
    :background
    :foreground

src/program-events.lisp

@@ -1877,7 +1877,10 @@
 (defmethod process-event ((object show-announcements-event))
   "Shows a window with all announcements"
   (when-let* ((all-announcements (api-client:get-announcements))
-              (all-texts         (mapcar #'html-utils:html->text
+              (all-texts         (mapcar (lambda (a)
+                                           (html-utils:html->text a
+                                                                  :quote-prefix (swconf:message-window-quote-prefix)
+                                                                  :list-item-prefix (swconf:message-window-bullet-prefix)))
                                          (mapcar #'tooter:content all-announcements)))
               (lines             (reduce #'append
                                          (mapcar #'text-utils:split-lines all-texts)))

src/software-configuration.lisp

@@ -1433,6 +1433,18 @@
                                 +key-mark+
                                 +key-value+)))
 
+(defun message-window-quote-prefix ()
+  (access-non-null-conf-value *software-configuration*
+                              +key-message-window+
+                              +key-quote+
+                              +key-prefix+))
+
+(defun message-window-bullet-prefix ()
+  (access-non-null-conf-value *software-configuration*
+                              +key-message-window+
+                              +key-bullet+
+                              +key-prefix+))
+
 (defun message-window-locked-account-mark ()
   (locked/unlocked-account-mark-value +key-message-window+ t))
 

src/ui-goodies.lisp

@@ -965,7 +965,9 @@ It an existing file path is provided the command will refuse to run."
                (let* ((row              (mtree:data node))
                       (content          (html-utils:html->text (db:row-message-content row)
                                                                :body-footnotes-separator
-                                                               (format nil (_ "───── links ───── ~%"))))
+                                                               (format nil (_ "───── links ───── ~%"))
+                                                               :quote-prefix (swconf:message-window-quote-prefix)
+                                                               :list-item-prefix (swconf:message-window-bullet-prefix)))
                       (author           (format nil "~a (~a)"
                                                 (db:row-message-username row)
                                                 (db:row-message-user-display-name row)))