1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Toolbar
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software
22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 ;;; Documentation: If you want to use this file, just add this line in
25 ;;; your configuration file:
27 ;;; (load-contrib "toolbar.lisp")
29 ;;; You can add a toolbar with the function add-toolbar in your configuration
30 ;;; file. You can obtain modules list with the list-toolbar-modules function.
32 ;;; For convenience, here is the add-toolbar documentation:
34 ;;; add-toolbar (root-x root-y direction size placement modules
35 ;;; &key (autohide *toolbar-default-autohide*)
36 ;;; (thickness *toolbar-default-thickness*)
37 ;;; (refresh-delay *toolbar-default-refresh-delay*)
38 ;;; (border-size *toolbar-default-border-size*))
39 ;;; "Add a new toolbar.
40 ;;; root-x, root-y: root coordinates or if root-y is nil, root-x is the nth root in root-list.
41 ;;; direction: one of :horiz or :vert
42 ;;; placement: same argument as with-placement macro
43 ;;; modules: list of modules: a list of module name, position in percent and arguments.
44 ;;; 0%=left/up <-> 100%=right/down.
45 ;;; Example: '((clock 1) (label 50 \"My label\") (clickable-clock 90))
46 ;;; size: toolbar size in percent of root size
47 ;;; thickness: toolbar height for horizontal toolbar or width for vertical one
48 ;;; autohide: one of nil, :click, or :motion
49 ;;; refresh-delay: refresh delay for toolbar in seconds
50 ;;; border-size: toolbar window border size"
52 ;;; Here are some examples:
53 ;;; (load-contrib "toolbar.lisp")
55 ;;; ;; Add an horizontal toolbar on root at coordinates 0,0 pixels
56 ;;; ;; with default modules
58 ;;; (add-toolbar 0 0 :horiz 80 'top-middle-root-placement *default-toolbar*)
61 ;;; ;; Add an horizontal toolbar on root at coordinates 0,0 pixels
63 ;;; (add-toolbar 0 0 :horiz 90 'top-middle-root-placement
64 ;;; '((clock 1) (label 50 "Plop") (clock-second 25) (clickable-clock 99))
69 ;;; ;; Add an horizontal toolbar on root at coordinates 0,0 pixels
71 ;;; (add-toolbar 0 0 :horiz 70 'bottom-middle-root-placement '((clock 1) (label 50 "Paf) (clock 99))
72 ;;; :autohide :motion)
75 ;;; ;; Add a vertical toolbar on root 0
77 ;;; (add-toolbar 0 nil :vert 60 'middle-left-root-placement '((clock 1) (label 50 "My label") (clock 90)))
80 ;;; ;; Add a vertical toolbar on root 1
82 ;;; (add-toolbar 1 nil :vert 70 'bottom-right-root-placement '((clock 1) (label 50) (clickable-clock 99)))
83 ;;; --------------------------------------------------------------------------
87 (format t
"Loading Toolbar code... ")
89 (pushnew :clfswm-toolbar
*features
*)
91 (defstruct toolbar root-x root-y root direction size thickness placement refresh-delay
92 autohide modules clickable hide-state font window gc border-size
93 exposure-hook button-press-hook motion-notify-hook leave-notify-hook
)
95 (defstruct toolbar-module name pos display-fun click-fun args rect
)
97 (defparameter *toolbar-list
* nil
)
98 (defparameter *toolbar-module-list
* nil
)
100 (defconfig *default-toolbar
* '((clfswm-menu 1)
101 (expose-mode-button 10)
103 (clickable-clock 99))
104 'Toolbar
"Default toolbar modules")
107 ;;; CONFIG - Toolbar window string colors
108 (defconfig *toolbar-window-font-string
* *default-font-string
*
109 'Toolbar
"Toolbar window font string")
110 (defconfig *toolbar-window-background
* "black"
111 'Toolbar
"Toolbar Window background color")
112 (defconfig *toolbar-window-foreground
* "green"
113 'Toolbar
"Toolbar Window foreground color")
114 (defconfig *toolbar-window-border
* "red"
115 'Toolbar
"Toolbar Window border color")
116 (defconfig *toolbar-default-border-size
* 0
117 'Toolbar
"Toolbar Window border size")
118 (defconfig *toolbar-window-transparency
* *default-transparency
*
119 'Toolbar
"Toolbar window background transparency")
120 (defconfig *toolbar-default-thickness
* 20
121 'Toolbar
"Toolbar default thickness")
122 (defconfig *toolbar-default-refresh-delay
* 30
123 'Toolbar
"Toolbar default refresh delay")
124 (defconfig *toolbar-default-autohide
* nil
125 'Toolbar
"Toolbar default autohide value")
126 (defconfig *toolbar-sensibility
* 3
127 'Toolbar
"Toolbar sensibility in pixels")
129 (defconfig *toolbar-window-placement
* 'top-left-placement
130 'Placement
"Toolbar window placement")
132 (use-event-hook :exposure
)
133 (use-event-hook :button-press
)
134 (use-event-hook :motion-notify
)
135 (use-event-hook :leave-notify
)
137 (defun toolbar-symbol-fun (name &optional
(type 'display
))
138 (create-symbol-in-package :clfswm
'toolbar- name
'-module- type
))
140 (defun toolbar-adjust-root-size (toolbar &optional
(dir +1))
141 (unless (toolbar-autohide toolbar
)
142 (let ((root (toolbar-root toolbar
))
143 (placement-name (symbol-name (toolbar-placement toolbar
)))
144 (thickness (+ (toolbar-thickness toolbar
) (* 2 (toolbar-border-size toolbar
)))))
146 (case (toolbar-direction toolbar
)
147 (:horiz
(cond ((search "TOP" placement-name
)
148 (incf (root-y root
) (* thickness dir
))
149 (decf (root-h root
) (* thickness dir
)))
150 ((search "BOTTOM" placement-name
)
151 (decf (root-h root
) (* thickness dir
)))))
152 (t (cond ((search "LEFT" placement-name
)
153 (incf (root-x root
) (* thickness dir
))
154 (decf (root-w root
) (* thickness dir
)))
155 ((search "RIGHT" placement-name
)
156 (decf (root-w root
) (* thickness dir
))))))))))
159 (defun toolbar-draw-text (toolbar pos1 pos2 text color
)
160 "pos1: percent of toolbar, pos2: pixels in toolbar"
161 (labels ((horiz-text ()
162 (let* ((height (- (xlib:font-ascent
(toolbar-font toolbar
)) (xlib:font-descent
(toolbar-font toolbar
))))
163 (dy (truncate (+ pos2
(/ height
2))))
164 (width (xlib:text-width
(toolbar-font toolbar
) text
))
165 (pos (truncate (/ (* (- (xlib:drawable-width
(toolbar-window toolbar
)) width
) pos1
) 100))))
166 (xlib:draw-glyphs
*pixmap-buffer
* (toolbar-gc toolbar
) pos dy text
)
167 (values (+ pos
(xlib:drawable-x
(toolbar-window toolbar
)))
168 (xlib:drawable-y
(toolbar-window toolbar
))
170 (xlib:drawable-height
(toolbar-window toolbar
)))))
172 (let* ((width (xlib:max-char-width
(toolbar-font toolbar
)))
173 (dx (truncate (- pos2
(/ width
2))))
174 (dpos (xlib:max-char-ascent
(toolbar-font toolbar
)))
175 (height (* dpos
(length text
)))
176 (pos (+ (truncate (/ (* (- (xlib:drawable-height
(toolbar-window toolbar
)) height
177 (xlib:max-char-descent
(toolbar-font toolbar
)))
179 (xlib:font-ascent
(toolbar-font toolbar
)))))
180 (loop for c across text
182 do
(xlib:draw-glyphs
*pixmap-buffer
* (toolbar-gc toolbar
) dx
(+ pos
(* i dpos
)) (string c
)))
183 (values (xlib:drawable-x
(toolbar-window toolbar
))
184 (+ (- pos dpos
) (xlib:drawable-y
(toolbar-window toolbar
)))
185 (xlib:drawable-width
(toolbar-window toolbar
))
187 (xlib:with-gcontext
((toolbar-gc toolbar
) :foreground
(get-color color
))
188 (case (toolbar-direction toolbar
)
189 (:horiz
(horiz-text))
190 (:vert
(vert-text))))))
193 (defun toolbar-module-text (toolbar module color formatter
&rest text
)
194 "Print a formatted text at module position centered in toolbar"
195 (toolbar-draw-text toolbar
(toolbar-module-pos module
) (/ *toolbar-default-thickness
* 2)
196 (apply #'format nil formatter text
)
199 (defun is-valid-toolbar (toolbar)
200 (member toolbar
*toolbar-list
*))
203 (defun refresh-toolbar (toolbar)
204 (when (is-valid-toolbar toolbar
)
205 (unless (toolbar-hide-state toolbar
)
206 (add-timer (toolbar-refresh-delay toolbar
)
208 (refresh-toolbar toolbar
))
210 (clear-pixmap-buffer (toolbar-window toolbar
) (toolbar-gc toolbar
))
211 (dolist (module (toolbar-modules toolbar
))
212 (when (fboundp (toolbar-module-display-fun module
))
213 (apply (toolbar-module-display-fun module
) toolbar module
(toolbar-module-args module
))))
214 (copy-pixmap-buffer (toolbar-window toolbar
) (toolbar-gc toolbar
)))))
216 (defun toolbar-in-sensibility-zone-p (toolbar root-x root-y
)
217 (let* ((tb-win (toolbar-window toolbar
))
218 (win-x (xlib:drawable-x tb-win
))
219 (win-y (xlib:drawable-y tb-win
))
220 (width (xlib:drawable-width tb-win
))
221 (height (xlib:drawable-height tb-win
))
222 (tb-dir (toolbar-direction toolbar
) )
223 (placement-name (symbol-name (toolbar-placement toolbar
))))
224 (or (and (equal tb-dir
:horiz
) (search "TOP" placement-name
)
225 (<= root-y win-y
(+ root-y
*toolbar-sensibility
*))
226 (<= win-x root-x
(+ win-x width
)) (toolbar-autohide toolbar
))
227 (and (equal tb-dir
:horiz
) (search "BOTTOM" placement-name
)
228 (<= (+ win-y height
(- *toolbar-sensibility
*)) root-y
(+ win-y height
))
229 (<= win-x root-x
(+ win-x width
)) (toolbar-autohide toolbar
))
230 (and (equal tb-dir
:vert
) (search "LEFT" placement-name
)
231 (<= root-x win-x
(+ root-x
*toolbar-sensibility
*))
232 (<= win-y root-y
(+ win-y height
)) (toolbar-autohide toolbar
))
233 (and (equal tb-dir
:vert
) (search "RIGHT" placement-name
)
234 (<= (+ win-x width
(- *toolbar-sensibility
*)) root-x
(+ win-x width
))
235 (<= win-y root-y
(+ win-y height
)) (toolbar-autohide toolbar
)))))
238 (defun toolbar-add-exposure-hook (toolbar)
239 (push (define-event-hook :exposure
(window)
240 (when (and (is-valid-toolbar toolbar
)
241 (xlib:window-p window
)
242 (xlib:window-equal
(toolbar-window toolbar
) window
))
243 (refresh-toolbar toolbar
)))
244 (toolbar-exposure-hook toolbar
)))
247 (defun toggle-toolbar-hide-state (toolbar)
248 (let* ((tb-win (toolbar-window toolbar
)))
249 (if (toolbar-hide-state toolbar
)
251 (setf (toolbar-hide-state toolbar
) nil
)
253 (raise-window tb-win
)
254 (refresh-toolbar toolbar
))
257 (setf (toolbar-hide-state toolbar
) t
)))))
259 (defun toolbar-add-hide-button-press-hook (toolbar)
260 (push (define-event-hook :button-press
(code root-x root-y
)
261 (when (and (is-valid-toolbar toolbar
) (= code
1)
262 (toolbar-in-sensibility-zone-p toolbar root-x root-y
))
263 (toggle-toolbar-hide-state toolbar
)
264 (wait-mouse-button-release)
266 (exit-handle-event)))
267 (toolbar-button-press-hook toolbar
)))
269 (defun toolbar-add-hide-motion-hook (toolbar)
270 (push (define-event-hook :motion-notify
(root-x root-y
)
271 (unless (compress-motion-notify)
272 (when (and (is-valid-toolbar toolbar
)
273 (toolbar-hide-state toolbar
)
274 (toolbar-in-sensibility-zone-p toolbar root-x root-y
))
275 (map-window (toolbar-window toolbar
))
276 (raise-window (toolbar-window toolbar
))
277 (refresh-toolbar toolbar
)
278 (setf (toolbar-hide-state toolbar
) nil
)
279 (exit-handle-event))))
280 (toolbar-motion-notify-hook toolbar
)))
282 (defun toolbar-add-hide-leave-hook (toolbar)
283 (push (define-event-hook :leave-notify
(root-x root-y
)
284 (when (and (is-valid-toolbar toolbar
)
285 (not (toolbar-hide-state toolbar
))
286 (not (in-window (toolbar-window toolbar
) root-x root-y
)))
287 (hide-window (toolbar-window toolbar
))
288 (setf (toolbar-hide-state toolbar
) t
)
289 (exit-handle-event)))
290 (toolbar-leave-notify-hook toolbar
)))
293 (defun toolbar-add-clickable-module-hook (toolbar)
294 (push (define-event-hook :button-press
(code state root-x root-y
)
295 (when (and (is-valid-toolbar toolbar
)
296 (in-window (toolbar-window toolbar
) root-x root-y
)
297 (not (toolbar-hide-state toolbar
)))
298 (dolist (module (toolbar-modules toolbar
))
299 (when (and (in-rectangle root-x root-y
(toolbar-module-rect module
))
300 (fboundp (toolbar-module-click-fun module
)))
301 (apply (toolbar-module-click-fun module
) toolbar module code state root-x root-y
302 (toolbar-module-args module
))
304 (exit-handle-event)))))
305 (toolbar-button-press-hook toolbar
)))
308 (defun define-toolbar-hooks (toolbar)
309 (toolbar-add-exposure-hook toolbar
)
310 (when (toolbar-clickable toolbar
)
311 (toolbar-add-clickable-module-hook toolbar
))
312 (case (toolbar-autohide toolbar
)
313 (:click
(toolbar-add-hide-button-press-hook toolbar
))
314 (:motion
(toolbar-add-hide-motion-hook toolbar
)
315 (toolbar-add-hide-leave-hook toolbar
))))
317 (defun set-clickable-toolbar (toolbar)
318 (dolist (module (toolbar-modules toolbar
))
319 (when (fboundp (toolbar-module-click-fun module
))
320 (setf (toolbar-clickable toolbar
) t
))))
323 (defmacro remove-toolbar-hook
(toolbar keyword
)
324 (let ((fun (create-symbol 'toolbar- keyword
'-hook
)))
325 `(dolist (hook (,fun
,toolbar
))
326 (remove-event-hook ,keyword hook
))))
330 (let ((windows-list nil
))
331 (defun is-toolbar-window-p (win)
332 (and (xlib:window-p win
) (member win windows-list
:test
'xlib
:window-equal
)))
334 (defun close-toolbar (toolbar)
335 (when (toolbar-p toolbar
)
336 (erase-timer :refresh-toolbar-window
)
337 (remove-toolbar-hook toolbar
:exposure
)
338 (remove-toolbar-hook toolbar
:button-press
)
339 (remove-toolbar-hook toolbar
:leave-notify
)
340 (remove-toolbar-hook toolbar
:motion-notify
)
341 (setf *never-managed-window-list
*
342 (remove (list #'is-toolbar-window-p nil
)
343 *never-managed-window-list
* :test
#'equal
))
344 (awhen (toolbar-gc toolbar
)
345 (xlib:free-gcontext it
))
346 (awhen (toolbar-window toolbar
)
347 (xlib:destroy-window it
))
348 (awhen (toolbar-font toolbar
)
349 (xlib:close-font it
))
350 (xlib:display-finish-output
*display
*)
351 (setf (toolbar-window toolbar
) nil
352 (toolbar-gc toolbar
) nil
353 (toolbar-font toolbar
) nil
)))
355 (defun open-toolbar (toolbar)
356 (let ((root (root (toolbar-root-x toolbar
) (toolbar-root-y toolbar
))))
358 (setf (toolbar-root toolbar
) root
)
359 (let ((*get-current-root-fun
* (lambda () root
)))
360 (setf (toolbar-font toolbar
) (xlib:open-font
*display
* *toolbar-window-font-string
*))
361 (let* ((width (if (equal (toolbar-direction toolbar
) :horiz
)
362 (round (/ (* (root-w root
) (toolbar-size toolbar
)) 100))
363 (toolbar-thickness toolbar
)))
364 (height (if (equal (toolbar-direction toolbar
) :horiz
)
365 (toolbar-thickness toolbar
)
366 (round (/ (* (root-h root
) (toolbar-size toolbar
)) 100)))))
367 (with-placement ((toolbar-placement toolbar
) x y width height
(toolbar-border-size toolbar
))
368 (setf (toolbar-window toolbar
) (xlib:create-window
:parent
*root
*
373 :background
(get-color *toolbar-window-background
*)
374 :border-width
(toolbar-border-size toolbar
)
375 :border
(when (plusp (toolbar-border-size toolbar
))
376 (get-color *toolbar-window-border
*))
377 :colormap
(xlib:screen-default-colormap
*screen
*)
378 :event-mask
'(:exposure
:key-press
:leave-window
380 (toolbar-gc toolbar
) (xlib:create-gcontext
:drawable
(toolbar-window toolbar
)
381 :foreground
(get-color *toolbar-window-foreground
*)
382 :background
(get-color *toolbar-window-background
*)
383 :font
(toolbar-font toolbar
)
385 (push (toolbar-window toolbar
) windows-list
)
386 (setf (window-transparency (toolbar-window toolbar
)) *toolbar-window-transparency
*)
387 (add-in-never-managed-window-list (list 'is-toolbar-window-p nil
))
388 (map-window (toolbar-window toolbar
))
389 (raise-window (toolbar-window toolbar
))
390 (refresh-toolbar toolbar
)
391 (when (toolbar-autohide toolbar
)
392 (hide-window (toolbar-window toolbar
))
393 (setf (toolbar-hide-state toolbar
) t
))
394 (xlib:display-finish-output
*display
*)
395 (set-clickable-toolbar toolbar
)
396 (define-toolbar-hooks toolbar
))))))))
400 (defun remove-toolbar (toolbar)
401 (close-toolbar toolbar
)
402 (setf *toolbar-list
* (remove toolbar
*toolbar-list
* :test
#'equal
)))
405 (defun open-all-toolbars ()
407 (dolist (toolbar *toolbar-list
*)
408 (open-toolbar toolbar
))
409 (dolist (toolbar *toolbar-list
*)
410 (toolbar-adjust-root-size toolbar
)))
412 (defun close-all-toolbars ()
413 (dolist (toolbar *toolbar-list
*)
414 (toolbar-adjust-root-size toolbar -
1))
415 (dolist (toolbar *toolbar-list
*)
416 (remove-toolbar toolbar
))
419 (defun create-toolbar-modules (modules)
420 (loop for mod in modules
421 collect
(make-toolbar-module :name
(first mod
)
423 :display-fun
(toolbar-symbol-fun (first mod
))
424 :click-fun
(toolbar-symbol-fun (first mod
) 'click
)
429 (defun add-toolbar (root-x root-y direction size placement modules
430 &key
(autohide *toolbar-default-autohide
*)
431 (thickness *toolbar-default-thickness
*)
432 (refresh-delay *toolbar-default-refresh-delay
*)
433 (border-size *toolbar-default-border-size
*))
435 root-x, root-y: root coordinates or if root-y is nil, root-x is the nth root in root-list.
436 direction: one of :horiz or :vert
437 placement: same argument as with-placement macro
438 modules: list of modules: a list of module name, position in percent and arguments.
439 0%=left/up <-> 100%=right/down.
440 Example: '((clock 1) (label 50 \"My label\") (clickable-clock 90))
441 size: toolbar size in percent of root size
442 thickness: toolbar height for horizontal toolbar or width for vertical one
443 autohide: one of nil, :click, or :motion
444 refresh-delay: refresh delay for toolbar in seconds
445 border-size: toolbar window border size"
446 (let ((toolbar (make-toolbar :root-x root-x
:root-y root-y
447 :direction direction
:size size
451 :refresh-delay refresh-delay
452 :border-size border-size
453 :modules
(create-toolbar-modules modules
))))
454 (push toolbar
*toolbar-list
*)
458 (add-hook *init-hook
* 'open-all-toolbars
)
459 (add-hook *close-hook
* 'close-all-toolbars
)
462 (defun set-toolbar-module-rectangle (module x y width height
)
463 (unless (toolbar-module-rect module
)
464 (setf (toolbar-module-rect module
) (make-rectangle)))
465 (setf (rectangle-x (toolbar-module-rect module
)) x
466 (rectangle-y (toolbar-module-rect module
)) y
467 (rectangle-width (toolbar-module-rect module
)) width
468 (rectangle-height (toolbar-module-rect module
)) height
))
470 (defmacro with-set-toolbar-module-rectangle
((module) &body body
)
471 (let ((x (gensym)) (y (gensym)) (width (gensym)) (height (gensym)))
472 `(multiple-value-bind (,x
,y
,width
,height
)
474 (set-toolbar-module-rectangle ,module
,x
,y
,width
,height
))))
478 (defmacro define-toolbar-module
((name &rest args
) &body body
)
479 (let ((symbol-fun (toolbar-symbol-fun name
)))
481 (pushnew ',name
*toolbar-module-list
*)
482 (defun ,symbol-fun
(toolbar module
,@(when args
`(&optional
,@args
)))
485 (defmacro define-toolbar-module-click
((name &rest args
) &body body
)
486 (let ((symbol-fun (toolbar-symbol-fun name
'click
)))
488 (pushnew ',name
*toolbar-module-list
*)
489 (defun ,symbol-fun
(toolbar module code state root-x root-y
,@(when args
`(&optional
,@args
)))
493 (defun list-toolbar-modules (&optional
(stream t
))
494 "List all toolbar modules"
495 (format stream
"Toolbar modules availables:~%")
496 (dolist (module (reverse *toolbar-module-list
*))
497 (format stream
" Module: ~A~%" module
)
498 (when (fboundp (toolbar-symbol-fun module
))
499 (format stream
" ~A~%" (documentation (toolbar-symbol-fun module
) 'function
)))
500 (when (fboundp (toolbar-symbol-fun module
'click
))
501 (format stream
" On click: ~A~%" (documentation (toolbar-symbol-fun module
'click
) 'function
)))))
504 (defmacro define-toolbar-color
(name doc-string
&optional
(value *toolbar-window-foreground
*))
505 (let ((symbol-name (create-symbol '*toolbar- name
'-color
*)))
506 `(defconfig ,symbol-name
,value
'Toolbar
,doc-string
)))
508 (defmacro tb-color
(name)
509 (let ((symbol-name (create-symbol '*toolbar- name
'-color
*)))
514 ;;; Module subdivisions functions
516 (defun toolbar-module-subdiv-horiz (module root-x N
)
517 (truncate (* N
(/ (- root-x
(rectangle-x (toolbar-module-rect module
)))
518 (rectangle-width (toolbar-module-rect module
))))))
520 (defun toolbar-module-subdiv-vert (module root-y N
)
521 (truncate (* N
(/ (- root-y
(rectangle-y (toolbar-module-rect module
)))
522 (rectangle-height (toolbar-module-rect module
))))))
524 (defun toolbar-module-subdiv (toolbar module root-x root-y N
)
525 (case (toolbar-direction toolbar
)
526 (:horiz
(toolbar-module-subdiv-horiz module root-x N
))
527 (:vert
(toolbar-module-subdiv-vert module root-y N
))))
531 ;;; Modules definitions
537 (define-toolbar-color clock
"Clock color")
539 (define-toolbar-module (clock)
541 (multiple-value-bind (s m h
)
544 (toolbar-module-text toolbar module
(tb-color clock
) "~2,'0D:~2,'0D" h m
)))
547 ;;; Clock module with seconds
549 (define-toolbar-module (clock-second)
550 "A clock module with seconds"
551 (multiple-value-bind (s m h
)
553 (toolbar-module-text toolbar module
(tb-color clock
) "~2,'0D:~2,'0D:~2,'0D" h m s
)))
559 (define-toolbar-color label
"Label color")
561 (define-toolbar-module (label text
)
562 "(text) - Display a text in toolbar"
563 (toolbar-module-text toolbar module
(tb-color label
) (or text
"Empty")))
566 ;;; Clickable label module
568 (define-toolbar-color clickable-label
"Clickable label color")
570 (define-toolbar-module (clickable-label text action
)
571 "(text action) - Display a clickable text in toolbar"
572 (declare (ignore action
))
573 (with-set-toolbar-module-rectangle (module)
574 (toolbar-module-text toolbar module
(tb-color clickable-label
) (or text
"Empty"))))
576 (define-toolbar-module-click (clickable-label text action
)
577 "Call the function 'action'"
578 (declare (ignore text root-x root-y
))
580 (funcall action toolbar module code state
)))
583 ;;; Clickable clock module
585 (define-toolbar-color clickable-clock
"Clickable clock color")
587 (define-toolbar-module (clickable-clock)
588 "A clickable clock module"
589 (multiple-value-bind (s m h
)
592 (with-set-toolbar-module-rectangle (module)
593 (toolbar-module-text toolbar module
(tb-color clickable-clock
) "~2,'0D:~2,'0D" h m
))))
596 (defconfig *toolbar-clock-action
* "xclock -analog"
597 'toolbar
"Toolbar clickable clock module action on click")
599 (define-toolbar-module-click (clickable-clock)
600 "Start an external clock"
601 (declare (ignore toolbar module state root-x root-y
))
603 (do-shell *toolbar-clock-action
*)))
610 ;;; CLFSWM menu module
612 (define-toolbar-color clfswm-menu
"CLFSWM menu color")
614 (define-toolbar-module (clfswm-menu text placement
)
615 "(text placement) - Display an entry for the CLFSWM menu"
616 (declare (ignore placement
))
617 (with-set-toolbar-module-rectangle (module)
618 (toolbar-module-text toolbar module
(tb-color clfswm-menu
) (or text
"CLFSWM"))))
620 (define-toolbar-module-click (clfswm-menu text placement
)
621 "Open the CLFSWM main menu"
622 (declare (ignore text code state toolbar module root-x root-y
))
623 (let ((*info-mode-placement
* (or placement
*info-mode-placement
*)))
629 (define-toolbar-color cpu
"CPU color")
631 (define-toolbar-module (cpu)
632 "Display the CPU usage (slow methode)"
633 (toolbar-module-text toolbar module
(tb-color cpu
) "CPU:~A%" (cpu-usage)))
639 (define-toolbar-color mem
"Memory color")
641 (define-toolbar-module (mem)
642 "Display the memory usage (slow methode)"
643 (multiple-value-bind (used total
)
645 (toolbar-module-text toolbar module
(tb-color mem
) "Mem:~A%" (round (* (/ used total
) 100.0)))))
652 (define-toolbar-color system-info
"System information colors (CPU+Mem+Battery)")
653 (define-toolbar-color system-info-low
"System information colors (CPU+Mem+Battery)" "Yellow")
654 (define-toolbar-color system-info-alert
"System information colors (CPU+Mem+Battery)" "Magenta")
655 (define-toolbar-color system-info-urgent
"System information colors (CPU+Mem+Battery)" "Red")
657 (defun toolbar-battery-color (bat)
659 (cond ((<= bat
5) (tb-color system-info-urgent
))
660 ((<= bat
10) (tb-color system-info-alert
))
661 ((<= bat
25) (tb-color system-info-low
))
662 (t (tb-color system-info
)))
663 (tb-color system-info
)))
665 (define-toolbar-module (bat)
666 "Display the battery usage (slow methode)"
667 (let* ((bat (battery-usage)))
668 (toolbar-module-text toolbar module
669 (toolbar-battery-color bat
)
675 ;;; System usage - Battery, CPU and Memory usage all in one
677 (define-toolbar-module (system-usage (poll-delay 10))
678 "Display system usage: CPU, Memory and Battery (poll methode)"
679 (multiple-value-bind (cpu used total bat
)
680 (system-usage-poll poll-delay
)
681 (toolbar-module-text toolbar module
(toolbar-battery-color bat
)
682 "Bat:~A% CPU:~A% Mem:~A%"
684 (round (* (/ used total
) 100)))))
687 ;;; CPU and Memory usage - CPU and Memory usage
689 (define-toolbar-module (system-cpu-mem (poll-delay 10))
690 "Display system usage: CPU and Memory (poll methode)"
691 (multiple-value-bind (cpu used total
)
692 (system-usage-poll poll-delay
)
693 (toolbar-module-text toolbar module
(tb-color cpu
)
696 (round (* (/ used total
) 100)))))
699 ;;; Expose-mode-button
701 (define-toolbar-color expose-mode-button
"Expose-mode button")
703 (define-toolbar-module (expose-mode-button text
)
704 "On click, switch to expose-mode"
705 (with-set-toolbar-module-rectangle (module)
706 (toolbar-module-text toolbar module
(tb-color expose-mode-button
) (or text
"Xpo"))))
708 (define-toolbar-module-click (expose-mode-button)
709 "left click=Show only current frames ; Right click=show all roots frames"
710 (declare (ignore state toolbar module root-x root-y
))
712 (expose-windows-mode)
713 (expose-all-windows-mode)))