mirror of https://codeberg.org/cage/tinmop/
- discouraged use of slot 'rows' for 'row-oriented-widget', used API instead.
This commit is contained in:
cage
parent
149c6931f2
commit
ca2ace2551
|
|
@ -88,9 +88,10 @@
|
|||
:selected-fg fg))
|
||||
chats)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows (db:all-chats)
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(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
|
||||
|
|
@ -108,7 +109,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *chats-list-window*)
|
||||
(resync-rows-db *chats-list-window* :redraw nil)
|
||||
(when (rows *chats-list-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *chats-list-window*))
|
||||
(select-row *chats-list-window* 0))
|
||||
(draw *chats-list-window*)
|
||||
*chats-list-window*))
|
||||
|
|
|
|||
|
|
@ -82,8 +82,7 @@
|
|||
object)))))
|
||||
|
||||
(defmethod draw :before ((object conversations-window))
|
||||
(with-accessors ((rows rows)
|
||||
(single-row-height single-row-height)
|
||||
(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)
|
||||
|
|
@ -93,7 +92,7 @@
|
|||
(with-croatoan-window (croatoan-window object)
|
||||
(loop
|
||||
for y from (+ 2 top-row-padding) by single-row-height
|
||||
for row-fields in (mapcar #'fields rows) do
|
||||
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)
|
||||
|
|
@ -136,9 +135,10 @@ position indicated by this variable."
|
|||
line-fields)))
|
||||
(let ((line-fields (db:all-conversation-stats)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows line-fields
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(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
|
||||
|
|
@ -156,7 +156,7 @@ position indicated by this variable."
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *conversations-window*)
|
||||
(resync-rows-db *conversations-window* :redraw nil)
|
||||
(when (rows *conversations-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *conversations-window*))
|
||||
(select-row *conversations-window* 0))
|
||||
(draw *conversations-window*)
|
||||
*conversations-window*))
|
||||
|
|
|
|||
|
|
@ -116,10 +116,10 @@
|
|||
:keybindings keybindings:*follow-requests-keymap*
|
||||
:croatoan-window low-level-window))
|
||||
(refresh-config *follow-requests-window*)
|
||||
(setf (rows *follow-requests-window*)
|
||||
(make-rows usernames-follow-requests
|
||||
(bgcolor low-level-window)
|
||||
(fgcolor low-level-window)))
|
||||
(line-oriented-window:update-all-rows *follow-requests-window*
|
||||
(make-rows usernames-follow-requests
|
||||
(bgcolor low-level-window)
|
||||
(fgcolor low-level-window)))
|
||||
(setf (row-selected-index *follow-requests-window*) 0)
|
||||
*follow-requests-window*)))
|
||||
|
||||
|
|
@ -127,9 +127,9 @@
|
|||
"Process the accepted or follow' requests, the accepted are the
|
||||
requeste that are not be erased from the window (see the class
|
||||
row-oriented-widget)"
|
||||
(with-accessors ((all-accounts requests)
|
||||
(rows rows)) specials:*follow-requests-window*
|
||||
(let* ((accepted-usernames (mapcar #'normal-text rows))
|
||||
(with-accessors ((all-accounts requests)) specials:*follow-requests-window*
|
||||
(let* ((accepted-usernames (line-oriented-window:map-rows #'normal-text
|
||||
specials:*follow-requests-window*))
|
||||
(accepted-accounts (remove-if-not (lambda (acc)
|
||||
(find-if (lambda (a)
|
||||
(string= a
|
||||
|
|
|
|||
|
|
@ -78,9 +78,10 @@
|
|||
:selected-fg fg))
|
||||
cache-rows)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows (db:find-tls-certificates-rows)
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows (db:find-tls-certificates-rows)
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(handler-bind ((conditions:out-of-bounds
|
||||
(lambda (e)
|
||||
|
|
@ -102,7 +103,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *gemini-certificates-window*)
|
||||
(resync-rows-db *gemini-certificates-window* :redraw nil)
|
||||
(when (rows *gemini-certificates-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *gemini-certificates-window*))
|
||||
(select-row *gemini-certificates-window* 0))
|
||||
(draw *gemini-certificates-window*)
|
||||
*gemini-certificates-window*))
|
||||
|
|
|
|||
|
|
@ -71,9 +71,10 @@
|
|||
:selected-fg fg))
|
||||
gemlogs)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows (db:gemini-all-subscriptions)
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows (db:gemini-all-subscriptions)
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
|
|
@ -92,7 +93,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *gemini-subscription-window*)
|
||||
(resync-rows-db *gemini-subscription-window* :redraw nil)
|
||||
(when (rows *gemini-subscription-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *gemini-subscription-window*))
|
||||
(select-row *gemini-subscription-window* 0))
|
||||
(draw *gemini-subscription-window*)
|
||||
*gemini-subscription-window*))
|
||||
|
|
|
|||
|
|
@ -732,9 +732,10 @@
|
|||
:selected-fg bg)))
|
||||
streams)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows *gemini-streams-db*
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows *gemini-streams-db*
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
|
|
@ -753,7 +754,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *gemini-streams-window*)
|
||||
(resync-rows-db *gemini-streams-window* :redraw nil)
|
||||
(when (rows *gemini-streams-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *gemini-streams-window*))
|
||||
(select-row *gemini-streams-window* 0))
|
||||
(draw *gemini-streams-window*)
|
||||
*gemini-streams-window*))
|
||||
|
|
|
|||
|
|
@ -226,7 +226,7 @@
|
|||
(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 rows or zero."
|
||||
this exact quantity would go beyond the length or rows or zero."
|
||||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) object
|
||||
(if (and rows
|
||||
|
|
@ -279,6 +279,74 @@ this exact quantity wold go beyond the length or rows or zero."
|
|||
(line-oriented-window:cleanup-after-search object)
|
||||
(ui:error-message (_ "Invalid regular expression")))))
|
||||
|
||||
(defgeneric update-all-rows (object new-rows))
|
||||
|
||||
(defmethod update-all-rows ((object row-oriented-widget) (new-rows sequence))
|
||||
(setf (rows object) new-rows))
|
||||
|
||||
(defgeneric append-new-rows (object new-rows))
|
||||
|
||||
(defmethod append-new-rows ((object row-oriented-widget) (new-rows sequence))
|
||||
(with-accessors ((rows rows)) object
|
||||
(let ((reversed-old-rows (reverse rows)))
|
||||
(loop for new-row in new-rows do
|
||||
(push new-row reversed-old-rows))
|
||||
(setf rows (reverse reversed-old-rows)))))
|
||||
|
||||
(defgeneric map-rows (object function &key &allow-other-keys))
|
||||
|
||||
(defmethod map-rows ((object row-oriented-widget) (function function)
|
||||
&key &allow-other-keys)
|
||||
(mapcar function (rows object)))
|
||||
|
||||
(defgeneric rows-length (object &key &allow-other-keys))
|
||||
|
||||
(defmethod rows-length ((object row-oriented-widget) &key &allow-other-keys)
|
||||
(length (rows object)))
|
||||
|
||||
|
||||
(defgeneric rows-empty-p (object &key &allow-other-keys))
|
||||
|
||||
(defmethod rows-empty-p ((object row-oriented-widget) &key &allow-other-keys)
|
||||
(not (rows object)))
|
||||
|
||||
(defgeneric rows-remove-if (object function &key &allow-other-keys))
|
||||
|
||||
(defmethod rows-remove-if ((object row-oriented-widget) (function function) &key &allow-other-keys)
|
||||
(remove-if function (rows object)))
|
||||
|
||||
(defgeneric rows-safe-subseq (object start &key end &allow-other-keys))
|
||||
|
||||
(defmethod rows-safe-subseq ((object row-oriented-widget) start
|
||||
&key (end nil) &allow-other-keys)
|
||||
(safe-subseq (rows object) start end))
|
||||
|
||||
(defgeneric rows-elt (object index &key &allow-other-keys))
|
||||
|
||||
(defmethod rows-elt ((object row-oriented-widget) index &key &allow-other-keys)
|
||||
(elt (rows object) index))
|
||||
|
||||
(defgeneric rows-last-elt (object &key &allow-other-keys))
|
||||
|
||||
(defmethod rows-last-elt ((object row-oriented-widget) &key &allow-other-keys)
|
||||
(last-elt (rows object)))
|
||||
|
||||
(defgeneric rows-first-elt (object &key &allow-other-keys))
|
||||
|
||||
(defmethod rows-first-elt ((object row-oriented-widget) &key &allow-other-keys)
|
||||
(first-elt (rows object)))
|
||||
|
||||
(defgeneric rows-position-if (object predicate &key from-end start end key &allow-other-keys))
|
||||
|
||||
(defmethod rows-position-if ((object row-oriented-widget) (predicate function)
|
||||
&key from-end start end key &allow-other-keys)
|
||||
(position-if predicate
|
||||
(rows object)
|
||||
:from-end from-end
|
||||
:start start
|
||||
:end end
|
||||
:key key))
|
||||
|
||||
(defclass simple-line-navigation-window (wrapper-window row-oriented-widget border-window)
|
||||
((selected-line-bg
|
||||
:initform :blue
|
||||
|
|
|
|||
|
|
@ -79,8 +79,7 @@
|
|||
(db:username->id username))))))
|
||||
|
||||
(defun maybe-crypt-message (send-message-window &key (notify-cant-crypt nil))
|
||||
(with-accessors ((message-data sending-message:message-data)
|
||||
(rows line-oriented-window:rows)) send-message-window
|
||||
(with-accessors ((message-data sending-message:message-data)) send-message-window
|
||||
(with-accessors ((body sending-message:body)
|
||||
(subject sending-message:subject)
|
||||
(reply-to sending-message:reply-to)
|
||||
|
|
|
|||
|
|
@ -86,22 +86,24 @@
|
|||
(declare (ignore object dt)))
|
||||
|
||||
(defun draw-text (window)
|
||||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) window
|
||||
(let ((actual-rows (safe-subseq rows row-selected-index)))
|
||||
(loop
|
||||
for line in actual-rows
|
||||
for y from 1 below (win-height-no-border window) do
|
||||
(let ((text-line (normal-text line)))
|
||||
(when (string-not-empty-p text-line)
|
||||
(print-text window text-line 1 y)))))))
|
||||
(with-accessors ((row-selected-index row-selected-index)) window
|
||||
(let ((actual-rows (line-oriented-window:rows-safe-subseq window row-selected-index)))
|
||||
(loop for line in actual-rows
|
||||
for y from 1 below (win-height-no-border window)
|
||||
do
|
||||
(cond
|
||||
((invisible-row-p line)
|
||||
(decf y))
|
||||
((not (vspace-row-p line))
|
||||
(let ((text-line (normal-text line)))
|
||||
(print-text window text-line 1 y))))))))
|
||||
|
||||
(defun draw-buffer-line-mark (window)
|
||||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)
|
||||
(line-position-mark line-position-mark)) window
|
||||
(let* ((height (1- (win-height-no-border window)))
|
||||
(rows-count (- (length rows) height))
|
||||
(rows-count (- (rows-length window) height))
|
||||
(fraction (/ row-selected-index
|
||||
(max 1 rows-count)))
|
||||
(mark-y (1+ (truncate (* fraction height))))
|
||||
|
|
@ -113,7 +115,7 @@
|
|||
(win-clear object :redraw nil)
|
||||
(win-box object)
|
||||
(draw-text object)
|
||||
(when (rows object)
|
||||
(when (not (line-oriented-window:rows-empty-p object))
|
||||
(draw-buffer-line-mark object))
|
||||
(call-next-method)))
|
||||
|
||||
|
|
@ -138,14 +140,27 @@
|
|||
|
||||
(defgeneric text->rendered-lines-rows (window text))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-start))
|
||||
(defun make-render-vspace-row ()
|
||||
(make-instance 'line
|
||||
:normal-text (make-tui-string "")))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-end))
|
||||
(defun vspace-row-p (row)
|
||||
(string-empty-p (normal-text row)))
|
||||
|
||||
(defun make-invisible-row ()
|
||||
(make-instance 'line
|
||||
:fields (list :invisible t)
|
||||
:normal-text (make-tui-string "")))
|
||||
|
||||
(defun invisible-row-p (row)
|
||||
(getf (fields row) :invisible))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-start))
|
||||
(make-invisible-row))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text gemini-parser:pre-end))
|
||||
(make-invisible-row))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text list))
|
||||
(flatten (loop for i in text
|
||||
collect
|
||||
|
|
@ -155,6 +170,17 @@
|
|||
(make-instance 'line
|
||||
:normal-text text))
|
||||
|
||||
(defmethod update-all-rows :around ((object message-window) (new-rows sequence))
|
||||
(let ((new-rows (remove-if #'invisible-row-p new-rows)))
|
||||
(call-next-method object new-rows)))
|
||||
|
||||
(defmethod append-new-rows :around ((object message-window) (new-rows sequence))
|
||||
(let ((new-rows (loop for new-row in new-rows
|
||||
when (not (invisible-row-p new-row))
|
||||
collect
|
||||
new-row)))
|
||||
(call-next-method object new-rows)))
|
||||
|
||||
(defun colorize-lines (lines)
|
||||
(let ((color-re (swconf:color-regexps)))
|
||||
(loop for line in lines
|
||||
|
|
@ -185,8 +211,7 @@
|
|||
(push fitted-line res))))
|
||||
(reverse res))))
|
||||
(if (string= text (format nil "~%"))
|
||||
(make-instance 'line
|
||||
:normal-text (make-tui-string ""))
|
||||
(make-render-vspace-row)
|
||||
(let* ((lines (split-lines text))
|
||||
(fitted-lines (fit-lines lines))
|
||||
(new-rows (colorize-lines fitted-lines)))
|
||||
|
|
@ -196,15 +221,14 @@
|
|||
new-rows)))))
|
||||
|
||||
(defmethod text->rendered-lines-rows (window (text null))
|
||||
(make-instance 'line
|
||||
:normal-text ""))
|
||||
(make-render-vspace-row))
|
||||
|
||||
(defmethod prepare-for-rendering ((object message-window) &key (jump-to-first-row t))
|
||||
(with-accessors ((support-text support-text)) object
|
||||
(when hooks:*before-prepare-for-rendering-message*
|
||||
(hooks:run-hook 'hooks:*before-prepare-for-rendering-message* object))
|
||||
(setf (rows object)
|
||||
(text->rendered-lines-rows object support-text))
|
||||
(update-all-rows object
|
||||
(text->rendered-lines-rows object support-text))
|
||||
(when jump-to-first-row
|
||||
(select-row object 0))
|
||||
object))
|
||||
|
|
@ -222,7 +246,7 @@
|
|||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) win
|
||||
(let ((win-height (win-height-no-border win)))
|
||||
(- (- (length rows)
|
||||
(- (- (rows-length win)
|
||||
(- win-height 1))
|
||||
row-selected-index))))
|
||||
|
||||
|
|
@ -230,7 +254,7 @@
|
|||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) win
|
||||
(let* ((win-height (win-height-no-border win))
|
||||
(rows-left (- (length rows) row-selected-index)))
|
||||
(rows-left (- (rows-length win) row-selected-index)))
|
||||
(< rows-left
|
||||
win-height))))
|
||||
|
||||
|
|
@ -264,7 +288,7 @@
|
|||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) object
|
||||
(let ((actual-window-height (win-height-no-border object)))
|
||||
(when (and (> (- (length rows)
|
||||
(when (and (> (- (rows-length object)
|
||||
row-selected-index)
|
||||
actual-window-height)
|
||||
(/= (row-move object actual-window-height)
|
||||
|
|
@ -277,21 +301,19 @@
|
|||
(draw object)))
|
||||
|
||||
(defun first-line->string (window)
|
||||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) window
|
||||
(let ((complex (normal-text (elt rows row-selected-index))))
|
||||
(with-accessors ((row-selected-index row-selected-index)) window
|
||||
(let ((complex (normal-text (rows-elt window row-selected-index))))
|
||||
(values (tui-string->chars-string complex)
|
||||
complex))))
|
||||
|
||||
(defmethod search-regex ((object message-window) regex)
|
||||
(with-accessors ((rows rows)
|
||||
(row-selected-index row-selected-index)) object
|
||||
(let ((line-found (position-if (lambda (a)
|
||||
(scan regex
|
||||
(tui-string->chars-string (normal-text a))))
|
||||
rows
|
||||
:start (min (1+ row-selected-index)
|
||||
(length rows))))
|
||||
(with-accessors ((row-selected-index row-selected-index)) object
|
||||
(let ((line-found (rows-position-if object
|
||||
(lambda (a)
|
||||
(scan regex
|
||||
(tui-string->chars-string (normal-text a))))
|
||||
:start (min (1+ row-selected-index)
|
||||
(rows-length object))))
|
||||
(replacements-strings ()))
|
||||
(if line-found
|
||||
(progn
|
||||
|
|
|
|||
|
|
@ -73,9 +73,10 @@
|
|||
(let ((attach-names (db:all-attachments-urls-to-status status-id
|
||||
:add-reblogged-urls t)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows attach-names
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows attach-names
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
|
|
@ -93,7 +94,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *open-attach-window*)
|
||||
(resync-rows-db *open-attach-window* :redraw nil)
|
||||
(when (rows *open-attach-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *open-attach-window*))
|
||||
(select-row *open-attach-window* 0))
|
||||
(draw *open-attach-window*)
|
||||
*open-attach-window*))
|
||||
|
|
|
|||
|
|
@ -45,9 +45,10 @@
|
|||
(when hooks:*before-displaying-links-hook*
|
||||
(setf links
|
||||
(hooks:run-hook-compose 'hooks:*before-displaying-links-hook* links)))
|
||||
(setf rows (make-rows links
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows links
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
|
|
@ -65,7 +66,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *open-message-link-window*)
|
||||
(resync-rows-db *open-message-link-window* :redraw nil)
|
||||
(when (rows *open-message-link-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *open-message-link-window*))
|
||||
(select-row *open-message-link-window* 0))
|
||||
(draw *open-message-link-window*)
|
||||
*open-message-link-window*))
|
||||
|
|
@ -137,9 +138,10 @@
|
|||
:selected-fg bg))
|
||||
links)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows links
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows links
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
|
|
@ -204,7 +206,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *open-message-link-window*)
|
||||
(resync-rows-db *open-message-link-window* :redraw nil)
|
||||
(when (rows *open-message-link-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *open-message-link-window*))
|
||||
(select-row *open-message-link-window* 0))
|
||||
(draw *open-message-link-window*)
|
||||
*open-message-link-window*))
|
||||
|
|
@ -246,9 +248,10 @@
|
|||
:selected-fg bg))
|
||||
links)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows links
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(line-oriented-window:update-all-rows object
|
||||
(make-rows links
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
|
|
@ -267,7 +270,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *open-message-link-window*)
|
||||
(resync-rows-db *open-message-link-window* :redraw nil)
|
||||
(when (rows *open-message-link-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *open-message-link-window*))
|
||||
(select-row *open-message-link-window* 0))
|
||||
(draw *open-message-link-window*)
|
||||
*open-message-link-window*))
|
||||
|
|
|
|||
|
|
@ -1801,7 +1801,7 @@
|
|||
:row-oriented-widget
|
||||
:single-row-height
|
||||
:top-row-padding
|
||||
:rows
|
||||
;;:rows
|
||||
:row-selected-index
|
||||
:y-current-row
|
||||
:top-rows-slice
|
||||
|
|
@ -1815,6 +1815,17 @@
|
|||
:selected-row-fields
|
||||
:selected-row-delete
|
||||
:search-row
|
||||
:update-all-rows
|
||||
:append-new-rows
|
||||
:map-rows
|
||||
:rows-length
|
||||
:rows-empty-p
|
||||
:rows-remove-if
|
||||
:rows-safe-subseq
|
||||
:rows-elt
|
||||
:rows-last-elt
|
||||
:rows-first-elt
|
||||
:rows-position-if
|
||||
:row-move
|
||||
:simple-line-navigation-window
|
||||
:selected-line-bg
|
||||
|
|
|
|||
|
|
@ -673,10 +673,9 @@
|
|||
:normal-bg bg
|
||||
:normal-fg fg
|
||||
:selected-bg fg
|
||||
:selected-fg bg)))
|
||||
(setf (line-oriented-window:rows specials:*send-message-window*)
|
||||
(append (line-oriented-window:rows specials:*send-message-window*)
|
||||
(list line)))
|
||||
:selected-fg bg))
|
||||
(win specials:*send-message-window*))
|
||||
(line-oriented-window:append-new-rows win line)
|
||||
(line-oriented-window:unselect-all specials:*send-message-window*)
|
||||
(line-oriented-window:select-row specials:*send-message-window* 0)
|
||||
(windows:draw specials:*send-message-window*))))
|
||||
|
|
@ -689,34 +688,35 @@
|
|||
:writer use-ui-notification)))
|
||||
|
||||
(defmethod process-event ((object send-message-event))
|
||||
(with-accessors ((message-data sending-message:message-data)
|
||||
(rows line-oriented-window:rows)) specials:*send-message-window*
|
||||
(with-accessors ((body sending-message:body)
|
||||
(subject sending-message:subject)
|
||||
(reply-to sending-message:reply-to)
|
||||
(mentions sending-message:mentions)
|
||||
(visibility sending-message:visibility)) message-data
|
||||
(let* ((attachments (mapcar #'line-oriented-window:normal-text rows)))
|
||||
(hooks:run-hook 'hooks:*before-sending-message* object)
|
||||
(msg-utils:maybe-crypt-message specials:*send-message-window*
|
||||
:notify-cant-crypt (use-ui-notification-p object))
|
||||
(let ((exceeding-characters (ui:message-exceeds-server-limit-p body)))
|
||||
(if exceeding-characters
|
||||
(ui:exceeding-characters-notify exceeding-characters)
|
||||
(let ((actual-message-body (if (text-utils:string-not-empty-p mentions)
|
||||
(format nil
|
||||
"~a~a~%~a"
|
||||
+mention-prefix+
|
||||
mentions
|
||||
body)
|
||||
body)))
|
||||
(client:send-status actual-message-body
|
||||
reply-to
|
||||
attachments
|
||||
subject
|
||||
(make-keyword (string-upcase visibility)))
|
||||
(ui:notify (_ "Message sent."))
|
||||
(ui:close-send-message-window))))))))
|
||||
(let ((send-win specials:*send-message-window*))
|
||||
(with-accessors ((message-data sending-message:message-data)) send-win
|
||||
(with-accessors ((body sending-message:body)
|
||||
(subject sending-message:subject)
|
||||
(reply-to sending-message:reply-to)
|
||||
(mentions sending-message:mentions)
|
||||
(visibility sending-message:visibility)) message-data
|
||||
(let* ((attachments (line-oriented-window:map-rows send-win
|
||||
#'line-oriented-window:normal-text)))
|
||||
(hooks:run-hook 'hooks:*before-sending-message* object)
|
||||
(msg-utils:maybe-crypt-message send-win
|
||||
:notify-cant-crypt (use-ui-notification-p object))
|
||||
(let ((exceeding-characters (ui:message-exceeds-server-limit-p body)))
|
||||
(if exceeding-characters
|
||||
(ui:exceeding-characters-notify exceeding-characters)
|
||||
(let ((actual-message-body (if (text-utils:string-not-empty-p mentions)
|
||||
(format nil
|
||||
"~a~a~%~a"
|
||||
+mention-prefix+
|
||||
mentions
|
||||
body)
|
||||
body)))
|
||||
(client:send-status actual-message-body
|
||||
reply-to
|
||||
attachments
|
||||
subject
|
||||
(make-keyword (string-upcase visibility)))
|
||||
(ui:notify (_ "Message sent."))
|
||||
(ui:close-send-message-window)))))))))
|
||||
|
||||
(defun find-user-id-from-exact-acct (username)
|
||||
(when-let ((remote-account-matching (api-client:search-user username :limit 1)))
|
||||
|
|
@ -1095,19 +1095,16 @@
|
|||
(window-metadata (message-window:metadata win)))
|
||||
(with-accessors ((rows message-window::rows)) win
|
||||
(let ((new-rows (message-window:text->rendered-lines-rows win
|
||||
ir-rows))
|
||||
(reversed-rows (reverse rows)))
|
||||
ir-rows)))
|
||||
(if append-text
|
||||
(progn
|
||||
(loop for new-row in new-rows do
|
||||
(push new-row reversed-rows))
|
||||
(line-oriented-window:append-new-rows win new-rows)
|
||||
(gemini-viewer:append-metadata-link window-metadata links)
|
||||
(gemini-viewer:append-metadata-source window-metadata source)
|
||||
(setf rows (reverse reversed-rows)))
|
||||
(gemini-viewer:append-metadata-source window-metadata source))
|
||||
(progn
|
||||
(setf (gemini-viewer:gemini-metadata-source-file window-metadata) source)
|
||||
(setf (gemini-viewer:gemini-metadata-links window-metadata) links)
|
||||
(setf rows new-rows)))))))
|
||||
(line-oriented-window:update-all-rows win new-rows)))))))
|
||||
|
||||
(defmethod process-event ((object gemini-got-line-event))
|
||||
(with-accessors ((response payload)
|
||||
|
|
@ -1288,7 +1285,7 @@
|
|||
(gemini-viewer:maybe-initialize-metadata specials:*message-window*)
|
||||
(refresh-gemini-message-window links
|
||||
gemini-page
|
||||
(gemini-parser:sexp->text parsed theme)
|
||||
(gemini-parser:sexp->text-rows parsed theme)
|
||||
nil)
|
||||
(setf (windows:keybindings specials:*message-window*)
|
||||
keybindings:*gemini-message-keymap*)
|
||||
|
|
|
|||
|
|
@ -200,9 +200,9 @@
|
|||
:croatoan-window low-level-window
|
||||
:message-data message-data))
|
||||
(refresh-config *send-message-window*)
|
||||
(setf (rows *send-message-window*)
|
||||
(make-rows (attachments message-data)
|
||||
(bgcolor low-level-window)
|
||||
(fgcolor low-level-window)))
|
||||
(line-oriented-window:update-all-rows *send-message-window*
|
||||
(make-rows (attachments message-data)
|
||||
(bgcolor low-level-window)
|
||||
(fgcolor low-level-window)))
|
||||
(setf (row-selected-index *send-message-window*) 0)
|
||||
*send-message-window*)))
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@
|
|||
(let ((histogram-width (truncate (* 2/3 (win-width-no-border object)))))
|
||||
(loop
|
||||
for y from (+ 2 top-row-padding) by single-row-height
|
||||
for row-fields in (mapcar #'fields rows) do
|
||||
for row-fields in (map-rows object #'fields) do
|
||||
(let* ((histogram-data (fields-histogram row-fields))
|
||||
(length-histogram-data (length histogram-data))
|
||||
(histogram-visualized-data (safe-subseq histogram-data
|
||||
|
|
@ -106,9 +106,10 @@
|
|||
:selected-fg bg)))
|
||||
line-fields)))
|
||||
(let ((line-fields (make-tag-line-fields)))
|
||||
(setf rows (make-rows line-fields
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(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
|
||||
|
|
@ -143,7 +144,7 @@
|
|||
:croatoan-window low-level-window))
|
||||
(refresh-config *tags-window*)
|
||||
(resync-rows-db *tags-window* :redraw nil)
|
||||
(when (rows *tags-window*)
|
||||
(when (not (line-oriented-window:rows-empty-p *tags-window*))
|
||||
(select-row *tags-window* 0))
|
||||
(draw *tags-window*)
|
||||
*tags-window*))
|
||||
|
|
|
|||
|
|
@ -254,18 +254,19 @@
|
|||
(defmethod calculate ((object thread-window) dt))
|
||||
|
||||
(defun render-messages (window)
|
||||
(loop
|
||||
for message in (rows window)
|
||||
for y from 1 do
|
||||
(cond
|
||||
((selectedp message)
|
||||
(print-text window (selected-text message) 1 y))
|
||||
((marked-to-delete-p message)
|
||||
(print-text window (deleted-text message) 1 y))
|
||||
(t
|
||||
(print-text window (normal-text message) 1 y))))
|
||||
(expand-modeline-spec window)
|
||||
(win-refresh window))
|
||||
(let ((y 1))
|
||||
(map-rows window
|
||||
(lambda (message)
|
||||
(cond
|
||||
((selectedp message)
|
||||
(print-text window (selected-text message) 1 y))
|
||||
((marked-to-delete-p message)
|
||||
(print-text window (deleted-text message) 1 y))
|
||||
(t
|
||||
(print-text window (normal-text message) 1 y)))
|
||||
(incf y)))
|
||||
(expand-modeline-spec window)
|
||||
(win-refresh window)))
|
||||
|
||||
(defmethod draw ((object thread-window))
|
||||
(when-window-shown (object)
|
||||
|
|
@ -640,10 +641,9 @@ db:renumber-timeline-message-index."
|
|||
(selected-fg selected-fg)
|
||||
(timeline-type timeline-type)
|
||||
(timeline-folder timeline-folder)
|
||||
(row-selected-index row-selected-index)
|
||||
(rows rows)) object
|
||||
(row-selected-index row-selected-index)) object
|
||||
(if (null annotated-tree)
|
||||
(setf rows nil)
|
||||
(update-all-rows object nil)
|
||||
(progn
|
||||
(setf row-selected-index selected-pos)
|
||||
(multiple-value-bind (tree-lines all-fields)
|
||||
|
|
@ -688,7 +688,7 @@ db:renumber-timeline-message-index."
|
|||
(setf normal-text message)
|
||||
(setf selected-text selected-message)
|
||||
(setf deleted-text deleted-message))))
|
||||
(setf rows new-rows))))))
|
||||
(update-all-rows object new-rows))))))
|
||||
object)
|
||||
|
||||
(defmethod go-message-down ((object thread-window))
|
||||
|
|
@ -696,13 +696,12 @@ db:renumber-timeline-message-index."
|
|||
(selected-fg selected-fg)
|
||||
(row-selected-index row-selected-index)
|
||||
(timeline-type timeline-type)
|
||||
(timeline-folder timeline-folder)
|
||||
(rows rows)) object
|
||||
(when rows
|
||||
(timeline-folder timeline-folder)) object
|
||||
(when (not (rows-empty-p object))
|
||||
(let ((new-index (1+ row-selected-index)))
|
||||
(if (>= new-index
|
||||
(length rows))
|
||||
(let* ((last-message-index (db:row-message-index (fields (last-elt rows))))
|
||||
(rows-length object))
|
||||
(let* ((last-message-index (db:row-message-index (fields (rows-last-elt object))))
|
||||
(next-message-index (1+ last-message-index)))
|
||||
(when (db:message-from-timeline-folder-message-index timeline-type
|
||||
timeline-folder
|
||||
|
|
@ -722,10 +721,10 @@ db:renumber-timeline-message-index."
|
|||
(timeline-type timeline-type)
|
||||
(timeline-folder timeline-folder)
|
||||
(rows rows)) object
|
||||
(when rows
|
||||
(when (not (rows-empty-p object))
|
||||
(let ((new-index (1- row-selected-index)))
|
||||
(if (< new-index 0)
|
||||
(let* ((first-message-index (db:row-message-index (fields (first-elt rows))))
|
||||
(let* ((first-message-index (db:row-message-index (fields (rows-first-elt object))))
|
||||
(previous-message-index (1- first-message-index)))
|
||||
(when (db:message-from-timeline-folder-message-index timeline-type
|
||||
timeline-folder
|
||||
|
|
@ -770,7 +769,7 @@ db:renumber-timeline-message-index."
|
|||
(db:message-index->sequence-index suggested-message-index)
|
||||
row-selected-index))
|
||||
(first-message-index (or suggested-message-index
|
||||
(db:row-message-index (fields (first-elt rows))))))
|
||||
(db:row-message-index (fields (rows-first-elt object))))))
|
||||
(handler-bind ((conditions:out-of-bounds
|
||||
(lambda (e)
|
||||
(invoke-restart 'ignore-selecting-action e))))
|
||||
|
|
|
|||
|
|
@ -1079,9 +1079,9 @@ Force the checking for new message in the thread the selected message belong."
|
|||
(when (and *send-message-window*
|
||||
(sending-message:message-data *send-message-window*))
|
||||
(let ((data (sending-message:message-data *send-message-window*))
|
||||
(attachments (line-oriented-window:rows *send-message-window*))
|
||||
(attachments-count (line-oriented-window:rows-length *send-message-window*))
|
||||
(max-allowed-attach (swconf:max-attachments-allowed)))
|
||||
(if (> (length attachments)
|
||||
(if (> attachments-count
|
||||
max-allowed-attach)
|
||||
(error-message (format nil
|
||||
(_ "The maximum allowed number of media is ~a.")
|
||||
|
|
|
|||
Loading…
Reference in New Issue