#| wmaker/dockapps.jl -- WindowMaker-style dockapps handling Copyright (C) 2009 Alexey I. Froloff Copyright (C) 2000 Walter C. Pelissero This file is not part of sawfish. This module 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. This module 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 module. If not, write to the Free Software Foundation, 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA |# (define-structure wmaker.dockapps () (open rep rep.regexp rep.system sawfish.wm.custom sawfish.wm.events sawfish.wm.frames sawfish.wm.misc sawfish.wm.placement sawfish.wm.windows) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; These should belong to workspace.jl or such (defconst WithdrawnState 0) (defconst WM_HINTS_INPUT 1) (defconst WM_HINTS_STATE 2) (defconst WM_HINTS_ICON_PIXMAP 4) (defconst WM_HINTS_ICON_WINDOW 8) (defconst WM_HINTS_ICON_POSITION 16) (defconst WM_HINTS_ICON_MASK 32) (defconst WM_HINTS_WINDOW_GROUP 64) (defconst WMIconSize 64) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgroup dockapps "Dockapps" :group placement :require wmaker.dockapps) (defcustom wmaker:dockapps-placement:origin 'south-west "Dockapp placement origin: \\w" :type (choice north-west north-east south-east south-west) :group (placement dockapps)) (defcustom wmaker:dockapps-placement:direction 'east "Dockapp placement direction: \\w" :type (choice north east south west) :group (placement dockapps)) (defcustom appicon-keymap (bind-keys (make-keymap) "Button1-Move" 'move-window-interactively) "Keymap containing bindings active when the pointer is in the appicon of a window. (Only mouse-bindings are evaluated in this map.)" :group bindings :type keymap) (defcustom wmaker:dockable-class-regexp "^(wmmixer|WMMail|wmmount|wmpinboard)$" "Dockable window class regexp: \\w" :type string :group (placement dockapps)) (define-frame-class 'appicon '((keymap . appicon-keymap))) (define dockapps-origin-x (case wmaker:dockapps-placement:origin ((north-west south-west) 0) ((north-east south-east) (- (screen-width) WMIconSize)))) (define dockapps-origin-y (case wmaker:dockapps-placement:origin ((north-east north-west) 0) ((south-east south-west) (- (screen-height) WMIconSize)))) (define dockapps-per-line (case wmaker:dockapps-placement:direction ((east west) (quotient (screen-width) WMIconSize)) ((north south) (quotient (screen-height) WMIconSize)))) (defun window-state-withdrawn-p (w) "Return true if w is withdrawn." (let ((hints (get-x-property w 'WM_HINTS))) (if hints (let* ((v (nth 2 hints)) (bits (aref v 0)) (state (aref v 2))) ;; check if the state hint is set and it's set to withdrawn (and (not (zerop (logand bits WM_HINTS_STATE))) (= state WithdrawnState)))))) (defun make-dockapp (w) "Check if w is a dockable window. In that case add it to the dock." (let ((class (get-x-property w 'WM_CLASS))) (when (or (window-state-withdrawn-p w) (and class (string-match wmaker:dockable-class-regexp (nth 2 class)))) (window-put w 'avoid t) (window-put w 'sticky t) (window-put w 'sticky-viewport t) (window-put w 'never-focus t) (window-put w 'ignore-program-position t) (window-put w 'type 'dockapp) (window-put w 'depth -1) (place-dockapp w)))) (add-hook 'before-add-window-hook make-dockapp) (defun dockapp-slot-pos (n) "Returns screen coordinates of nth dockapp slot." (cons (case wmaker:dockapps-placement:direction ((north south) (case wmaker:dockapps-placement:origin ((north-west south-west) (+ dockapps-origin-x (* (quotient n dockapps-per-line) WMIconSize))) ((north-east south-east) (- dockapps-origin-x (* (quotient n dockapps-per-line) WMIconSize))))) ((east) (+ dockapps-origin-x (* (% n dockapps-per-line) WMIconSize))) ((west) (- dockapps-origin-x (* (% n dockapps-per-line) WMIconSize)))) (case wmaker:dockapps-placement:direction ((east west) (case wmaker:dockapps-placement:origin ((north-west north-east) (+ dockapps-origin-y (* (quotient n dockapps-per-line) WMIconSize))) ((south-west south-east) (- dockapps-origin-y (* (quotient n dockapps-per-line) WMIconSize))))) ((south) (+ dockapps-origin-y (* (% n dockapps-per-line) WMIconSize))) ((north) (- dockapps-origin-y (* (% n dockapps-per-line) WMIconSize)))))) (defun dockapps-around (point) "Returns list of dockapp windows around given point." (filter-windows (lambda (w) (and (eq (window-get w 'type) 'dockapp) (window-get w 'placed) (let ((w-point (window-position w))) (and (< (abs (- (car w-point) (car point))) (/ WMIconSize 2)) (< (abs (- (cdr w-point) (cdr point))) (/ WMIconSize 2)))))))) (defun snap-dockapp (w) "Snap dockapp window to placement origin." (let* ((w-pos (window-position w)) (x (car w-pos)) (y (cdr w-pos)) (slot (case wmaker:dockapps-placement:direction ((north south) (% (min (quotient (+ (abs (- dockapps-origin-y y)) (/ WMIconSize 2)) WMIconSize) (1- dockapps-per-line)) dockapps-per-line)) ((east west) (% (min (quotient (+ (abs (- dockapps-origin-x x)) (/ WMIconSize 2)) WMIconSize) (1- dockapps-per-line)) dockapps-per-line))))) (window-put w 'placed nil) (while (dockapps-around (dockapp-slot-pos slot)) (setq slot (+ slot dockapps-per-line))) (let ((point (dockapp-slot-pos slot))) ;;;; Unbound variable: backquote-splice ;;(move-window-to w ,@(dockapp-slot-pos slot)) (move-window-to w (car point) (cdr point)) (window-put w 'placed t)))) (add-hook 'after-move-hook (lambda (w) (when (eq (window-get w 'type) 'dockapp) (snap-dockapp w)))) (defun place-dockapp (w) "Place new dockapp window on free space." (let ((placed nil) (i 0)) (while (not placed) (let ((point (dockapp-slot-pos i))) (if (dockapps-around point) (setq i (1+ i)) ;;;; Unbound variable: backquote-splice ;;(move-window-to w ,@point) (move-window-to w (car point) (cdr point)) (window-put w 'placed t) (setq placed t)))))) ;;###autoload (define-placement-mode 'dockapp place-dockapp))