1;; shade-hover.jl -- temporarily unshade windows while hovered over
2
3;; Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
4
5;; This file is part of sawfish.
6
7;; sawfish is free software; you can redistribute it and/or modify it
8;; under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; sawfish is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with sawfish; see the file COPYING.  If not, write to
19;; the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21(define-structure sawfish.wm.ext.shade-hover
22
23    (export clean-up)
24
25    (open rep
26          rep.system
27          rep.io.timers
28          sawfish.wm.windows
29          sawfish.wm.custom
30          sawfish.wm.events
31          sawfish.wm.state.shading)
32
33  (define-structure-alias shade-hover sawfish.wm.ext.shade-hover)
34
35  (defgroup shade-hover "Shade Hover"
36    :group focus
37    :require sawfish.wm.ext.shade-hover)
38
39  (defcustom shade-hover-mode nil
40    "Enable shade-hover mode."
41    :tooltip "(Temporarily unshades windows while the mouse pointer is \
42over them.)"
43    :group (focus shade-hover)
44    :type boolean
45    :require sawfish.wm.ext.shade-hover)
46
47  (defcustom shade-hover-delay 250
48    "Delay in milliseconds before unshading windows."
49    :group (focus shade-hover)
50    :depends shade-hover-mode
51    :type (number 0 5000))
52
53  (defcustom shade-hover-raise nil
54    "Raise windows when they are unshaded."
55    :group (focus shade-hover)
56    :depends shade-hover-mode
57    :type boolean)
58
59  (define shade-hover-timer nil)
60  (define shade-hover-window nil)
61
62  (define (clean-up)
63    (when shade-hover-timer
64      (delete-timer shade-hover-timer)
65      (setq shade-hover-timer nil))
66    (setq shade-hover-window nil)
67    (remove-hook 'pre-command-hook shade-hover-before))
68
69  (define (shade-hover-leave w)
70    (when (eq shade-hover-window w)
71      (clean-up)
72      (when (window-get w 'shade-hover-unshaded)
73	(window-put w 'shade-hover-unshaded nil)
74	(shade-window w))))
75
76  (define (shade-hover-before)
77    (let ((w (current-event-window)))
78      (when (and (windowp w) (window-get w 'shade-hover-unshaded))
79	(case this-command
80	  ((toggle-window-shaded unshade-window)
81	   ;; don't want window to shade then unshade
82	   (clean-up)
83	   (window-put w 'shade-hover-unshaded nil)
84	   (setq this-command nil))
85	  ((shade-window)
86	   (clean-up))))))
87
88  (define (shade-hover-enter w)
89    (when (and (windowp w)
90	       (or shade-hover-mode (window-get w 'shade-hover)))
91      (when (window-get w 'shaded)
92	(let ((callback
93	       (lambda ()
94		 (window-put w 'shade-hover-unshaded t)
95		 (let
96		     ((raise-windows-when-unshaded shade-hover-raise))
97		   (unshade-window w)))))
98	  (when shade-hover-timer
99	    (delete-timer shade-hover-timer))
100	  (setq shade-hover-window w)
101	  (if (zerop shade-hover-delay)
102	      (callback)
103	    (setq shade-hover-timer
104		  (make-timer callback
105			      (quotient shade-hover-delay 1000)
106			      (mod shade-hover-delay 1000))))
107	  (unless (in-hook-p 'pre-command-hook shade-hover-before)
108	    (add-hook 'pre-command-hook shade-hover-before))))))
109
110  (add-hook 'enter-notify-hook shade-hover-enter)
111  (add-hook 'leave-notify-hook shade-hover-leave)
112  (add-hook 'focus-out-hook shade-hover-leave))
113