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