cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-18 08:20:35 +01:00
Code Issues

- improved macro 'when-window-shown' to prevent crash of the program when terminal window is too small.

Browse Source
This commit is contained in:
cage 2021-08-13 12:14:58 +02:00
parent d04f4e001b
commit 423779986a
5 changed files with 114 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/line-oriented-window.lisp
View File

@ -409,6 +409,7 @@ this exact quantity would go beyond the length or rows or zero."
(single-row-height single-row-height)
(top-row-padding top-row-padding)
(top-horizontal-padding top-horizontal-padding)) object
(when-window-shown (object)
(let ((max-line-size (if uses-border-p
(win-width-no-border object)
(win-width object))))
@ -440,7 +441,7 @@ this exact quantity would go beyond the length or rows or zero."
max-line-size)
x y
:bgcolor (normal-bg row)
:fgcolor (normal-fg row))))))))
:fgcolor (normal-fg row)))))))))
(defgeneric resync-rows-db (object &key redraw)
(:documentation "Synchronize information table slot of `object` with

1
src/package.lisp
View File

@ -1679,6 +1679,7 @@
:in-focus-p
:border-window
:uses-border-p
:window-uses-border-p
:title-window))
(defpackage :notify-window

6
src/tags-window.lisp
View File

@ -65,6 +65,7 @@
(single-row-height single-row-height)
(top-row-padding top-row-padding)
(new-messages-mark new-messages-mark)) object
(when-window-shown (object)
(win-clear object)
(with-croatoan-window (croatoan-window object)
(let ((histogram-width (truncate (* 2/3 (win-width-no-border object)))))
@ -87,12 +88,13 @@
(when got-new-messages-p
(print-text object new-messages-mark nil nil
:bgcolor (bgcolor croatoan-window)
:fgcolor histogram-fg))))))))
:fgcolor histogram-fg)))))))))
(defmethod resync-rows-db ((object tags-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
(when-window-shown (object)
(flet ((make-rows (line-fields bg fg)
(mapcar (lambda (fields)
(let ((text (db:tag->folder-name (fields-tag fields))))
@ -113,7 +115,7 @@
(when suggested-message-index
(select-row object suggested-message-index))
(when redraw
(draw object))))))
(draw object)))))))
(defun fields-tag (fields)
(getf fields :tag))

3
src/thread-window.lisp
View File

@ -784,6 +784,7 @@ db:renumber-timeline-message-index."
(defmethod resync-rows-db ((object thread-window) &key (redraw t) (suggested-message-index nil))
(with-accessors ((row-selected-index row-selected-index)
(rows rows)) object
(when-window-shown (object)
(let ((saved-row-selected-index (if suggested-message-index
(db:message-index->sequence-index suggested-message-index)
row-selected-index))
@ -798,7 +799,7 @@ db:renumber-timeline-message-index."
(unselect-all object)
(select-row object saved-row-selected-index)
(when redraw
(draw object))))))
(draw object)))))))
object)
(defun reblogged-data (reblogger-status)

22
src/windows.lisp
View File

@ -98,10 +98,19 @@
`(with-accessors ((,slot croatoan-window)) ,window
,@body))
(defmacro when-window-shown ((window) &body body)
`(when (and ,window
(win-shown-p ,window))
,@body))
(defmacro when-window-shown ((window &key (min-valid-height 5) (min-valid-width 5)) &body body)
(with-gensyms (height width)
`(when ,window
(let ((,height (if (window-uses-border-p ,window)
(win-height-no-border ,window)
(win-height ,window)))
(,width (if (window-uses-border-p ,window)
(win-width-no-border ,window)
(win-width ,window))))
(when (and (win-shown-p ,window)
(> ,height ,min-valid-height)
(> ,width ,min-valid-width))
,@body)))))
(defun win-clear (window &key (redraw t))
"Clear window content"
@ -654,6 +663,11 @@ insetred by the user"
:reader uses-border-p))
(:documentation "This is a window that has a border."))
(defun window-uses-border-p (window)
(and window
(typep window 'border-window)
(uses-border-p window)))
(defmethod draw :after ((object border-window))
(when (uses-border-p object)
(win-box object)))