cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- prevented window's title to go out of the window's width.

This commit is contained in:
cage 2022-02-25 12:01:05 +01:00
parent 74f363af3a
commit 84f0aadf21
1 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/windows.lisp
View File

@ -692,7 +692,7 @@ insetred by the user"
((title
:initform ""
:initarg :title
:accessor title
:reader title
:documentation "The actual title")
(title-padding-left
:initform 3
@ -721,21 +721,26 @@ insetred by the user"
(title-padding-left title-padding-left)) object
(setf title-padding-left padding)
(setf left-stopper left-mark)
(setf right-stopper right-mark)))
(setf right-stopper right-mark)
(setf (slot-value object 'title)
(ellipsize-title object (title object)))))
object)
(defmethod (setf title) ((new-title string) (object title-window))
(with-slots (title) object
(defun ellipsize-title (window title)
(with-accessors ((left-stopper left-stopper)
(right-stopper right-stopper)
(title-padding-left title-padding-left)) object
(let ((clean-title (ellipsize (trim-blanks new-title)
(truncate (/ (- (win-width object)
(title-padding-left title-padding-left)) window
(let ((clean-title (ellipsize (trim-blanks title)
(truncate (/ (- (win-width window)
(length left-stopper)
(length right-stopper)
title-padding-left)
2)))))
(setf title clean-title))))
clean-title)))
(defmethod (setf title) ((new-title string) (object title-window))
(setf (slot-value object 'title)
(ellipsize-title object new-title))
object)
(defmethod draw :after ((object title-window))
@ -744,7 +749,7 @@ insetred by the user"
(title-padding-left title-padding-left)
(title title)) object
(print-text object left-stopper title-padding-left 0)
(print-text object title nil nil)
(print-text object (ellipsize-title object title) nil nil)
(print-text object right-stopper nil nil)))
(defun adjust-win-vertical-positioning-if-gemini-fullscreen (window)