From 52f550df5eec5b46a0a5b9bc303621820dcad214 Mon Sep 17 00:00:00 2001 From: cage Date: Thu, 10 Sep 2020 17:50:22 +0200 Subject: [PATCH] - added feature create new chat; - fixed crash when selecting a chat with no messages. --- etc/init.lisp | 6 ++++++ src/api-pleroma.lisp | 4 ++++ src/line-oriented-window.lisp | 6 ++++-- src/message-window.lisp | 5 ++++- src/package.lisp | 7 ++++++- src/program-events.lisp | 19 ++++++++++++++++++ src/ui-goodies.lisp | 38 +++++++++++++++++++++++++++++++++++ 7 files changed, 81 insertions(+), 4 deletions(-) diff --git a/etc/init.lisp b/etc/init.lisp index 11c8ee4..c93e082 100644 --- a/etc/init.lisp +++ b/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 () diff --git a/src/api-pleroma.lisp b/src/api-pleroma.lisp index a41b2d3..a90dd0e 100644 --- a/src/api-pleroma.lisp +++ b/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)) diff --git a/src/line-oriented-window.lisp b/src/line-oriented-window.lisp index ebaf32d..e8cd75d 100644 --- a/src/line-oriented-window.lisp +++ b/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 diff --git a/src/message-window.lisp b/src/message-window.lisp index 3973f4a..2cb465e 100644 --- a/src/message-window.lisp +++ b/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) diff --git a/src/package.lisp b/src/package.lisp index aa698a2..651bb90 100644 --- a/src/package.lisp +++ b/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 diff --git a/src/program-events.lisp b/src/program-events.lisp index 9dfdd33..aa16598 100644 --- a/src/program-events.lisp +++ b/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) ()) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 48414b5..60af5f4 100644 --- a/src/ui-goodies.lisp +++ b/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 ()