- added feature create new chat;

- fixed crash when selecting a chat with no messages.

etc/init.lisp

@@ -375,6 +375,12 @@
 
 (define-key "l"         #'change-chat-label                             *chats-list-keymap*)
 
+(define-key "c"         #'chat-create-new                               *chats-list-keymap*)
+
+(define-key "up"        #'chat-list-go-up                               *chats-list-keymap*)
+
+(define-key "down"      #'chat-list-go-down                             *chats-list-keymap*)
+
 ;; chat  window
 
 (defun write-to-chat ()

src/api-pleroma.lisp

@@ -102,3 +102,7 @@ media `media'. Returns a `chat-message' instance"
   (if (cl-ppcre:scan "^/" message)
       (api-pleroma:post-chat-message api-client:*client* chat-id nil message)
       (api-pleroma:post-chat-message api-client:*client* chat-id message nil)))
+
+(defun-w-lock create-new-chat (user-id)
+    api-client:*client-lock*
+  (create-chat api-client:*client* user-id))

src/line-oriented-window.lisp

@@ -218,10 +218,12 @@
 (defmethod row-move ((object row-oriented-widget) amount)
   "Navigate the lines, move the  selected row by `amount', returns the
 actual of  rows moved. This can  be different from `amount'  if moving
-this exact quantity wold go beyond the length or fows or zero."
+this exact quantity wold go beyond the length or rows or zero."
   (with-accessors ((rows               rows)
                    (row-selected-index row-selected-index)) object
-    (if (/= 0 amount)
+    (if (and rows
+             row-selected-index
+             (/= 0 amount))
         (let* ((desired-amount (+ amount row-selected-index))
                (actual-amount  (if (< amount 0)
                                    (max (- desired-amount

src/message-window.lisp

@@ -47,7 +47,10 @@
 
 (defmethod (setf source-text) (new-text (object message-window))
   (setf (slot-value object 'source-text) new-text)
-  (prepare-for-rendering object))
+  (handler-bind ((conditions:out-of-bounds
+                  (lambda (e)
+                    (invoke-restart 'ignore-selecting-action e))))
+    (prepare-for-rendering object)))
 
 (defun refresh-line-mark-config (window)
   (multiple-value-bind (mark-value mark-fg mark-bg)

src/package.lisp

@@ -1248,6 +1248,7 @@
    :update-all-chat-messages-event
    :chat-post-message-event
    :chat-change-label-event
+   :chat-create-event
    :function-event
    :dispatch-program-events
    :add-pagination-status-event
@@ -1285,7 +1286,8 @@
    :delete-chat-message
    :get-chat-messages
    :get-chats
-   :post-on-chat))
+   :post-on-chat
+   :create-new-chat))
 
 (defpackage :api-client
   (:use
@@ -2193,6 +2195,9 @@
    :chat-loop
    :open-chat-link-window
    :change-chat-label
+   :chat-create-new
+   :chat-list-go-up
+   :chat-list-go-down
    :open-gemini-address
    :gemini-history-back
    :gemini-view-source

src/program-events.lisp

@@ -1077,6 +1077,25 @@
     (db:chat-change-label chat-id label)
     (line-oriented-window:resync-rows-db specials:*chats-list-window*)))
 
+(defclass chat-create-event (program-event)
+  ((user-id
+    :initform nil
+    :initarg :user-id
+    :accessor user-id)
+   (chat-label
+    :initform (_ "no label")
+    :initarg  :chat-label
+    :accessor chat-label)))
+
+(defmethod process-event ((object chat-create-event))
+  (with-accessors ((chat-label chat-label)
+                   (user-id    user-id)) object
+    (let ((chat (api-pleroma:create-new-chat user-id)))
+      (db:update-db chat)
+      (process-event (make-instance 'chat-change-label-event
+                                    :chat-id (api-pleroma:chat-id chat)
+                                    :label   chat-label)))))
+
 ;;;; general usage
 
 (defclass function-event (program-event) ())

src/ui-goodies.lisp

@@ -1483,6 +1483,7 @@ mot recent updated to least recent"
     (focus-to-open-message-link-window)))
 
 (defun change-chat-label ()
+  "Change the name (called label) of a chat"
   (let* ((fields  (line-oriented-window:selected-row-fields *chats-list-window*))
          (chat-id (db:row-id fields)))
     (flet ((on-input-complete (new-label)
@@ -1494,6 +1495,43 @@ mot recent updated to least recent"
                         :prompt      (_ "Type the new label of the chat: ")
                         :complete-fn #'complete:complete-chat-message))))
 
+(defun chat-create-new ()
+  "Start a new chat"
+  (let ((chat-user-id  nil)
+        (chat-username nil))
+    (labels  ((on-user-id-complete (username)
+                (when (string-not-empty-p username)
+                  (when-let* ((user-id (db:username->id username)))
+                    (setf chat-user-id  user-id)
+                    (setf chat-username username)
+                    (ask-string-input #'on-label-complete
+                                      :prompt (_ "Type the new label of the chat: ")))))
+              (on-label-complete (chat-label)
+                (when (string-not-empty-p chat-label)
+                  (push-event (make-instance 'chat-create-event
+                                             :chat-label chat-label
+                                             :user-id    chat-user-id))
+                  (update-all-chats-data)
+                  (notify (format nil
+                                  (_ "Chat ~a with ~a created")
+                                  chat-label
+                                  chat-username)))))
+      (ask-string-input #'on-user-id-complete
+                        :prompt      (_ "Type the user to chat with: ")
+                        :complete-fn #'complete:username-complete))))
+
+(defun chat-list-move (amount)
+  (ignore-errors
+    (line-oriented-window:unselect-all specials:*chats-list-window*)
+    (line-oriented-window:row-move     specials:*chats-list-window* amount)
+    (draw specials:*chats-list-window*)))
+
+(defun chat-list-go-up ()
+  (chat-list-move -1))
+
+(defun chat-list-go-down ()
+  (chat-list-move 1))
+
 ;;;; gemini
 
 (defun open-gemini-address ()