;; tinmop: a multiprotocol client ;; Copyright © cage ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. ;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. (in-package :chats-list-window) (defclass chats-list-window (focus-marked-window simple-line-navigation-window title-window border-window) ()) (defmethod refresh-config :after ((object chats-list-window)) (open-attach-window:refresh-view-links-window-config object swconf:+key-chats-list-window+) (refresh-config-sizes object swconf:+key-thread-window+) (win-move object (- (win-width *main-window*) (win-width object)) 0) (win-move object (- (win-width *main-window*) (win-width object)) 0) object) (defun chat->list-item (chat-db-row) (format nil (_ "~a ~a unread: ~a") (db:row-label chat-db-row) (db:user-id->username (db:row-account-id chat-db-row)) (db:count-unread-chat-messages (db:row-id chat-db-row)))) (defun chat->text (chat-db-row &key (skip-ignored-user t)) (with-output-to-string (stream) (let ((all-messages (db:all-chat-messages (db:row-id chat-db-row)))) (dolist (message all-messages) (when (and skip-ignored-user (not (db:user-ignored-p (db:row-account-id message)))) (let* ((date-fmt (or (swconf:date-fmt swconf:+key-chat-window+) (swconf:date-fmt swconf:+key-thread-window+))) (created-date (db:row-created-at message)) (encoded-created-date (db-utils:encode-datetime-string created-date)) (formatted-created-date (format-time encoded-created-date date-fmt)) (attachment (db:attachment-to-chat-message (db:row-id message))) (attachment-type (if attachment (format nil "~a attachment" (db:row-type attachment)) "")) (content (or (db:row-message-content message) "")) (username (db:user-id->username (db:row-account-id message)))) (format stream (_ "~a ~a wrote:~%~a ~a~2%") formatted-created-date username (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) &key (redraw t) (suggested-message-index nil)) (with-accessors ((rows rows) (selected-line-bg selected-line-bg) (selected-line-fg selected-line-fg)) object (flet ((make-rows (chats bg fg) (mapcar (lambda (chat) (make-instance 'line :normal-text (chat->list-item chat) :selected-text (chat->list-item chat) :fields chat :normal-bg fg :normal-fg bg :selected-bg bg :selected-fg fg)) chats))) (with-croatoan-window (croatoan-window object) (line-oriented-window:update-all-rows object (make-rows (db:all-chats) selected-line-bg selected-line-fg)) (when suggested-message-index (select-row object suggested-message-index)) (when redraw (draw object)))))) (defun open-chats-list-window () (let* ((low-level-window (make-croatoan-window :enable-function-keys t))) (setf *chats-list-window* (make-instance 'chats-list-window :top-row-padding 0 :title (_ "Current chats") :single-row-height 1 :uses-border-p t :keybindings keybindings:*chats-list-keymap* :croatoan-window low-level-window)) (refresh-config *chats-list-window*) (resync-rows-db *chats-list-window* :redraw nil) (when (not (line-oriented-window:rows-empty-p *chats-list-window*)) (select-row *chats-list-window* 0)) (draw *chats-list-window*) *chats-list-window*))