From 8d1bc99472558ec8d2470bc1f2a553b8944f5d42 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Sun, 1 Sep 2024 12:06:23 +0200
Subject: [PATCH] - added comments when composing posts.

---
 etc/shared.conf           |  2 +-
 src/emoji-shortcodes.lisp | 45 +++++++++++++++++++++++++++++++++++++++
 src/package.lisp          |  4 +++-
 src/ui-goodies.lisp       | 32 ++++++++++++++++++++--------
 4 files changed, 72 insertions(+), 11 deletions(-)

diff --git a/etc/shared.conf b/etc/shared.conf
index 179a590..5f0c57b 100644
--- a/etc/shared.conf
+++ b/etc/shared.conf
@@ -40,7 +40,7 @@ editor                                      = "nano --locking"
 # prefix for comments line when composing a post
 # line starting with this prefix will *not* be sent to the server
 
-post.comment-line.prefix                    = ";;"
+post.comment-line.prefix                    = ";"
 
 # allowed  languages post,  if the  regex  does not  match the  post's
 # language the post is discarded
diff --git a/src/emoji-shortcodes.lisp b/src/emoji-shortcodes.lisp
index 80df6c2..9c8b789 100644
--- a/src/emoji-shortcodes.lisp
+++ b/src/emoji-shortcodes.lisp
@@ -997,3 +997,48 @@
                                            text
                                            (cdr mapping))))
   text)
+
+(defun print-comment-prefix (stream
+                             format-argument
+                             colon-modifier-supplied-p
+                             at-sign-modifier-supplied-p
+                             &optional (repetitions 1))
+  (declare (ignore format-argument
+                   colon-modifier-supplied-p
+                   at-sign-modifier-supplied-p
+                   repetitions))
+  (write-string (swconf:config-post-comment-prefix) stream))
+
+(defun emoji-shortcode-as-comment ()
+  (let ((emojis (list "🤬" "🧐" "🤯" "🤮" "🤨" "🤫"
+                      "🤪" "🤩" "👿" "😈" "😠" "😡"
+                      "😫" "😩" "😓" "😞" "😣" "😖"
+                      "😭" "😢" "😥" "😰" "😨" "😧"
+                      "😳" "😲" "😯" "😮" "🙁" "😟"
+                      "🤓" "😎" "😵" "🤕" "🤒" "😷"
+                      "🤭" "😤" "😱" "😦" "😕" "😴"
+                      "😪" "😔" "😌" "😬" "🙄" "😒"
+                      "😏" "😶" "😑" "🤐" "🤔" "🤗"
+                      "🤑" "😝" "😜" "😛" "😋" "😙"
+                      "😚" "😗" "😘" "😍" "😇" "😊"
+                      "😉" "🙃" "🙂" "😂" "😅" "😆"
+                      "😁" "😄" "😃" "😀" "🤠" "🤧"
+                      "🤢" "🤤" "🤥" "🤣" "👏" "👊"
+                      "✊" "🖕" "🤘" "👌" "🖖" "✋"
+                      "👋" "🤝" "🤜" "🤛" "🤙" "🤞"
+                      "🤚" "🙏" "👍")))
+      (with-output-to-string (stream)
+        (format stream
+                "~{~/emoji-shortcodes::print-comment-prefix/ ~a~^~a~^~a~^~a~^~%~}"
+                (mapcar (lambda (emoji)
+                          (a:when-let ((shortcodes-found (remove-if-not (lambda (a)
+                                                                          (string= emoji
+                                                                                   (cdr a)))
+                                                                        *shortcodes-db*)))
+                            (with-output-to-string (emoji-stream)
+                              (loop for shortcode in shortcodes-found do
+                                (format emoji-stream
+                                        "~a ~a "
+                                        (car shortcode)
+                                        (cdr shortcode))))))
+                        emojis)))))
diff --git a/src/package.lisp b/src/package.lisp
index d8600eb..0af4333 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1215,10 +1215,12 @@
 
 (defpackage :emoji-shortcodes
   (:use :cl)
+  (:local-nicknames (:a :alexandria))
   (:export
    :initialize
    :shortcode-lookup
-   :emojify))
+   :emojify
+   :emoji-shortcode-as-comment))
 
 (defpackage :software-configuration
   (:use
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index 1e4ce21..ae8e21f 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -1429,6 +1429,17 @@ It an existing file path is provided the command will refuse to run."
                                  :initial-value (swconf:config-default-post-language)
                                  :prompt (_ "Add language of the post: ")
                                  :complete-fn #'complete:language-codes)))
+           (remove-comments (body)
+             (when-let* ((lines      (split-lines body))
+                         (comment-re (strcat "^" (swconf:config-post-comment-prefix) ".*"))
+                         (stripped   (remove-if #'string-empty-p
+                                                (mapcar (lambda (a)
+                                                          (cl-ppcre:regex-replace comment-re
+                                                                                  a
+                                                                                  ""))
+                                                        lines))))
+               (join-with-strings stripped
+                                  (format nil "~%"))))
            (add-body ()
              (let ((temp-file (fs:temporary-file)))
                (insert-header-text temp-file)
@@ -1443,15 +1454,18 @@ It an existing file path is provided the command will refuse to run."
                                0)
                             (> (fs:get-stat-mtime temp-file)
                                reference-open-file))
-                   (let ((body (emoji-shortcodes:emojify (fs:slurp-file temp-file))))
-                     ;; saving "emojified" message
-                     (with-open-file (stream temp-file
-                                             :direction :output
-                                             :if-exists :supersede
-                                             :if-exists :error)
-                       (write-string body stream))
-                     (setf (sending-message:body *message-to-send*) body)
-                     (add-language)))))))
+                   (let ((body (remove-comments
+                                (emoji-shortcodes:emojify
+                                 (fs:slurp-file temp-file)))))
+                     (when (string-not-empty-p body)
+                       ;; saving "emojified" and uncommented message
+                       (with-open-file (stream temp-file
+                                               :direction :output
+                                               :if-exists :supersede
+                                               :if-exists :error)
+                         (write-string body stream))
+                       (setf (sending-message:body *message-to-send*) body)
+                       (add-language))))))))
     (add-body)))
 
 (defun edit-posted-message ()