mirror of
https://gitlab.com/eql/lqml.git
synced 2025-12-06 10:31:34 -08:00
107 lines
3.8 KiB
Common Lisp
107 lines
3.8 KiB
Common Lisp
(in-package :msg)
|
|
|
|
(defvar *message-id* 0)
|
|
(defvar *states* '(:not-received :sending :received))
|
|
|
|
(defun show-message-p (message)
|
|
(let ((user (app:setting :latest-receiver)))
|
|
(and user (or (string= user (getf message :receiver))
|
|
(string= user (getf message :sender))))))
|
|
|
|
(defun add-message (message &optional loading)
|
|
"Adds passed MESSAGE (a PLIST) to the QML item model and saves it to the DB.
|
|
The model keys are:
|
|
:receiver :sender :sender-name :timestamp :hour :text :mid :ack-state :me"
|
|
(unless (or loading (getf message :me))
|
|
(x:when-it (app:setting (getf message :sender) :custom-name)
|
|
(setf (getf message :sender-name) x:it)))
|
|
(unless loading
|
|
(db:save-message (parse-integer (getf message :mid))
|
|
(parse-integer (getf message (if (getf message :me) :receiver :sender))
|
|
:radix 16)
|
|
(prin1-to-string message)))
|
|
(if (or loading (show-message-p message))
|
|
(qjs |addMessage| ui:*messages* message)
|
|
(let* ((sender (getf message :sender))
|
|
(unread (1+ (or (app:setting sender :unread-messages) 0))))
|
|
(app:change-setting sender unread :sub-key :unread-messages)
|
|
(group:set-unread sender unread)))
|
|
(unless loading
|
|
(q! |positionViewAtEnd| ui:*message-view*)))
|
|
|
|
(defun change-state (state mid)
|
|
(let* ((i-state (position state *states*))
|
|
(mid* (parse-integer mid))
|
|
(message (db:load-message mid*)))
|
|
(when message
|
|
(setf message (read-from-string message))
|
|
(setf (getf message :ack-state) i-state)
|
|
(db:update-message mid* (prin1-to-string message))
|
|
(qjs |changeState| ui:*messages*
|
|
i-state mid))))
|
|
|
|
(defun show-messages ()
|
|
(x:when-it (app:setting :latest-receiver)
|
|
(q! |clear| ui:*messages*)
|
|
(dolist (message (db:load-messages (parse-integer x:it :radix 16)))
|
|
(add-message (read-from-string message) t))
|
|
(qsingle-shot 100 (lambda () (q! |positionViewAtEnd| ui:*message-view*)))))
|
|
|
|
(defun receiver-changed ()
|
|
(qsleep 0.1)
|
|
(q> |currentIndex| ui:*main-view* 1) ; 'Messages'
|
|
(show-messages))
|
|
|
|
(defun check-utf8-length (text) ; called from QML
|
|
"Checks the actual number of bytes to send (e.g. an emoji is 4 utf8 bytes),
|
|
because we can't exceed 234 bytes, which will give 312 bytes encoded protobuf
|
|
payload."
|
|
(let ((len (length (qto-utf8 text)))
|
|
(too-long (q< |tooLong| ui:*edit*)))
|
|
(cond ((and (not too-long)
|
|
(> len 234))
|
|
(q> |tooLong| ui:*edit* t))
|
|
((and too-long
|
|
(<= len 234))
|
|
(q> |tooLong| ui:*edit* nil))))
|
|
(values))
|
|
|
|
(defun message-press-and-hold (text) ; called from QML
|
|
(set-clipboard-text text)
|
|
(app:toast (tr "message copied") 2)
|
|
(values))
|
|
|
|
(defun find-clicked ()
|
|
(let ((show (not (q< |visible| ui:*find-text*))))
|
|
(q> |visible| ui:*find-text* show)
|
|
(if show
|
|
(q! |forceActiveFocus| ui:*find-text*)
|
|
(progn
|
|
(q! |clear| ui:*find-text*)
|
|
(clear-find)))))
|
|
|
|
(defun find-text (text)
|
|
(unless (x:empty-string text)
|
|
(qjs |clearFind| ui:*messages*)
|
|
(qjs |find| ui:*messages* text)))
|
|
|
|
(defun clear-find ()
|
|
(qjs |clearFind| ui:*messages*)
|
|
(qlater (lambda () (qjs |positionViewAtEnd| ui:*message-view*))))
|
|
|
|
(defun highlight-term (text term) ; called from QML
|
|
"Highlights TERM in red, returns NIL if TERM is not found."
|
|
(let ((len (length term))
|
|
found)
|
|
(with-output-to-string (s)
|
|
(do ((e (search term text :test 'string-equal)
|
|
(search term text :test 'string-equal :start2 (+ e len)))
|
|
(b 0 (+ e len)))
|
|
((not e) (if found
|
|
(write-string (subseq text b) s)
|
|
(return-from highlight-term)))
|
|
(setf found t)
|
|
(write-string (subseq text b e) s)
|
|
(format s "<font color='red'>~A</font>"
|
|
(subseq text e (+ e len)))))))
|
|
|