contrib/toolbar.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Toolbar
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2011 Philippe Brochard <hocwp@free.fr>
   9 ;;;
  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.
  14 ;;;
  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.
  19 ;;;
  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.
  23 ;;;
  24 ;;; Documentation: If you want to use this file, just add this line in
  25 ;;; your configuration file:
  26 ;;;
  27 ;;;   (load-contrib "toolbar.lisp")
  28 ;;;
  29 ;;; --------------------------------------------------------------------------
  30
  31 (in-package :clfswm)
  32
  33 (format t "Loading Toolbar code... ")
  34
  35 (defstruct toolbar root-x root-y root direction size thickness placement autohide modules font window gc)
  36
  37 (defparameter *toolbar-list* nil)
  38
  39 ;;; CONFIG - Toolbar window string colors
  40 (defconfig *toolbar-window-font-string* *default-font-string*
  41   'Toolbar-Window "Toolbar window font string")
  42 (defconfig *toolbar-window-background* "black"
  43   'Toolbar-Window "Toolbar Window background color")
  44 (defconfig *toolbar-window-foreground* "green"
  45   'Toolbar-Window "Toolbar Window foreground color")
  46 (defconfig *toolbar-window-border* "red"
  47   'Toolbar-Window "Toolbar Window border color")
  48 (defconfig *toolbar-window-transparency* *default-transparency*
  49   'Toolbar-window "Toolbar window background transparency")
  50 (defconfig *toolbar-default-thickness* 10
  51   'toolbar-window "Toolbar default thickness")
  52
  53 (defconfig *toolbar-window-placement* 'top-left-placement
  54   'Placement "Toolbar window placement")
  55
  56
  57
  58 (defun toolbar-adjust-root-size (toolbar)
  59   (unless (toolbar-autohide toolbar)
  60     (let ((root (toolbar-root toolbar))
  61           (placement-name (symbol-name (toolbar-placement toolbar)))
  62           (thickness (+ (toolbar-thickness toolbar) (* 2 *border-size*))))
  63       (case (toolbar-direction toolbar)
  64         (:horiz (cond ((search "TOP" placement-name)
  65                        (incf (root-y root) thickness)
  66                        (decf (root-h root) thickness))
  67                       ((search "BOTTOM" placement-name)
  68                        (decf (root-h root) thickness))))
  69         (t (cond ((search "LEFT" placement-name)
  70                   (incf (root-x root) thickness)
  71                   (decf (root-w root) thickness))
  72                  ((search "RIGHT" placement-name)
  73                   (decf (root-w root) thickness))))))))
  74
  75
  76 (let ((windows-list nil))
  77   (defun is-toolbar-window-p (win)
  78     (and (xlib:window-p win) (member win windows-list :test 'xlib:window-equal)))
  79
  80   ;;    (defun refresh-toolbar-window ()
  81   ;;      (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
  82   ;;      (raise-window window)
  83   ;;      (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
  84   ;;    (loop for tx in text
  85   ;;       for i from 1 do
  86   ;;         (setf (xlib:gcontext-foreground gc) (text-color tx))
  87   ;;         (xlib:draw-glyphs window gc
  88   ;;                           (truncate (/ (- width (* (xlib:max-char-width font) (length (text-string tx)))) 2))
  89   ;;                           (* text-height i 2)
  90   ;;                           (text-string tx)))))
  91   ;;
  92   ;;    (defun close-toolbar-window ()
  93   ;;      (erase-timer :refresh-toolbar-window)
  94   ;;      (setf *never-managed-window-list*
  95   ;;        (remove (list #'is-toolbar-window-p 'raise-window)
  96   ;;                *never-managed-window-list* :test #'equal))
  97   ;;      (when gc
  98   ;;    (xlib:free-gcontext gc))
  99   ;;      (when window
 100   ;;    (xlib:destroy-window window))
 101   ;;      (when font
 102   ;;    (xlib:close-font font))
 103   ;;      (xlib:display-finish-output *display*)
 104   ;;      (setf window nil
 105   ;;        gc nil
 106   ;;        font nil))
 107
 108   (defun open-toolbar (toolbar)
 109     (let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
 110       (when (root-p root)
 111         (setf (toolbar-root toolbar) root)
 112         (let ((*get-current-root-fun* (lambda () root)))
 113           (setf (toolbar-font toolbar) (xlib:open-font *display* *toolbar-window-font-string*))
 114           (let* ((width (if (equal (toolbar-direction toolbar) :horiz)
 115                             (round (/ (* (root-w root) (toolbar-size toolbar)) 100))
 116                             (toolbar-thickness toolbar)))
 117                  (height (if (equal (toolbar-direction toolbar) :horiz)
 118                              (toolbar-thickness toolbar)
 119                              (round (/ (* (root-h root) (toolbar-size toolbar)) 100)))))
 120             (with-placement ((toolbar-placement toolbar) x y width height)
 121               (setf (toolbar-window toolbar) (xlib:create-window :parent *root*
 122                                                                  :x x
 123                                                                  :y y
 124                                                                  :width width
 125                                                                  :height height
 126                                                                  :background (get-color *toolbar-window-background*)
 127                                                                  :border-width *border-size*
 128                                                                  :border (get-color *toolbar-window-border*)
 129                                                                  :colormap (xlib:screen-default-colormap *screen*)
 130                                                                  :event-mask '(:exposure :key-press))
 131                     (toolbar-gc toolbar) (xlib:create-gcontext :drawable (toolbar-window toolbar)
 132                                                                :foreground (get-color *toolbar-window-foreground*)
 133                                                                :background (get-color *toolbar-window-background*)
 134                                                                :font (toolbar-font toolbar)
 135                                                                :line-style :solid))
 136               (push (toolbar-window toolbar) windows-list)
 137               (setf (window-transparency (toolbar-window toolbar)) *toolbar-window-transparency*)
 138               (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
 139               (map-window (toolbar-window toolbar))
 140               (raise-window (toolbar-window toolbar))
 141               ;;(refresh-toolbar-window)
 142               (xlib:display-finish-output *display*))))))))
 143
 144 (defun open-all-toolbars ()
 145   "Open all toolbars"
 146   (dolist (toolbar *toolbar-list*)
 147     (open-toolbar toolbar))
 148   (dolist (toolbar *toolbar-list*)
 149     (toolbar-adjust-root-size toolbar)))
 150
 151
 152 (defun add-toolbar (root-x root-y direction size placement autohide &rest modules)
 153   "Add a new toolbar.
 154      root-x, root-y: root coordinates
 155      direction: one of :horiz or :vert
 156      size: toolbar size in percent of root size"
 157   (let ((toolbar (make-toolbar :root-x root-x :root-y root-y
 158                       :direction direction :size size
 159                       :thickness *toolbar-default-thickness*
 160                       :placement placement
 161                       :autohide autohide
 162                       :modules modules)))
 163     (push toolbar *toolbar-list*)
 164     toolbar))
 165
 166
 167 (add-hook *init-hook* 'open-all-toolbars)
 168
 169
 170 (format t "done~%")