From 423779986a7a68f94a08f4a8fb57402388221133 Mon Sep 17 00:00:00 2001 From: cage Date: Fri, 13 Aug 2021 12:14:58 +0200 Subject: [PATCH] - improved macro 'when-window-shown' to prevent crash of the program when terminal window is too small. --- src/line-oriented-window.lisp | 65 ++++++++++++------------- src/package.lisp | 1 + src/tags-window.lisp | 90 ++++++++++++++++++----------------- src/thread-window.lisp | 31 ++++++------ src/windows.lisp | 22 +++++++-- 5 files changed, 114 insertions(+), 95 deletions(-) diff --git a/src/line-oriented-window.lisp b/src/line-oriented-window.lisp index 20230cc..083109c 100644 --- a/src/line-oriented-window.lisp +++ b/src/line-oriented-window.lisp @@ -409,38 +409,39 @@ 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 - (let ((max-line-size (if uses-border-p - (win-width-no-border object) - (win-width object)))) - (let ((rows (renderizable-rows-data object)) - (x (if (uses-border-p object) - 1 - 0)) - (y-start (if (uses-border-p object) - 1 - 0))) - (loop - for y from (+ y-start - top-horizontal-padding - top-row-padding) - by single-row-height - for ct from 0 - for row in rows do - (if (selectedp row) - (print-text object - (right-pad-text (text-ellipsis (selected-text row) - max-line-size) - max-line-size) - x y - :bgcolor (selected-bg row) - :fgcolor (selected-fg row)) - (print-text object - (right-pad-text (text-ellipsis (normal-text row) - max-line-size) - max-line-size) - x y - :bgcolor (normal-bg row) - :fgcolor (normal-fg row)))))))) + (when-window-shown (object) + (let ((max-line-size (if uses-border-p + (win-width-no-border object) + (win-width object)))) + (let ((rows (renderizable-rows-data object)) + (x (if (uses-border-p object) + 1 + 0)) + (y-start (if (uses-border-p object) + 1 + 0))) + (loop + for y from (+ y-start + top-horizontal-padding + top-row-padding) + by single-row-height + for ct from 0 + for row in rows do + (if (selectedp row) + (print-text object + (right-pad-text (text-ellipsis (selected-text row) + max-line-size) + max-line-size) + x y + :bgcolor (selected-bg row) + :fgcolor (selected-fg row)) + (print-text object + (right-pad-text (text-ellipsis (normal-text row) + max-line-size) + max-line-size) + x y + :bgcolor (normal-bg row) + :fgcolor (normal-fg row))))))))) (defgeneric resync-rows-db (object &key redraw) (:documentation "Synchronize information table slot of `object` with diff --git a/src/package.lisp b/src/package.lisp index 9596de4..768198f 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1679,6 +1679,7 @@ :in-focus-p :border-window :uses-border-p + :window-uses-border-p :title-window)) (defpackage :notify-window diff --git a/src/tags-window.lisp b/src/tags-window.lisp index 81d2d42..a8fb0f6 100644 --- a/src/tags-window.lisp +++ b/src/tags-window.lisp @@ -65,55 +65,57 @@ (single-row-height single-row-height) (top-row-padding top-row-padding) (new-messages-mark new-messages-mark)) object - (win-clear object) - (with-croatoan-window (croatoan-window object) - (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 (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 - (- length-histogram-data - histogram-width) - length-histogram-data)) - (histogram (cl-spark:spark histogram-visualized-data)) - (got-new-messages-p (getf row-fields :got-new-message-p))) - (print-text object - histogram - 1 y - :bgcolor (bgcolor croatoan-window) - :fgcolor histogram-fg) - (when got-new-messages-p - (print-text object new-messages-mark nil nil - :bgcolor (bgcolor croatoan-window) - :fgcolor histogram-fg)))))))) + (when-window-shown (object) + (win-clear object) + (with-croatoan-window (croatoan-window object) + (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 (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 + (- length-histogram-data + histogram-width) + length-histogram-data)) + (histogram (cl-spark:spark histogram-visualized-data)) + (got-new-messages-p (getf row-fields :got-new-message-p))) + (print-text object + histogram + 1 y + :bgcolor (bgcolor croatoan-window) + :fgcolor histogram-fg) + (when got-new-messages-p + (print-text object new-messages-mark nil nil + :bgcolor (bgcolor croatoan-window) + :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 - (flet ((make-rows (line-fields bg fg) - (mapcar (lambda (fields) - (let ((text (db:tag->folder-name (fields-tag fields)))) - (make-instance 'line - :fields fields - :normal-text text - :selected-text text - :normal-bg bg - :normal-fg fg - :selected-bg fg - :selected-fg bg))) - line-fields))) - (let ((line-fields (make-tag-line-fields))) - (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)))))) + (when-window-shown (object) + (flet ((make-rows (line-fields bg fg) + (mapcar (lambda (fields) + (let ((text (db:tag->folder-name (fields-tag fields)))) + (make-instance 'line + :fields fields + :normal-text text + :selected-text text + :normal-bg bg + :normal-fg fg + :selected-bg fg + :selected-fg bg))) + line-fields))) + (let ((line-fields (make-tag-line-fields))) + (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 fields-tag (fields) (getf fields :tag)) diff --git a/src/thread-window.lisp b/src/thread-window.lisp index 07ba196..8d31cb6 100644 --- a/src/thread-window.lisp +++ b/src/thread-window.lisp @@ -784,21 +784,22 @@ 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 - (let ((saved-row-selected-index (if suggested-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 (rows-first-elt object)))))) - (handler-bind ((conditions:out-of-bounds - (lambda (e) - (invoke-restart 'ignore-selecting-action e)))) - (multiple-value-bind (tree pos) - (fit-timeline-to-window object first-message-index) - (build-lines object tree pos) - (unselect-all object) - (select-row object saved-row-selected-index) - (when redraw - (draw 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)) + (first-message-index (or suggested-message-index + (db:row-message-index (fields (rows-first-elt object)))))) + (handler-bind ((conditions:out-of-bounds + (lambda (e) + (invoke-restart 'ignore-selecting-action e)))) + (multiple-value-bind (tree pos) + (fit-timeline-to-window object first-message-index) + (build-lines object tree pos) + (unselect-all object) + (select-row object saved-row-selected-index) + (when redraw + (draw object))))))) object) (defun reblogged-data (reblogger-status) diff --git a/src/windows.lisp b/src/windows.lisp index af308b7..42e1828 100644 --- a/src/windows.lisp +++ b/src/windows.lisp @@ -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)))