;; 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 . (in-package :conversations-window) (defclass conversations-window (focus-marked-window simple-line-navigation-window title-window border-window) ((read-message-fg :initarg :read-message-fg :initform nil :accessor read-message-fg :documentation "Read message foreground color") (read-message-bg :initarg :read-message-bg :initform nil :accessor read-message-bg :documentation "Read message background color") (unread-message-fg :initarg :unread-message-fg :initform nil :accessor unread-message-fg :documentation "Unread message foreground color") (unread-message-bg :initarg :unread-message-bg :initform nil :accessor unread-message-bg :documentation "unread message background color")) (:documentation "The window that shows active conversation")) (defmethod refresh-config :after ((object conversations-window)) (with-accessors ((croatoan-window croatoan-window) (histogram-fg histogram-fg) (read-message-fg read-message-fg) (read-message-bg read-message-bg) (selected-line-bg selected-line-bg) (selected-line-fg selected-line-fg) (unread-message-fg unread-message-fg) (unread-message-bg unread-message-bg)) object (let* ((theme-style (swconf:form-style swconf:+key-conversations-window+)) (fg (swconf:foreground theme-style)) (bg (swconf:background theme-style)) (selected-fg (swconf:selected-foreground theme-style)) (selected-bg (swconf:selected-background theme-style)) (width (- (win-width *main-window*) (win-width *thread-window*))) (y (win-height *tags-window*)) (height (- (win-height *main-window*) (win-height *command-window*) (win-height *tags-window*))) (x 0)) (multiple-value-bind (fg-read bg-read) (swconf:conversation-window-read-colors) (multiple-value-bind (fg-unread bg-unread) (swconf:conversation-window-unread-colors) (setf read-message-bg bg-read) (setf read-message-fg fg-read) (setf unread-message-bg bg-unread) (setf unread-message-fg fg-unread) (setf (c:background croatoan-window) (tui:make-win-background bg)) (setf (c:bgcolor croatoan-window) bg) (setf (c:fgcolor croatoan-window) fg) (setf selected-line-fg selected-fg) (setf selected-line-bg selected-bg) (win-resize object width height) (win-move object x y) object))))) (defmethod draw :before ((object conversations-window)) (with-accessors ((single-row-height single-row-height) (top-row-padding top-row-padding) (read-message-fg read-message-fg) (read-message-bg read-message-bg) (unread-message-fg unread-message-fg) (unread-message-bg unread-message-bg)) object (win-clear object) (with-croatoan-window (croatoan-window object) (loop for y from (+ 2 top-row-padding) by single-row-height for row-fields in (line-oriented-window:map-rows object #'fields) do (let ((attributes-to-read (if (= (db:messages-to-read row-fields) 0) (attribute-dim) (attribute-bold)))) (print-text object (text-utils:to-s (db:messages-to-read row-fields)) 1 y :bgcolor unread-message-bg :fgcolor unread-message-fg :attributes attributes-to-read) (print-text object "/" nil nil) (print-text object (text-utils:to-s (+ (db:messages-to-read row-fields) (db:messages-red row-fields))) nil nil :bgcolor read-message-bg :fgcolor read-message-fg)))))) (defmethod resync-rows-db ((object conversations-window) &key (redraw t) (suggested-message-index nil)) "Resync this window whit the conversation in database, if `suggested-message-index' is not nil marks as selected the message in position indicated by this variable." (with-accessors ((rows rows) (selected-line-bg selected-line-bg) (selected-line-fg selected-line-fg)) object (flet ((make-rows (line-fields bg fg) (mapcar (lambda (fields) (let ((name (db:conversation-name fields))) (make-instance 'line :fields fields :normal-text name :selected-text name :normal-bg bg :normal-fg fg :selected-bg fg :selected-fg bg))) line-fields))) (let ((line-fields (db:all-conversation-stats))) (with-croatoan-window (croatoan-window object) (line-oriented-window:update-all-rows object (make-rows line-fields selected-line-bg selected-line-fg)) (when suggested-message-index (select-row object suggested-message-index)) (when redraw (draw object))))))) (defun init () "Init the window" (let* ((low-level-window (make-croatoan-window :enable-function-keys t))) (setf *conversations-window* (make-instance 'conversations-window :title (_ "Conversations") :single-row-height 3 :uses-border-p t :keybindings keybindings:*conversations-keymap* :croatoan-window low-level-window)) (refresh-config *conversations-window*) (resync-rows-db *conversations-window* :redraw nil) (when (not (line-oriented-window:rows-empty-p *conversations-window*)) (select-row *conversations-window* 0)) (draw *conversations-window*) *conversations-window*))