-
Notifications
You must be signed in to change notification settings - Fork 0
/
mode-line-formatters.lisp
180 lines (151 loc) · 6.94 KB
/
mode-line-formatters.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
;; Copyright (C) 2006-2008 Shawn Betts
;;
;; This file is part of thesiswm.
;;
;; thesiswm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; thesiswm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.
(in-package :thesiswm)
(export '(*hidden-window-color*
*mode-line-highlight-template*
bar
bar-zone-color))
;;; Settings
(defvar *hidden-window-color* "^5*"
"Color command for hidden windows when using the
fmt-head-window-list-hidden-windows formatter. To disable coloring
hidden windows, set this to an empty string.")
(defvar *mode-line-highlight-template* "^R~A^r"
"The string passed to FORMAT to highlight things in the mode line.")
;;; Utilities
(defun mode-line-current-group (ml)
(screen-current-group (mode-line-screen ml)))
;;; Formatters
(add-screen-mode-line-formatter #\u 'fmt-urgent-window-list)
(defun fmt-urgent-window-list (ml)
"Using `*window-format*', return a 1 line list of the urgent windows, space seperated."
(format nil "~{~a~^ ~}"
(mapcar (lambda (w)
(let ((str (format-expand *window-formatters* *window-format* w)))
(if (eq w (current-window))
(fmt-highlight str)
str)))
(screen-urgent-windows (mode-line-screen ml)))))
(add-screen-mode-line-formatter #\w 'fmt-window-list)
(defun fmt-window-list (ml)
"Using *window-format*, return a 1 line list of the windows, space seperated."
(format nil "~{~a~^ ~}"
(mapcar (lambda (w) (format-expand *window-formatters* *window-format* w))
(sort-windows (mode-line-current-group ml)))))
(add-screen-mode-line-formatter #\g 'fmt-group-list)
(defun fmt-group-list (ml)
"Given a group list all the groups in the group's screen."
(format nil "~{~a~^ ~}"
(mapcar (lambda (w)
(let* ((str (format-expand *group-formatters* *group-format* w)))
(if (eq w (current-group))
(fmt-highlight str)
str)))
(sort-groups (group-screen (mode-line-current-group ml))))))
(add-screen-mode-line-formatter #\h 'fmt-head)
(defun fmt-head (ml)
(format nil "~d" (head-number (mode-line-head ml))))
(add-screen-mode-line-formatter #\n 'fmt-group)
(defun fmt-group (ml)
(format nil "~a" (group-name (mode-line-current-group ml))))
(defun fmt-highlight (s)
(format nil *mode-line-highlight-template* s))
(add-screen-mode-line-formatter #\W 'fmt-head-window-list)
(defun fmt-head-window-list (ml)
"Using *window-format*, return a 1 line list of the windows, space seperated."
(format nil "~{~a~^ ~}"
(mapcar (lambda (w)
(let ((str (format-expand *window-formatters* *window-format* w)))
(if (eq w (current-window))
(fmt-highlight str)
str)))
(sort1 (head-windows (mode-line-current-group ml) (mode-line-head ml))
#'< :key #'window-number))))
(defun fmt-hidden (s)
(format nil (concat "^[" *hidden-window-color* "~A^]") s))
(add-screen-mode-line-formatter #\v 'fmt-head-window-list-hidden-windows)
(defun fmt-head-window-list-hidden-windows (ml)
"Using *window-format*, return a 1 line list of the windows, space
separated. The currently focused window is highlighted with
fmt-highlight. Any non-visible windows are colored the
*hidden-window-color*."
(let* ((all (head-windows (mode-line-current-group ml) (mode-line-head ml)))
(non-top (set-difference all (top-windows))))
(format nil "~{~a~^ ~}"
(mapcar (lambda (w)
(let ((str (format-expand *window-formatters*
*window-format* w)))
(cond ((eq w (current-window)) (fmt-highlight str))
((find w non-top) (fmt-hidden str))
(t str))))
(sort1 all #'< :key #'window-number)))))
(add-screen-mode-line-formatter #\d 'fmt-modeline-time)
(defun fmt-modeline-time (ml)
(declare (ignore ml))
(time-format *time-modeline-string*))
(defvar *bar-med-color* "^B")
(defvar *bar-hi-color* "^B^3*")
(defvar *bar-crit-color* "^B^1*")
(defun bar-zone-color (amount &optional (med 20) (hi 50) (crit 90) reverse)
"Return a color command based on the magnitude of the argument. If
the limits for the levels aren't specified, they default to sensible
values for a percentage. With reverse, lower numbers are more
critical."
(labels ((past (n) (funcall (if reverse #'<= #'>=) amount n)))
(cond ((past crit) *bar-crit-color*)
((past hi) *bar-hi-color*)
((past med) *bar-med-color*)
(t ""))))
(defun repeat (n char)
(make-string n :initial-element char))
(defun bar (percent width full empty)
"Return a progress bar string of WIDTH characters composed of characters FULL
and EMPTY at PERCENT complete."
(let ((chars (truncate (* (/ width 100) percent))))
(format nil "^[~A~A^]~A" (bar-zone-color percent)
(repeat chars full)
(repeat (- width chars) empty))))
(defvar *alt-prev-index* 0)
(defvar *alt-prev-time* 0)
;; TODO: Figure out a way to objectify fmt-alternate and fmt-scroll so that
;; multiple instances can coexist.
(defun alternate (strings period)
"Show each of STRINGS, alternating at most once every PERIOD seconds."
(let ((now (/ (get-internal-real-time) internal-time-units-per-second)))
(when (>= (- now *alt-prev-time*) period)
(setf *alt-prev-time* now)
(if (< *alt-prev-index* (1- (length strings)))
(incf *alt-prev-index*)
(setf *alt-prev-index* 0))))
(elt strings *alt-prev-index*))
(defvar *scroll-prev-index* 0)
(defvar *scroll-prev-time* 0)
(defvar *scroll-prev-dir* :forward)
(defun scroll (string width delay)
"Scroll STRING within the space of WIDTH characters, with a step of DELAY"
(let ((now (/ (get-internal-real-time) internal-time-units-per-second)))
(when (>= (- now *scroll-prev-time*) delay)
(setf *scroll-prev-time* now)
(case *scroll-prev-dir*
(:forward
(if (< *scroll-prev-index* (- (length string) width))
(incf *scroll-prev-index*)
(setf *scroll-prev-dir* :backward)))
(:backward
(if (> *scroll-prev-index* 0)
(decf *scroll-prev-index*)
(setf *scroll-prev-dir* :forward))))))
(subseq string *scroll-prev-index* (+ *scroll-prev-index* width)))