cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-win.el

   1 ;;; xwem-win.el --- Windows ops for XWEM.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: 21 Mar 2003
   7 ;; Keywords: xlib, xwem
   8 ;; X-CVS: $Id: xwem-win.el,v 1.9 2005-04-04 19:54:17 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30 ;;
  31 ;; This file contain operations on XWEM windows.  Window is part of
  32 ;; Frame, Window holds X client - CL.
  33 ;;
  34
  35 ;;; Code
  36 \f
  37 (require 'xwem-load)
  38
  39 ;;; Customisation
  40 (defgroup xwem-win nil
  41   "Group to customize XWEM windows."
  42   :prefix "xwem-win-"
  43   :group 'xwem)
  44
  45 ;;;###autoload
  46 (defcustom xwem-win-min-width 80
  47   "*Minimal width for window"
  48   :type 'number
  49   :group 'xwem-win)
  50
  51 ;;;###autoload
  52 (defcustom xwem-win-min-height 80
  53   "*Minimal height for window"
  54   :type 'number
  55   :group 'xwem-win)
  56
  57 ;;;###xwem-autoload
  58 (defcustom xwem-win-vertical-delim-width '(8 . 1)
  59   "*Width in pixels for vertical delimiters.
  60 car is delimiter width, cdr is shadow thickness."
  61   :type '(cons number number)
  62   :group 'xwem-win)
  63
  64 ;;;###xwem-autoload
  65 (defcustom xwem-win-horizontal-delim-width '(6 . 1)
  66   "*Width in pixels for horizontal delimiters.
  67 car is delimiter width, cdr is shadow thickness."
  68   :type '(cons number number)
  69   :group 'xwem-win)
  70
  71 (defcustom xwem-win-default-border-width 1
  72   "*Default border width for newly created windows."
  73   :type 'number
  74   :group 'xwem-win)
  75
  76 (defcustom xwem-win-default-properties
  77   (list 'attachable nil)
  78   "*Default properties list for frame windows.
  79
  80 dead       - window that referenced but not workable.
  81 deleted    - deleted window have this equal to t
  82 frame      - frame window attached to.
  83 next       - next window in windows double linked list.
  84 prev       - previous window.
  85 hchild     - child window after horizontal split.
  86 vchild     - child window after vertical split.
  87 parent     - parent window (window in which we do split).
  88 client     - client currently active in window. (index in clients-list)
  89 attachable - if non-nil then frame may be attached to some frame's
  90              window. (not yet implemented [is it will be usefull?])
  91 expectances - list of expectances for window.
  92 "
  93   :type '(restricted-sexp :match-alternatives (valid-plist-p))
  94   :group 'xwem-win)
  95
  96 (defcustom xwem-win-winmove-allow-jumping t
  97   "*Non-nil allows jumping to opposite edge, when no window founded."
  98   :type 'boolean
  99   :group 'xwem-win)
 100
 101 (defcustom xwem-win-collect-deleted-clients t
 102   "*Non-nil mean clients managed in window that are deleting now, will
 103 be placed in `xwem-window-other' window."
 104   :type 'boolean
 105   :group 'xwem-win)
 106
 107 (defcustom xwem-win-max-clients 32
 108   "*Maximum number of clients in window.
 109 NOT USED."
 110   :type 'number
 111   :group 'xwem-win)
 112
 113 \f
 114 ;;; Hooks
 115 (defcustom xwem-win-switch-hook nil
 116   "Hooks to be called when window switching occurs.
 117 Function will receive two arguments OLD-WIN and NEW-WIN."
 118   :type 'hook
 119   :group 'xwem-hooks)
 120
 121 (defcustom xwem-win-delete-hook nil
 122   "Hooks called with one arg - window when deleting window."
 123   :type 'hook
 124   :group 'xwem-hooks)
 125
 126 (defcustom xwem-win-clients-change-hook nil
 127   "Hooks called when win's clients list changed."
 128   :type 'hook
 129   :group 'xwem-hooks)
 130
 131 ;;;###autoload
 132 (defcustom xwem-win-split-hook nil
 133   "Hook to be called after window split.
 134 Functions will be called with two arguments: SPLIT-WIN, NEW-WIN."
 135   :type 'hook
 136   :group 'xwem-hooks)
 137
 138 (define-xwem-face xwem-window-outline-face
 139   `(((frame-selected win-selected)
 140      (:foreground "green" :background "green4" :line-width 4))
 141     ((frame-selected win-nonselected)
 142      (:foreground "gray70" :background "gray70" :line-width 4))
 143     ((frame-nonselected win-selected)
 144      (:foreground "green3" :background "green4" :line-width 4))
 145     ((frame-nonselected win-nonselected)
 146      (:foreground "gray60" :background "gray40" :line-width 4)))
 147   "Face to outline frame windows."
 148   :group 'xwem-win
 149   :group 'xwem-faces)
 150
 151 (define-xwem-face xwem-window-delimiter-face
 152   `(((horizontal)
 153      (:foreground "royalblue"))
 154     ((horizontal shadow)
 155      (:foreground "blue4"))
 156     ((horizontal light shadow)
 157      (:foreground "cyan"))
 158     ((vertical)
 159      (:foreground "royalblue"))
 160     ((shadow vertical)
 161      (:foreground "blue4"))
 162     ((light shadow vertical)
 163      (:foreground "cyan"))
 164     (t (:foreground "gray20" :background "black")))
 165   "Face to draw window delimiter."
 166   :group 'xwem-win
 167   :group 'xwem-faces)
 168
 169 ;;; Internal variables
 170
 171 \f
 172 ;;;; Win macros
 173 (defmacro xwem-win-child (window)
 174   "Return child of WINDOW, hchild checked first then if not set vchild
 175   tested."
 176   `(or (xwem-win-hchild ,window) (xwem-win-vchild ,window)))
 177
 178 (defmacro xwem-win-mark-deleted (win)
 179   "Mark WIN as deleted window."
 180   `(setf (xwem-win-deleted ,win) t))
 181
 182 ;;;###xwem-autoload
 183 (defun xwem-win-delim-width (window)
 184   "Return WIN's delimiter width."
 185   (let ((pwin (xwem-win-parent window)))
 186     (or (and pwin (xwem-win-hchild pwin) (car xwem-win-horizontal-delim-width))
 187         (and pwin (xwem-win-vchild pwin) (car xwem-win-vertical-delim-width))
 188         0)))
 189
 190 ;;;###xwem-autoload
 191 (defun xwem-win-delim-shadow-thickness (window)
 192   "Return WIN's delimiter width."
 193   (let ((pwin (xwem-win-parent window)))
 194     (or (and pwin (xwem-win-hchild pwin) (cdr xwem-win-horizontal-delim-width))
 195         (and pwin (xwem-win-vchild pwin) (cdr xwem-win-vertical-delim-width))
 196         0)))
 197
 198 \f
 199 ;;;; Functions
 200 ;;;###xwem-autoload
 201 (defun xwem-win-make-list-by-next (window)
 202   "Create list of WINDOW and all next windows."
 203   (let ((wins window)
 204         rlist)
 205     (while (xwem-win-p wins)
 206       (setq rlist (cons wins rlist))
 207       (setq wins (xwem-win-next wins)))
 208     (nreverse rlist)))
 209
 210 ;;;###xwem-autoload
 211 (defun xwem-win-num (win)
 212   "Return relative WIN's number in logical window list."
 213   (let ((ch (xwem-win-child (xwem-frame-rootwin (xwem-win-frame win))))
 214         (idx 0))
 215     (when (xwem-win-p ch)
 216       (while (not (xwem-win-alive-p ch))
 217         (setq ch (xwem-win-child ch)))
 218       ;; CH is very first window in frame
 219       (while (not (eq ch win))
 220         (setq idx (1+ idx)
 221               ch (xwem-window-next ch))))
 222     idx))
 223
 224 ;;;###xwem-autoload
 225 (defun xwem-win-find-by-num (frame num)
 226   "In FRAME find window for which `xwem-win-num' returns NUM."
 227   (let* ((fch (xwem-win-child (xwem-frame-rootwin frame)))
 228          (ch fch))
 229     (if (not (xwem-win-p ch))
 230         (and (= num 0) (xwem-frame-rootwin frame))
 231
 232       (while (not (xwem-win-alive-p ch))
 233         (setq ch (xwem-win-child ch)))
 234       ;; CH is very first window in frame
 235       (while (and (> num 0) ch)
 236         (setq ch (xwem-window-next ch))
 237         (if (eq ch fch)
 238             (setq ch nil)
 239           (decf num)))
 240       ch)))
 241
 242 ;; We do want closures in emacs lisp
 243 (defvar xwem-win-next-id 0)
 244 (defun xwem-win-gen-id ()
 245   "Generate new window id."
 246   (truncate (X-Dpy-get-id (xwem-dpy))))
 247
 248 (defun xwem-win-hacked-or (&rest args)
 249   "Like `or', but can by used under `apply'."
 250   (while (and args (null (car args)))
 251     (setq args (cdr args)))
 252   (car args))
 253
 254 ;;;###xwem-autoload
 255 (defun xwem-win-find-by-id (win-id &optional win)
 256   "Find a window with WIN-ID."
 257   (cond ((and (xwem-win-p win)
 258               (= (xwem-win-id win) win-id))
 259          win)
 260
 261         ((xwem-win-p win)
 262          (or (apply 'xwem-win-hacked-or
 263                     (mapcar #'(lambda (w)
 264                                 (xwem-win-find-by-id win-id w))
 265                             (xwem-win-make-list-by-next (xwem-win-child win))))
 266              (apply 'xwem-win-hacked-or
 267                     (mapcar #'(lambda (w)
 268                                 (xwem-win-find-by-id win-id w))
 269                             (delq win (xwem-win-make-list-by-next win))))))
 270
 271         (t (apply 'xwem-win-hacked-or
 272                   (mapcar #'(lambda (w)
 273                               (xwem-win-find-by-id win-id w))
 274                           (mapcar #'xwem-frame-rootwin
 275                                   xwem-frames-list))))))
 276
 277 ;;;###xwem-autoload
 278 (defun xwem-cl-set-win (cl win)
 279   "Associate CL with WIN.
 280 WIN is valid WIN or nil."
 281   (unless (eq (xwem-cl-win cl) win)
 282     (let ((owin (xwem-cl-win cl)))
 283       ;; Deactivate CL, when changing window
 284       (xwem-deactivate cl)
 285
 286       (setf (xwem-cl-win cl) win)
 287
 288       ;; Set also client property
 289       (xwem-client-set-property
 290        cl 'client-window (and (xwem-win-p win) (xwem-win-id win)))
 291
 292       ;; Remove CL from OWIN's clients list
 293       (when (xwem-win-p owin)
 294         (xwem-win-rem-cl owin cl))))
 295
 296   ;; Add CL to WIN's clients list
 297   (when (xwem-win-p win)
 298     (xwem-win-add-cl win cl)))
 299
 300 ;;;###xwem-autoload
 301 (defun xwem-win-add-cl (win cl)
 302   "Into WIN's clients list add new client CL."
 303   (unless (or (not (xwem-cl-p cl))
 304               (memq cl (xwem-win-clients win)))
 305
 306     (when (and (xwem-frame-dedicated-p (xwem-win-frame win))
 307                (xwem-win-clients win))
 308       (error 'xwem-error "Window in dedicted frame already has client"))
 309
 310     ;; Insert CL in WIN's clients list in proper place (as in
 311     ;; `xwem-clients')
 312     (let ((wcls (xwem-win-clients win)))
 313       (while (and wcls (memq cl (memq (car wcls) xwem-clients)))
 314         (setq wcls (cdr wcls)))
 315       (if (not wcls)
 316           (setf (xwem-win-clients win)
 317                 (append (xwem-win-clients win) (list cl)))
 318         (setcdr wcls (cons (car wcls) (cdr wcls)))
 319         (setcar wcls cl)))
 320
 321     (run-hook-with-args 'xwem-win-clients-change-hook win)))
 322
 323 ;;;###xwem-autoload
 324 (defun xwem-win-rem-cl (win cl)
 325   "From WIN's clients list remove client CL."
 326   (when (and (xwem-cl-p cl)
 327              (memq cl (xwem-win-clients win)))
 328     (setf (xwem-win-clients win)
 329           (delq cl (xwem-win-clients win)))
 330
 331     ;; If CL is current client in WIN, also unset it
 332     (when (eq cl (xwem-win-cl win))
 333       (xwem-win-set-cl win nil))
 334
 335     (run-hook-with-args 'xwem-win-clients-change-hook win)))
 336
 337 ;;;###xwem-autoload
 338 (defun xwem-win-set-cl (win cl)
 339   "Associate WIN with CL as current client in WIN."
 340   ;; When CL isnt in WIN's clients list yet, add it.
 341   (unless (eq (xwem-win-cl win) cl)
 342     (when (xwem-cl-p cl)
 343       (xwem-cl-set-win cl win))
 344
 345     (let ((ocl (xwem-win-cl win)))
 346       (setf (xwem-win-cl win) cl)
 347
 348       (when (xwem-cl-alive-p (xwem-win-cl win))
 349         (xwem-activate (xwem-win-cl win)))
 350       (when (xwem-cl-alive-p ocl)
 351         (xwem-deactivate ocl))
 352
 353       (when (or (null ocl) (null (xwem-win-cl win)))
 354         (xwem-win-redraw-win win)))))
 355
 356 ;;;###autoload
 357 (defun xwem-win-new (&optional params props)
 358   "Create new window with properties PROPS."
 359   (let ((nwin (apply 'make-xwem-win :id (xwem-win-gen-id) params))
 360         (rplist (copy-list xwem-win-default-properties)))
 361
 362     ;; Prepare window properties
 363     (setq rplist (xwem-misc-merge-plists rplist props))
 364
 365     (setf (xwem-win-geom nwin)
 366           (make-X-Geom :x 0 :y 0 :width 1 :height 1
 367                        :border-width xwem-win-default-border-width))
 368     (setf (xwem-win-clients nwin) nil)  ; list of clients
 369     (setf (xwem-win-cl nwin) nil)       ; no visible client yet
 370     (setf (xwem-win-plist nwin) rplist) ; window properties
 371
 372     nwin))
 373
 374 (defun xwem-win-replace (old new)
 375   "Replace OLD window with contents of NEW window."
 376   (when (not (and (xwem-win-p old) (xwem-win-p new)))
 377     (error 'xwem-error "Hmm .. one of OLD or NEW is not a xwem window"))
 378
 379   (when (eq (xwem-frame-rootwin (xwem-win-frame old)) old)
 380     (setf (xwem-frame-rootwin (xwem-win-frame old)) new))
 381
 382   (setf (xwem-win-x new) (xwem-win-x old))
 383   (setf (xwem-win-y new) (xwem-win-y old))
 384   (setf (xwem-win-width new) (xwem-win-width old))
 385   (setf (xwem-win-height new) (xwem-win-height old))
 386
 387   (let ((tem))
 388     (setq tem (xwem-win-next old))
 389     (setf (xwem-win-next new) tem)
 390     (when (xwem-win-p tem)
 391       (setf (xwem-win-prev tem) new))
 392
 393     (setq tem (xwem-win-prev old))
 394     (setf (xwem-win-prev new) tem)
 395     (when (xwem-win-p tem)
 396       (setf (xwem-win-next tem) new))
 397
 398     (setq tem (xwem-win-parent old))
 399     (setf (xwem-win-parent new) tem)
 400     (when (xwem-win-p tem)
 401       (when (eq (xwem-win-vchild tem) old)
 402         (setf (xwem-win-vchild tem) new))
 403       (when (eq (xwem-win-hchild tem) old)
 404         (setf (xwem-win-hchild tem) new))
 405       )))
 406
 407 (defun xwem-win-make-parent (window)
 408   "Make dummy parent for WINDOW."
 409   (let ((pwin (xwem-win-new
 410                (list :frame (xwem-win-frame window)
 411                      :dead t            ; XXX dead mean that window
 412                                         ; can't contain clients
 413                      ))))
 414
 415     (xwem-win-replace window pwin)
 416
 417     (setf (xwem-win-next window) nil)
 418     (setf (xwem-win-prev window) nil)
 419     (setf (xwem-win-hchild window) nil)
 420     (setf (xwem-win-vchild window) nil)
 421     (setf (xwem-win-parent window) pwin)
 422     ))
 423
 424 ;;;###xwem-autoload
 425 (defun xwem-window-next (&optional window)
 426   "Return next window after WINDOW in canonical ordering of windows.
 427 If omitted, WINDOW defaults to the `(xwem-win-selected)'."
 428   (let ((win (or window (xwem-win-selected)))
 429         while-exit tem)
 430
 431     (while (and (not while-exit)
 432                 (null (setq tem (xwem-win-next win))))
 433       (if (xwem-win-p (setq tem (xwem-win-parent win)))
 434           (setq win tem)
 435
 436         ;;else
 437         (setq tem (xwem-frame-rootwin (xwem-win-frame win)))
 438         (setq while-exit t)             ;break from loop
 439         ))
 440
 441     (setq win tem)
 442
 443     ;; now if we have a horizontal or vertical combination - find the
 444     ;; first child
 445     (while (cond ((xwem-win-p (xwem-win-child win))
 446                   (progn (setq win (xwem-win-child win)) t))
 447                  (t nil)))              ;break
 448     win))
 449
 450 ;;;###xwem-autoload
 451 (defun xwem-window-next-vertical (&optional window)
 452   "Return next window which is vertically after WINDOW.
 453 If WINDOW is not given `(xwem-win-selected)' will be used."
 454   (let* ((win (or window (xwem-win-selected)))
 455          (root-win (xwem-frame-rootwin (xwem-win-frame win)))
 456          (rwin nil))
 457
 458     (when (eq root-win win)
 459       (while (cond ((xwem-win-p (xwem-win-hchild win))
 460                     (progn (setq win (xwem-win-hchild win)) t))
 461                    ((xwem-win-p (xwem-win-vchild win))
 462                     (progn (setq win (xwem-win-vchild win)) t))
 463                    (t (progn (setq rwin win) nil)))))
 464     (if rwin
 465         rwin
 466
 467       ;; TODO: check for root window in frame
 468       (while (progn
 469                (if (and (xwem-win-p (xwem-win-parent win))
 470                         (xwem-win-p (xwem-win-vchild (xwem-win-parent win))))
 471                      (if (xwem-win-p (xwem-win-next win))
 472                          (setq rwin (xwem-win-next win))
 473                        (setq win (xwem-win-parent win)))
 474                  (setq win (xwem-win-parent win)))
 475                (and (null rwin) (not (eq win root-win)))))
 476
 477       (if rwin
 478           rwin
 479         (while (progn
 480                  (if (xwem-win-p (xwem-win-hchild win))
 481                      (setq win (xwem-win-hchild win))
 482                    (if (xwem-win-p (xwem-win-vchild win))
 483                        (setq win (xwem-win-vchild win))
 484                      (setq rwin win)))
 485                  (null rwin)))
 486         rwin))))
 487
 488 ;;;###xwem-autoload
 489 (defun xwem-window-prev (&optional window)
 490   "Retrun previous window before WINDOW in canonical ordering of windows.
 491 If ommitted, WINDOW defaults to the `(xwem-win-selected)'."
 492   (let* ((win (or window (xwem-win-selected)))
 493          while-exit tem)
 494
 495     (while (and (not while-exit)
 496                 (null (setq tem (xwem-win-prev win))))
 497
 498       (if (xwem-win-p (setq tem (xwem-win-parent win)))
 499           (setq win tem)
 500
 501         (setq tem (xwem-frame-rootwin (xwem-win-frame win)))
 502         (setq while-exit t)             ;break from loop
 503         ))
 504
 505     (setq win tem)
 506
 507     ;; now if we have a horizontal or vertical combination find
 508     ;; the first child
 509     (while (and
 510             (cond ((xwem-win-p (xwem-win-child win))
 511                    (progn (setq win (xwem-win-child win)) t))
 512                   (t nil))              ;break
 513             (progn
 514               (while (xwem-win-p (xwem-win-next win))
 515                 (setq win (xwem-win-next win)))
 516               t)))
 517     win))
 518
 519 ;;;###xwem-autoload
 520 (defun xwem-window-other (cnt &optional window)
 521   "Return CNT's next window for WINDOW if CNT is greater then zero and
 522   previous if negative."
 523   (let ((ofn (if (>= cnt 0) 'xwem-window-next 'xwem-window-prev))
 524         (cnt (abs cnt))
 525         (win (or window (xwem-win-selected))))
 526     (while (> cnt 0)
 527       (setq win (funcall ofn win))
 528       (setq cnt (1- cnt)))
 529     win))
 530
 531 (defun xwem-win-xy-in-p (x y win &optional inc-gutter)
 532   "Returns non-nil if X Y lies in WIN.
 533 If INC-GUTTER is non-nil, than include gutters width as WIN area."
 534   (let ((edges (xwem-win-pixel-edges win))
 535         (gw (if inc-gutter (xwem-win-delim-width win) 0)))
 536     (and (>= x (- (nth 0 edges) gw))
 537          (<= x (+ (nth 2 edges) gw))
 538          (>= y (- (nth 1 edges) gw))
 539          (<= y (+ (nth 3 edges) gw)))))
 540
 541 (defun xwem-window-at (x y &optional frame)
 542   "Returns window where X and Y lies in it."
 543   (catch 'found
 544     (xwem-win-map #'(lambda (win)
 545                       (when (xwem-win-xy-in-p x y win t)
 546                         (throw 'found win)))
 547                   (xwem-frame-selwin (or frame (xwem-frame-selected))))
 548     ))
 549
 550 ;;; -- Moving around windows --
 551 ;;
 552 (defun xwem-winmove-distance (&optional win)
 553   "Returns distance between windows."
 554   ;; 2 is XXX
 555   (+ (xwem-win-delim-width (or win (xwem-win-selected))) 2))
 556
 557 (defun xwem-winmove-refloc (&optional arg window)
 558   "Calculates the reference location for directional window selection.
 559 Returns cons cell in form (hpos . vpos)."
 560   (let* ((effarg (if (null arg) 0 (prefix-numeric-value arg)))
 561          (edges (xwem-win-pixel-edges window))
 562          (top-left (cons (nth 0 edges) (nth 1 edges)))
 563          (bot-right (cons (1- (nth 2 edges)) (1- (nth 3 edges)))))
 564     (cond ((> effarg 0) top-left)
 565           ((< effarg 0) bot-right)
 566           (t
 567            ;; As if point in center of WINDOW
 568            (cons (+ (nth 0 edges) (/ (- (nth 2 edges) (nth 0 edges)) 2))
 569                  (+ (nth 1 edges) (/ (- (nth 3 edges) (nth 1 edges)) 2)))))
 570     ))
 571
 572 (defun xwem-winmove-other-window (dir &optional arg window)
 573   "Calculates location of window to be moved to.
 574 Returns cons cell (x . y)."
 575   (let ((edges (xwem-win-pixel-edges window))
 576         (refpoint (xwem-winmove-refloc arg window)))
 577     (cond ((eq dir 'left)
 578            (cons (- (nth 0 edges)
 579                     (xwem-winmove-distance))
 580                  (cdr refpoint)))
 581           ((eq dir 'up)
 582            (cons (car refpoint)
 583                  (- (nth 1 edges)
 584                     (xwem-winmove-distance))))
 585           ((eq dir 'right)
 586            (cons (+ (nth 2 edges)
 587                     (xwem-winmove-distance))
 588                  (cdr refpoint)))
 589           ((eq dir 'down)
 590            (cons (car refpoint)
 591                  (+ (nth 3 edges)
 592                     (xwem-winmove-distance))))
 593           (t (error 'xwem-error "`xwem-winmove-other-window': Invalid direction %s" dir)))))
 594
 595 (defun xwem-winmove-select (dir &optional arg window)
 596   "Moves to the window in DIR direction."
 597   (let* ((frame (xwem-win-frame (or window (xwem-win-selected))))
 598          (owin-loc (xwem-winmove-other-window dir arg window))
 599          (x (car owin-loc))
 600          (y (cdr owin-loc))
 601          (owin (xwem-window-at x y frame)))
 602
 603     (when xwem-win-winmove-allow-jumping
 604       (let ((rwin (xwem-frame-rootwin
 605                    (xwem-win-frame (or window (xwem-win-selected))))))
 606         (when (not (xwem-win-xy-in-p x y rwin))
 607           ;; we are outside root window
 608           (setq owin-loc
 609                 (cond ((eq dir 'left)
 610                        (cons (- (nth 2 (xwem-win-pixel-edges rwin))
 611                                 (abs x)) y))
 612                       ((eq dir 'right)
 613                        (cons (- x (nth 2 (xwem-win-pixel-edges rwin)))
 614                              y))
 615                       ((eq dir 'up)
 616                        (cons x (- (nth 3 (xwem-win-pixel-edges rwin))
 617                                   (abs y))))
 618                       ((eq dir 'down)
 619                        (cons x (+ (- y (nth 3 (xwem-win-pixel-edges rwin)))
 620                                   (nth 1 (xwem-win-pixel-edges rwin)))))
 621                       (t (error 'xwem-error "Invalid direction"))))
 622           (setq owin (xwem-window-at (car owin-loc) (cdr owin-loc) frame)))))
 623
 624     (if (not (xwem-win-p owin))
 625         (xwem-message 'error "No window at %S" dir)
 626       (xwem-select-window owin))
 627     ))
 628
 629 ;;;###autoload(autoload 'xwem-other-window "xwem-win" "Switch to other window." t)
 630 (defalias 'xwem-other-window 'xwem-frame-goto-next)
 631
 632 ;;;###autoload(autoload 'xwem-winmove-up "xwem-win" "" t)
 633 (define-xwem-command xwem-winmove-up (arg)
 634   "Selects window that up for selected."
 635   (xwem-interactive "P")
 636   (xwem-winmove-select 'up arg))
 637 (put 'xwem-winmove-up 'xwem-frame-command t)
 638
 639 ;;;###autoload(autoload 'xwem-winmove-down "xwem-win" "" t)
 640 (define-xwem-command xwem-winmove-down (arg)
 641   "Selects window that down for selected."
 642   (xwem-interactive "P")
 643   (xwem-winmove-select 'down arg))
 644 (put 'xwem-winmove-down 'xwem-frame-command t)
 645
 646 ;;;###autoload(autoload 'xwem-winmove-left "xwem-win" "" t)
 647 (define-xwem-command xwem-winmove-left (arg)
 648   "Selects window that left for selected."
 649   (xwem-interactive "P")
 650   (xwem-winmove-select 'left arg))
 651 (put 'xwem-winmove-left 'xwem-frame-command t)
 652
 653 ;;;###autoload(autoload 'xwem-winmove-right "xwem-win" "" t)
 654 (define-xwem-command xwem-winmove-right (arg)
 655   "Selects window that right for selected."
 656   (xwem-interactive "P")
 657   (xwem-winmove-select 'right arg))
 658 (put 'xwem-winmove-right 'xwem-frame-command t)
 659
 660 ;;; Windows oriented drawers
 661 (define-xwem-deffered xwem-win-redraw-delims (win)
 662   "Draw delimetrs in window WIN."
 663   (when (xwem-win-p win)
 664     (let ((wf (xwem-win-frame win))
 665           (hc (xwem-win-hchild win))
 666           (vc (xwem-win-vchild win)))
 667
 668       (while (xwem-win-p hc)
 669         ;; For horizontal split
 670         (when (xwem-win-p (xwem-win-next hc))
 671           (xwem-misc-draw-bar
 672            (xwem-dpy) (xwem-frame-xwin wf)
 673            (xwem-face-get-gc 'xwem-window-delimiter-face
 674              '(horizontal) hc)
 675            (xwem-face-get-gc 'xwem-window-delimiter-face
 676              '(horizontal shadow light) hc)
 677            (xwem-face-get-gc 'xwem-window-delimiter-face
 678              '(horizontal shadow) hc)
 679            (+ (xwem-win-x hc) (xwem-win-width hc))
 680            (xwem-win-y hc)
 681            (xwem-win-delim-width hc)
 682            (xwem-win-height hc)
 683            (xwem-win-delim-shadow-thickness hc)))
 684
 685         (xwem-win-redraw-delims-1 hc)
 686         (setq hc (xwem-win-next hc)))
 687
 688       (while (xwem-win-p vc)
 689         ;; For vertical split
 690         (when (xwem-win-p (xwem-win-next vc))
 691           (xwem-misc-draw-bar
 692            (xwem-dpy) (xwem-frame-xwin wf)
 693            (xwem-face-get-gc 'xwem-window-delimiter-face
 694              '(vertical) vc)
 695            (xwem-face-get-gc 'xwem-window-delimiter-face
 696              '(light shadow vertical) vc)
 697            (xwem-face-get-gc 'xwem-window-delimiter-face
 698              '(shadow vertical) vc)
 699            (xwem-win-x vc)
 700            (+ (xwem-win-y vc) (xwem-win-height vc))
 701            (xwem-win-width vc)
 702            (xwem-win-delim-width vc)
 703            (xwem-win-delim-shadow-thickness vc)))
 704
 705         (xwem-win-redraw-delims-1 vc)
 706         (setq vc (xwem-win-next vc)))
 707       )))
 708
 709 (defun xwem-win-choose-outline-gc (win)
 710   "Choose X-Gc according to WIN's current state."
 711   (xwem-face-get-gc 'xwem-window-outline-face
 712     (list (if (xwem-frame-selected-p (xwem-win-frame win))
 713               'frame-selected
 714             'frame-nonselected)
 715           (if (xwem-win-selwin-p win)
 716               'win-selected
 717             'win-nonselected))
 718     win))
 719
 720 (define-xwem-deffered xwem-win-redraw-win (win)
 721   "Redraw only one WIN in WIN's frame."
 722   (when (and (xwem-win-p win)
 723              (xwem-frame-p (xwem-win-frame win)))
 724     (XClearArea (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win))
 725                 (xwem-win-x win) (xwem-win-y win)
 726                 (xwem-win-width win) (xwem-win-height win) nil)
 727     (if (xwem-win-cl win)
 728         (XFillRectangles
 729          (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win))
 730          (xwem-win-choose-outline-gc win)
 731          (list (make-X-Rect :x (xwem-win-x win)
 732                             :y (xwem-win-y win)
 733                             :width (xwem-win-width win)
 734                             :height (xwem-win-border-width win))
 735                (make-X-Rect :x (xwem-win-x win)
 736                             :y (xwem-win-y win)
 737                             :width (xwem-win-border-width win)
 738                             :height (xwem-win-height win))
 739                (make-X-Rect :x (+ (xwem-win-x win)
 740                                   (xwem-win-width win)
 741                                   (- (xwem-win-border-width win)))
 742                             :y (xwem-win-y win)
 743                             :width (xwem-win-border-width win)
 744                             :height (xwem-win-height win))
 745                (make-X-Rect :x (xwem-win-x win)
 746                             :y (+ (xwem-win-y win)
 747                                   (xwem-win-height win)
 748                                   (- (xwem-win-border-width win)))
 749                             :width (xwem-win-width win)
 750                             :height (xwem-win-border-width win))))
 751
 752       (let ((cgc (xwem-win-choose-outline-gc win)))
 753         (XSetClipRectangles (xwem-dpy) cgc 0 0
 754                             (list (X-Geom-to-X-Rect (xwem-win-geom win))))
 755         (XDrawRectangle (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win))
 756                         cgc
 757                         (xwem-win-x win) (xwem-win-y win)
 758                         (xwem-win-width win) (xwem-win-height win))
 759         (setf (X-Gc-clip-mask cgc) X-None)
 760         (XChangeGC (xwem-dpy) cgc)))))
 761
 762 (define-xwem-deffered xwem-win-redraw-frame (frame)
 763   "Outline windows in FRAME if needed."
 764   (when (and (xwem-frame-alive-p frame)
 765              (eq (xwem-frame-state frame) 'mapped))
 766     (xwem-win-map 'xwem-win-redraw-win (xwem-frame-selwin frame))
 767     (xwem-win-redraw-delims (xwem-frame-rootwin frame))))
 768
 769 ;;;###xwem-autoload
 770 (defun xwem-select-window (window)
 771   "Set WINDOW to be selected window."
 772   (when (xwem-win-alive-p window)
 773     (let* ((wframe (xwem-win-frame window))
 774            (ow (xwem-frame-selwin wframe))
 775            (cl (xwem-win-cl window))
 776            emcl)
 777       (unless (xwem-frame-selected-p wframe)
 778         ;; Select client in case WFRAME is embedded client
 779         (when (xwem-cl-p
 780                (setq emcl (xwem-frame-get-prop wframe 'xwem-embedded-cl)))
 781           (xwem-select-client emcl))
 782
 783         (run-hooks 'xwem-frame-deselect-hook)
 784         (setq xwem-current-frame wframe)
 785         (run-hooks 'xwem-frame-select-hook))
 786
 787       (xwem-frame-raise wframe)
 788       (unless (eq ow window)
 789         (setf (xwem-frame-selwin wframe) window)
 790         (run-hook-with-args 'xwem-win-switch-hook ow window))
 791
 792       (unless (xwem-cl-selected-p cl)
 793         (xwem-select-client cl)))))
 794
 795 ;;;###xwem-autoload
 796 (defun xwem-window-set-pixsize (window nsize nodelete is-height)
 797   "Set pixsize for WINDOW."
 798   (let ((old-pixsize (if is-height
 799                          (xwem-win-height window)
 800                        (xwem-win-width window)))
 801         (min-size (if is-height
 802                       xwem-win-min-height
 803                     xwem-win-min-width))
 804         machild michild pos)
 805
 806     (if (and (null nodelete)
 807              (xwem-win-parent window)   ; not top level window
 808              (< nsize min-size))
 809         (progn
 810           (if is-height
 811               (setf (xwem-win-height window) nsize)
 812             (setf (xwem-win-width window) nsize))
 813           ;; If size will be not enought even after everything is
 814           ;; complete - delete window.
 815           ;; In case when balancing window, some windows resizes to
 816           ;; nsize < min-size temporary, but then resizes again to
 817           ;; better size, so we will not delete them.
 818           (xwem-deffered-funcall
 819            `(lambda (window)
 820               (when (< (if ,is-height
 821                            (xwem-win-height window)
 822                          (xwem-win-width window))
 823                        (if ,is-height
 824                            xwem-win-min-height
 825                          xwem-win-min-width))
 826                 (xwem-window-delete window)))
 827            window))
 828
 829       (if is-height
 830           (progn
 831             (setf (xwem-win-height window) nsize)
 832             (setq machild (xwem-win-vchild window))
 833             (setq michild (xwem-win-hchild window)))
 834         (progn
 835           (setf (xwem-win-width window) nsize)
 836           (setq machild (xwem-win-hchild window))
 837           (setq michild (xwem-win-vchild window))))
 838
 839       ;; Also refit window's client
 840       (when (xwem-cl-p (xwem-win-cl window))
 841         (xwem-deffered-funcall 'xwem-refit (xwem-win-cl window)))
 842
 843       (cond ((xwem-win-p michild)
 844              (mapc (lambda (child)
 845                      (if is-height
 846                          (setf (xwem-win-y child) (xwem-win-y window))
 847                        (setf (xwem-win-x child) (xwem-win-x window)))
 848                      (xwem-window-set-pixsize child nsize nodelete is-height))
 849                    (xwem-win-make-list-by-next michild)))
 850
 851             ((xwem-win-p machild)
 852              ;; TODO: adjust geom for major child
 853              (let* ((last-pos (if is-height
 854                                   (xwem-win-y window)
 855                                 (xwem-win-x window)))
 856                     (first last-pos)
 857                     (last-old-pos 0)
 858                     (delims-size 0)
 859                     (old-pos nil)
 860                     (mchils (xwem-win-make-list-by-next machild)))
 861
 862                ;; Calculate width sum of all delimetrs
 863                (mapc #'(lambda (el)
 864                          (when (xwem-win-p (xwem-win-next el))
 865                            (setq delims-size
 866                                  (+ delims-size (xwem-win-delim-width el)))))
 867                      mchils)
 868
 869                (mapc #'(lambda (child)
 870                          (if is-height
 871                              (progn
 872                                (setq old-pos
 873                                      (+ last-old-pos
 874                                         (xwem-win-height child)))
 875                                (setf (xwem-win-y child) last-pos))
 876                            (progn
 877                              (setq old-pos (+ last-old-pos
 878                                               (xwem-win-width child)))
 879                              (setf (xwem-win-x child) last-pos)))
 880
 881                          (setq pos (/ (+ (* old-pos
 882                                             (if (xwem-win-p (xwem-win-next child))
 883                                                 (- nsize delims-size)
 884                                               nsize)
 885                                             2)
 886                                          (- old-pixsize delims-size))
 887                                       (* 2 (- old-pixsize delims-size))))
 888
 889                          (xwem-window-set-pixsize
 890                           child (- (+ pos first) last-pos) t is-height)
 891
 892                          (setq last-pos
 893                                (+ pos first (xwem-win-delim-width child))
 894                                last-old-pos old-pos))
 895                      mchils))
 896
 897              ;; Now delete any children that became too small.
 898              (when (not nodelete)
 899                (mapc #'(lambda (child)
 900                          (if is-height
 901                              (xwem-window-set-pixsize
 902                               child (xwem-win-height child) nil t)
 903                            (xwem-window-set-pixsize
 904                             child (xwem-win-width child) nil nil)))
 905                      (xwem-win-make-list-by-next machild)))
 906              )
 907
 908             ;; Normal window, just outdraw
 909             (t (xwem-win-redraw-win window)))
 910
 911       ;; Redraw WINDOW's frame
 912       (xwem-win-redraw-delims (xwem-frame-rootwin (xwem-win-frame window)))
 913       )))
 914
 915 ;;;###xwem-autoload
 916 (defun xwem-win-set-width (win new-width)
 917   "Set window's WIN width to NEW-WIDTH."
 918   (xwem-window-set-pixsize win new-width nil nil))
 919
 920 ;;;###xwem-autoload
 921 (defun xwem-win-set-height (win new-height)
 922   "Set window's WIN height to NEW-HEIGHT."
 923   (xwem-window-set-pixsize win new-height nil t))
 924
 925 ;;;###autoload(autoload 'xwem-window-delete "xwem-win" "Delete selected WINDOW." t)
 926 (define-xwem-command xwem-window-delete (win)
 927   "Delete WIN."
 928   (xwem-interactive (list (xwem-win-selected)))
 929
 930   (unless (xwem-win-p win)
 931     (error 'xwem-error "Invalid window" win))
 932
 933   (when (xwem-win-only-one-p win)
 934     (error 'xwem-error "Can't delete window, because it is only one."))
 935
 936   (let ((frame (xwem-win-frame win))
 937         dclients owin par pwin ccl)
 938
 939     (if (null (xwem-win-parent win))
 940         (progn
 941           ;; win is top level window
 942           ;; TODO: should I delete frame?
 943           nil)
 944
 945       ;; Normal window - delete it
 946       (setq par (xwem-win-parent win))
 947       (setq pwin (xwem-frame-selwin frame))
 948       (while (and (xwem-win-p pwin) (not (eq pwin win)))
 949         (setq pwin (xwem-win-parent pwin)))
 950
 951       ;; If we're going to delete selected window then we should
 952       ;; update selected window and demanage client, and maybe
 953       ;; collect its clients to other window.
 954       (setq dclients (xwem-win-clients win))
 955       (setq owin (xwem-window-other 1 win))
 956       (mapc #'(lambda (cl)
 957                 (xwem-cl-change-window cl owin))
 958             dclients)
 959
 960       (when (eq pwin win)
 961         ;; If there no clients in window manage our client
 962         (when (and (not (xwem-cl-p (xwem-win-cl owin)))
 963                    (xwem-cl-p (setq ccl (xwem-win-cl win))))
 964           (xwem-cl-change-window ccl owin)
 965           (xwem-activate ccl))
 966         (xwem-select-window owin))
 967
 968       ;; close that hole in list
 969       ;; XXX: check h v h split then delete right win ...
 970       (when (xwem-win-p (xwem-win-next win))
 971         (setf (xwem-win-prev (xwem-win-next win)) (xwem-win-prev win)))
 972       (when (xwem-win-p (xwem-win-prev win))
 973         (setf (xwem-win-next (xwem-win-prev win)) (xwem-win-next win)))
 974       (when (eq win (xwem-win-hchild par))
 975         (setf (xwem-win-hchild par) (xwem-win-next win)))
 976       (when (eq win (xwem-win-vchild par))
 977         (setf (xwem-win-vchild par) (xwem-win-next win)))
 978
 979       ;; TODO: adjust the geometry
 980       (let ((sib (xwem-win-prev win)))
 981         (when (null sib)
 982           (setq sib (xwem-win-next win))
 983           (setf (xwem-win-x sib) (xwem-win-x win))
 984           (setf (xwem-win-y sib) (xwem-win-y win)))
 985
 986         (when (xwem-win-p (xwem-win-vchild par))
 987           (xwem-window-set-pixsize
 988            sib
 989            (+ (xwem-win-height sib)
 990               (xwem-win-height win)
 991               (car xwem-win-vertical-delim-width))
 992            t t))
 993
 994         (when (xwem-win-p (xwem-win-hchild par))
 995           (xwem-window-set-pixsize
 996            sib
 997            (+ (xwem-win-width sib)
 998               (xwem-win-width win)
 999               (car xwem-win-horizontal-delim-width))
1000            t nil)))
1001
1002       ;; If parent now has only one child put child into parent
1003       ;; place
1004       (when (null (xwem-win-next (xwem-win-child par)))
1005         (xwem-win-replace par (xwem-win-child par))
1006         (xwem-win-mark-deleted par))
1007
1008       ;; Since we deleting combination of windows we should delete
1009       ;; all childs
1010       (when (xwem-win-p (xwem-win-child win))
1011         (xwem-win-delete-subwindows (xwem-win-child win)))
1012
1013       (xwem-win-mark-deleted win)
1014
1015       ;; Redraw WIN's frame
1016       (xwem-win-redraw-frame (xwem-win-frame win))
1017
1018       ;; Now run on-delete hooks
1019       (run-hook-with-args 'xwem-win-delete-hook win))
1020     ))
1021 (put 'xwem-window-delete 'xwem-frame-command t)
1022
1023 ;;;###autoload(autoload 'xwem-window-delete-others "xwem-win" nil t)
1024 (define-xwem-command xwem-window-delete-others (window)
1025   "Delete all xwem windows other then WINDOW."
1026   (xwem-interactive (list (xwem-win-selected)))
1027
1028   (unless (xwem-win-p window)
1029     (error 'xwem-error "Invalid window" window))
1030
1031   (xwem-win-map #'(lambda (ww)
1032                     (unless (eq ww window)
1033                       (xwem-window-delete ww)))
1034                 window))
1035 (put 'xwem-window-delete-others 'xwem-frame-command t)
1036
1037 (defun xwem-win-delete-subwindows (win)
1038   "Delete all childs of WIN."
1039   (when (xwem-win-p (xwem-win-next win))
1040     (xwem-win-delete-subwindows (xwem-win-next win)))
1041   (when (xwem-win-child win)
1042     (xwem-win-delete-subwindows (xwem-win-child win)))
1043
1044   (xwem-win-mark-deleted win))
1045
1046 ;;;###xwem-autoload
1047 (defun xwem-win-map (fn &optional window)
1048   "Apply FN to FRAME-WIN and each subwindow.
1049 FN will be called with a window as argument.
1050 If ommitted, WINDOW defaults to the `(xwem-win-selected)'."
1051   (let* ((start-win (or window (xwem-win-selected)))
1052          cur-win res)
1053
1054     (when start-win
1055       (setq res (cons (funcall fn start-win) res))
1056       (setq cur-win (xwem-window-next start-win)))
1057
1058     (while (not (eq cur-win start-win))
1059       (setq res (cons (funcall fn cur-win) res))
1060       (setq cur-win (xwem-window-next cur-win)))
1061     res))
1062
1063 (defun xwem-win-count (&optional window)
1064   "Count windows."
1065   (let ((cnt 0))
1066     (xwem-win-map #'(lambda (win) (setq cnt (+ cnt 1))) window)
1067     cnt))
1068
1069 ;;;###autoload(autoload 'xwem-balance-windows "xwem-win" "" t)
1070 (define-xwem-command xwem-balance-windows (&optional win)
1071   "Make all WIN's parent children windows to be same height or width.
1072 If WIN is ommited, selected window is used."
1073   (xwem-interactive (list (xwem-win-selected)))
1074   (unless (xwem-win-p win)
1075     (error 'xwem-error "invalid window" win))
1076
1077   (when (xwem-win-p (setq win (xwem-win-parent win)))
1078     (let* ((height-p (xwem-win-p (xwem-win-vchild win)))
1079            (getsizefn (if height-p
1080                           'xwem-win-pixel-height
1081                         'xwem-win-pixel-width))
1082            (wins (xwem-win-make-list-by-next (xwem-win-child win)))
1083            size)
1084
1085       (when wins
1086         (setq size (/ (funcall getsizefn win) (length wins)))
1087         (mapc #'(lambda (w)
1088                   (xwem-window-enlarge
1089                    (- size (funcall getsizefn w) (xwem-win-delim-width w))
1090                    height-p w))
1091               wins)
1092         (mapc #'(lambda (w)
1093                   (xwem-window-enlarge
1094                    (- size (funcall getsizefn w) (xwem-win-delim-width w))
1095                    height-p w))
1096               wins)
1097         ))))
1098 (put 'xwem-balance-windows 'xwem-frame-command t)
1099
1100 ;;;###(autoload 'xwem-transpose-windows "xwem-win" nil t)
1101 (define-xwem-command xwem-transpose-windows (arg)
1102   "Transpose selected window with other window.
1103 Prefix ARG directly passed to `xwem-window-other' to findout other
1104 window."
1105   (xwem-interactive "p")
1106
1107   (let ((cw (xwem-win-selected))
1108         (ow (xwem-window-other arg)))
1109     (when (or (eq cw ow)
1110             (not (xwem-win-p cw))
1111             (not (xwem-win-p ow)))
1112       (error 'xwem-error "Can't transpose windows"))
1113
1114     (let ((cwcl (xwem-win-cl cw))
1115           (cwcls (xwem-win-clients cw))
1116           (owcl (xwem-win-cl ow))
1117           (owcls (xwem-win-clients ow)))
1118
1119       (xwem-win-set-cl cw owcl)
1120       (mapc #'(lambda (cl) (xwem-cl-set-win cl cw)) (nreverse owcls))
1121
1122       (xwem-win-set-cl ow cwcl)
1123       (mapc #'(lambda (cl) (xwem-cl-set-win cl ow)) (nreverse cwcls))
1124
1125       (xwem-select-window cw))))
1126 (put 'xwem-transpose-windows 'xwem-frame-command t)
1127
1128 ;;;###xwem-autoload
1129 (defun xwem-win-only-one-p (&optional window)
1130   "Return non-nil if WINDOW is only one in chain.
1131 If WINDOW ommitted `(xwem-win-selected)' used."
1132   (= 1 (xwem-win-count (or window (xwem-win-selected)))))
1133
1134 (defun xwem-window-list (&optional frame)
1135   "Return list of windows for FRAME.
1136 Default FRAME is selected frame."
1137   (let* ((wlf (or frame (xwem-frame-selected)))
1138          (win (xwem-frame-rootwin wlf))
1139          (rlist nil))
1140     (xwem-win-map #'(lambda (win)
1141                       (setq rlist (cons win rlist)))
1142                   win)
1143     rlist))
1144
1145 (defun xwem-win-pixel-edges (&optional window)
1146   "Return a list of the pixel edge coordinates of WINDOW.
1147 \\(LEFT TOP RIGHT BOTTOM\\), all relative to 0, 0 at top left corner of
1148 frame.  The frame title are considered to be outside of this area."
1149   (unless window
1150     (setq window (xwem-win-selected)))
1151   (list (xwem-win-x window)
1152         (xwem-win-y window)
1153         (+ (xwem-win-x window) (xwem-win-width window))
1154         (+ (xwem-win-y window) (xwem-win-height window))))
1155
1156 (defun xwem-win-pixel-width (&optional window)
1157   "Retrun width in pixels of WINDOW."
1158   (xwem-win-width (or window (xwem-win-selected))))
1159
1160 (defun xwem-win-pixel-height (&optional window)
1161   "Return height in pixels of WINDOW."
1162   (xwem-win-height (or window (xwem-win-selected))))
1163
1164 (defun xwem-win-pixels-steps (&optional window)
1165   "Convert size in pixels to size in steps for WINDOW."
1166   (error 'xwem-error "`xwem-win-pixels-steps' not yet implemented."))
1167
1168 (defun xwem-win-steps-pixels (&optional window)
1169   "Convert size in steps to size in pixels for WINDOW."
1170   (error 'xwem-error "`xwem-win-steps-pixels' not yet implemented."))
1171
1172 ;;; START: Window configurations section
1173
1174 ;;;###xwem-autoload
1175 (defun xwem-window-configuration (&optional frame)
1176   "Return an object representing the current window configuration of xwem FRAME.
1177 If FRAME is nil or ommited, use the sected frame."
1178   (let ((frm (or frame (xwem-frame-selected))))
1179     (when (xwem-frame-p frm)
1180       (make-xwem-win-config
1181        :frame frm
1182        :frame-xgeom (copy-X-Geom (xwem-frame-xgeom frm))
1183        :frame-properties (xwem-frame-properties frm)
1184        :current-cl (xwem-win-cl (xwem-frame-selwin frm))
1185        :min-width xwem-win-min-width :min-height xwem-win-min-height
1186        :saved-root-window (xwem-win-root->saved-win (xwem-frame-rootwin frm))))))
1187
1188 (defun xwem-win-root->saved-win (win)
1189   "Convert an xwem root WIN into a tree of saved-window structures."
1190   (let ((saved-win
1191          (make-xwem-win-saved
1192           :id (xwem-win-id win)
1193           :geom (copy-X-Geom (xwem-win-geom win))
1194           :clients (copy-list (xwem-win-clients win))
1195           :cl (xwem-win-cl win)
1196           :plist (xwem-win-properties win)
1197           :selwin-p (xwem-win-selwin-p win)
1198           :first-hchild (and (xwem-win-p (xwem-win-hchild win))
1199                              (xwem-win-root->saved-win (xwem-win-hchild win)))
1200           :first-vchild (and (xwem-win-p (xwem-win-vchild win))
1201                              (xwem-win-root->saved-win (xwem-win-vchild win)))
1202
1203           :next (and (xwem-win-p (xwem-win-next win))
1204                      (xwem-win-root->saved-win (xwem-win-next win)))
1205           )))
1206     saved-win))
1207
1208 (defun xwem-win-config-equal (win-cfg0 win-cfg1)
1209   "Return non-nil if two window configurations WIN-CFG0 and WIN-CFG1 are equal."
1210   (equal win-cfg0 win-cfg1))
1211
1212 ;;;###xwem-autoload
1213 (defun xwem-set-window-configuration (config &optional select-frame-p)
1214   "Set window to CONFIG.
1215 If optional argument SELECT-FRAME-P is non-nil also select frame for
1216 which window CONFIG was generated."
1217   (let ((frame (xwem-win-config-frame config)))
1218     (when (and (xwem-frame-alive-p frame)
1219                (not (xwem-win-config-equal
1220                      config (xwem-window-configuration frame))))
1221
1222       (xwem-frame-reduce-to-one-window frame)
1223       (xwem-frame-set-win-config-frame-params config)
1224
1225       (xwem-win-restore-saved-win
1226        config (xwem-frame-rootwin frame)
1227        (xwem-win-config-saved-root-window config) 'vertical)
1228
1229       ;; XXX what is this?
1230       (setq xwem-win-min-width (xwem-win-config-min-width config))
1231       (setq xwem-win-min-height (xwem-win-config-min-height config)))
1232
1233     ;; Time to select frame
1234     (when (and select-frame-p (xwem-frame-alive-p frame))
1235       (xwem-select-frame frame))))
1236
1237 (defun xwem-frame-reduce-to-one-window (frame)
1238   "Delete all windows except the one."
1239   (let ((swin (xwem-frame-selwin frame)))
1240     (xwem-win-map #'(lambda (ww)
1241                       (when (not (eq ww swin))
1242                         (xwem-window-delete ww)))
1243                   swin)))
1244
1245 (defun xwem-frame-set-win-config-frame-params (config)
1246   "Restore FRAME size of a window configuration CONFIG."
1247   (setf (xwem-frame-xgeom (xwem-win-config-frame config))
1248         (copy-X-Geom (xwem-win-config-frame-xgeom config)))
1249   (xwem-frame-apply-xgeom-1 (xwem-win-config-frame config))
1250   (xwem-frame-set-properties (xwem-win-config-frame config)
1251                              (xwem-win-config-frame-properties config)))
1252
1253 (defun xwem-win-restore-saved-win (config win saved-win direction)
1254   "Within CONFIG, restore WIN to the state of SAVED-WIN."
1255   (if (xwem-win-saved-next saved-win)
1256       (progn
1257         (xwem-win-split win direction)
1258         (xwem-win-restore-win-params config win saved-win)
1259         (xwem-win-restore-saved-win config (xwem-win-next win)
1260            (xwem-win-saved-next saved-win) direction))
1261
1262     ;; [else] No next saved
1263     (xwem-win-restore-win-params config win saved-win))
1264
1265   (when (xwem-win-saved-first-hchild saved-win)
1266     (xwem-win-restore-saved-win config win
1267                                 (xwem-win-saved-first-hchild saved-win)
1268                                 'horizontal))
1269   (when (xwem-win-saved-first-vchild saved-win)
1270     (xwem-win-restore-saved-win config win
1271                                 (xwem-win-saved-first-vchild saved-win)
1272                                 'vertical)))
1273
1274 (defun xwem-win-subr-first-member (l1 l2)
1275   "Return first element in L1, which also in L2.
1276 Comparison done using `eq'."
1277   (while (and l1 (not (memq (car l1) l2)))
1278     (setq l1 (cdr l1)))
1279   l1)
1280
1281 (defun xwem-reorder-clients (clients clients-list)
1282   "Reorder CLIENTS to be in same order as in CLIENTS-LIST.
1283 This is destructive function, it will modify CLIENTS list directly."
1284   (let ((cls clients)
1285         (scls clients-list)
1286         t1 t2)
1287     (while scls
1288       (when (setq t1 (memq (car scls) cls))
1289         (setq t2 (xwem-win-subr-first-member cls scls))
1290         (xwem-list-exchange-els clients (car t1) (car t2))
1291         (setq scls t1)
1292         (setq cls t2))
1293
1294       (setq scls (cdr scls))
1295       (setq cls (cdr cls)))))
1296
1297 (defun xwem-win-reorder-clients (saved-win)
1298   "Reorder `xwem-clients' in SAVED-WIN clients order."
1299   (let ((cls xwem-clients)
1300         (scls (xwem-win-saved-clients saved-win))
1301         t1 t2)
1302     (while scls
1303       (when (setq t1 (memq (car scls) cls))
1304         (setq t2 (xwem-win-subr-first-member cls scls))
1305         (xwem-list-exchange-els xwem-clients (car t1) (car t2))
1306         (setq scls t1)
1307         (setq cls t2))
1308
1309       (setq scls (cdr scls))
1310       (setq cls (cdr cls)))))
1311
1312 (defun xwem-win-restore-win-params (config win saved-win)
1313   "Restore the windown parameters stored in SAVED-WIN on WIN."
1314   (let ((cln (xwem-win-saved-cl saved-win)))
1315     ;; Restore ID and PLIST
1316     (setf (xwem-win-id win) (xwem-win-saved-id saved-win)
1317           (xwem-win-plist win) (copy-list (xwem-win-saved-plist saved-win)))
1318
1319     ;; Resort clients in WIN's order
1320     (xwem-win-reorder-clients saved-win)
1321
1322     ;; Collect clients to WIN
1323     (mapc #'(lambda (cl)
1324               (when (xwem-cl-alive-p cl)
1325                 (xwem-cl-set-win cl win)))
1326           (xwem-win-saved-clients saved-win))
1327
1328     ;; Restore window geometry
1329     (when (and (not (xwem-win-saved-first-hchild saved-win))
1330                (not (xwem-win-saved-first-vchild saved-win)))
1331       (when (not (eq win (xwem-frame-rootwin (xwem-win-frame win))))
1332         (xwem-window-enlarge (- (X-Geom-width (xwem-win-saved-geom saved-win))
1333                                 (xwem-win-width win)) nil win)
1334         (xwem-window-enlarge (- (X-Geom-height (xwem-win-saved-geom saved-win))
1335                                 (xwem-win-height win)) t win)))
1336
1337     ;; Remanage current WIN's client
1338     (when (xwem-cl-alive-p cln)
1339       ;; Check manage
1340       (xwem-cl-change-window cln win)
1341       (xwem-activate cln))
1342
1343     (when (xwem-win-saved-selwin-p saved-win)
1344       (setf (xwem-frame-selwin (xwem-win-frame win)) win))))
1345
1346 ;;; END:
1347
1348 ;;;###autoload(autoload 'xwem-window-split-horizontally "xwem-win" nil t)
1349 (define-xwem-command xwem-window-split-horizontally (arg &optional window)
1350   "Split WINDOW horizontally."
1351   (xwem-interactive (list (prefix-numeric-value xwem-prefix-arg)
1352                           (xwem-win-selected)))
1353
1354   (unless window
1355     (setq window (xwem-win-selected)))
1356   (unless (xwem-win-p window)
1357     (error 'xwem-error "Invalid window" window))
1358
1359   (when (xwem-frame-dedicated-p (xwem-win-frame window))
1360     (error 'xwem-error "Can't split dedicated frame"))
1361
1362   (xwem-win-split window 'horizontal arg))
1363 (put 'xwem-window-split-horizontally 'xwem-frame-command t)
1364
1365 ;;;###autoload(autoload 'xwem-window-split-vertically "xwem-win" nil t)
1366 (define-xwem-command xwem-window-split-vertically (arg &optional window)
1367   "Split WINDOW horizontally."
1368   (xwem-interactive (list (prefix-numeric-value xwem-prefix-arg)
1369                           (xwem-win-selected)))
1370   (unless window
1371     (setq window (xwem-win-selected)))
1372   (unless (xwem-win-p window)
1373     (error 'xwem-error "Invalid window" window))
1374
1375   (when (xwem-frame-dedicated-p (xwem-win-frame window))
1376     (error 'xwem-error "Can't split dedicated frame."))
1377
1378   (xwem-win-split window 'vertical arg))
1379 (put 'xwem-window-split-vertically 'xwem-frame-command t)
1380
1381 ;;;###autoload(autoload 'xwem-window-enlarge-horizontally "xwem-win" nil t)
1382 (define-xwem-command xwem-window-enlarge-horizontally (n window)
1383   "Enlarge horizontally WINDOW by N pixels."
1384   (xwem-interactive (list (prefix-numeric-value xwem-prefix-arg)
1385                           (xwem-win-selected)))
1386   (unless (xwem-win-p window)
1387     (error 'xwem-error "Invalid window" window))
1388
1389   (xwem-window-enlarge n nil window))
1390 (put 'xwem-window-enlarge-horizontally 'xwem-frame-command t)
1391
1392 ;;;###autoload(autoload 'xwem-window-enlarge-vertically "xwem-win" nil t)
1393 (define-xwem-command xwem-window-enlarge-vertically (n window)
1394   "Enlarge vertically WINDOW by N pixels."
1395   (xwem-interactive (list (prefix-numeric-value xwem-prefix-arg)
1396                           (xwem-win-selected)))
1397   (unless (xwem-win-p window)
1398     (error 'xwem-error "Invalid window" window))
1399
1400   (xwem-window-enlarge n t window))
1401 (put 'xwem-window-enlarge-vertically 'xwem-frame-command t)
1402
1403 (defun xwem-win-split (&optional window how new-size)
1404   "Split WINDOW.
1405 When WINDOW is ommitted `(xwem-win-selected)' used.
1406 HOW is 'vertical of 'horizontal, default is 'horizontal.
1407 If NEW-SIZE is given make WINDOW NEW-SIZE pixels bigger after split."
1408   (let* ((sp-win (or window (xwem-win-selected)))
1409          (sp-how (or how 'horizontal))
1410          (hor (equal sp-how 'horizontal))
1411          (nwin (xwem-win-new (list :frame (xwem-win-frame sp-win))))
1412          (nsiz (or new-size 0))
1413          psize psize1 psize2 remd)
1414
1415     (if hor
1416         (progn
1417           (setq psize (/ (- (xwem-win-width sp-win)
1418                             (car xwem-win-horizontal-delim-width)) 2))
1419           (setq remd (% (- (xwem-win-width sp-win)
1420                            (car xwem-win-horizontal-delim-width)) 2)))
1421       (progn
1422           (setq psize (/ (- (xwem-win-height sp-win)
1423                             (car xwem-win-vertical-delim-width)) 2))
1424           (setq remd (% (- (xwem-win-height sp-win)
1425                            (car xwem-win-vertical-delim-width)) 2))))
1426
1427     (setq psize1 (+ psize nsiz))
1428     (setq psize2 (+ psize remd (- nsiz)))
1429     ;; Check that minimal widht or height is not exceeded
1430     (xwem-debug 'xwem-misc "Doing split hor=%s psize=%d" 'hor 'psize)
1431     (if hor
1432         ;; horizontal split
1433         (if (or (< psize1 xwem-win-min-width)
1434                 (< psize2 xwem-win-min-width))
1435             (error 'xwem-error "Can't do split.")
1436
1437           ;; TODO:
1438           (when (or (null (xwem-win-parent sp-win))
1439                     (null (xwem-win-hchild (xwem-win-parent sp-win))))
1440             (xwem-win-make-parent sp-win)
1441             (setf (xwem-win-hchild (xwem-win-parent sp-win)) sp-win)))
1442
1443       ;; vertical split
1444       (if (or (< psize1 xwem-win-min-height)
1445               (< psize2 xwem-win-min-height))
1446           (error 'xwem-error "Can't do split.")
1447         ;; TODO
1448         (when (or (null (xwem-win-parent sp-win))
1449                   (null (xwem-win-vchild (xwem-win-parent sp-win))))
1450           (xwem-win-make-parent sp-win)
1451           (setf (xwem-win-vchild (xwem-win-parent sp-win)) sp-win))))
1452
1453     (setf (xwem-win-frame nwin) (xwem-win-frame sp-win))
1454     (setf (xwem-win-next nwin) (xwem-win-next sp-win))
1455     (when (xwem-win-p (xwem-win-next nwin))
1456       (setf (xwem-win-prev (xwem-win-next nwin)) nwin))
1457     (setf (xwem-win-prev nwin) sp-win)
1458     (setf (xwem-win-next sp-win) nwin)
1459     (setf (xwem-win-parent nwin) (xwem-win-parent sp-win))
1460
1461     ;; TODO: adjust geometry
1462     (if hor
1463         (progn
1464           (setf (xwem-win-width sp-win) psize1)
1465           (setf (xwem-win-x nwin)
1466                 (+ (xwem-win-delim-width sp-win)
1467                    (xwem-win-x sp-win)
1468                    (xwem-win-width sp-win)))
1469           (setf (xwem-win-y nwin) (xwem-win-y sp-win))
1470           (setf (xwem-win-width  nwin) psize2)
1471           (setf (xwem-win-height nwin) (xwem-win-height sp-win)))
1472       (progn
1473         (setf (xwem-win-height sp-win) psize1)
1474         (setf (xwem-win-x nwin) (xwem-win-x sp-win))
1475         (setf (xwem-win-y nwin)
1476               (+ (xwem-win-delim-width sp-win)
1477                  (xwem-win-y sp-win)
1478                  (xwem-win-height sp-win)))
1479         (setf (xwem-win-width nwin) (xwem-win-width sp-win))
1480         (setf (xwem-win-height nwin) psize2)))
1481
1482     ;; Client refitting if needed
1483     (when (xwem-cl-p (xwem-win-cl sp-win))
1484       (xwem-deffered-funcall 'xwem-refit (xwem-win-cl sp-win)))
1485
1486     ;; NOTE: nwin is (xwem-win-next sp-win)
1487     (run-hook-with-args 'xwem-win-split-hook sp-win nwin)
1488
1489     ;; Redraw window delimiters and outline
1490     (xwem-win-redraw-delims (xwem-win-parent nwin))
1491     (xwem-win-redraw-win nwin)
1492     (xwem-win-redraw-win sp-win)
1493     ))
1494
1495 (defvar xwem-allow-resize-frame-when-resizing-root-window t
1496   "Non-nil mean win's frame can be resized if resizing frame's root window.")
1497
1498 (defun xwem-window-change-size (win delta height-p)
1499   "Change WIN size to old-size plus DELTA."
1500   (let ((getsizefn (if height-p 'xwem-win-pixel-height 'xwem-win-pixel-width))
1501         (setsizefn (if height-p 'xwem-win-set-height 'xwem-win-set-width))
1502         (par nil)
1503         wsize minsize maxdelta)
1504
1505     (if (eq win (xwem-frame-rootwin (xwem-win-frame win)))
1506         ;; Resize frame
1507         (if xwem-allow-resize-frame-when-resizing-root-window
1508             (xwem-frame-set-size (xwem-win-frame win)
1509                                  (+ (X-Geom-width
1510                                      (xwem-frame-xgeom (xwem-win-frame win)))
1511                                     (if height-p 0 delta))
1512                                  (+ (X-Geom-height
1513                                      (xwem-frame-xgeom (xwem-win-frame win)))
1514                                     (if height-p delta 0)))
1515           (error 'xwem-error "Can't change size of frame's root window"))
1516
1517       (setq par (xwem-win-parent win))
1518       (while (and par (not (if height-p
1519                                (xwem-win-vchild par)
1520                              (xwem-win-hchild par))))
1521         (setq win par)
1522         (setq par (xwem-win-parent win)))
1523
1524       (setq wsize (funcall getsizefn win))
1525       (setq minsize (if height-p xwem-win-min-height xwem-win-min-width))
1526       (when (< (+ wsize delta) minsize)
1527         (error 'xwem-error
1528                "Minimum size exceeded while in `xwem-window-change-size'"))
1529
1530       (setq maxdelta (if par (- (funcall getsizefn par) wsize)
1531                        (if (xwem-win-next win)
1532                            (- (funcall getsizefn (xwem-win-next win))
1533                               minsize)
1534                          (if (xwem-win-prev win)
1535                              (- (funcall getsizefn (xwem-win-prev win))
1536                                 minsize)
1537                            (setq delta 0)))))
1538       (when (> delta maxdelta)
1539         (setq delta maxdelta))
1540
1541       (unless (= delta 0)
1542         (if (and (xwem-win-p (xwem-win-next win))
1543                  (>= (- (funcall getsizefn (xwem-win-next win)) delta) minsize))
1544             (progn
1545               (xwem-debug
1546                'xwem-misc "HERE IN xwem-window-change-size: delta=%d" 'delta)
1547               (if height-p
1548                   (setf (xwem-win-y (xwem-win-next win))
1549                         (+ (xwem-win-y (xwem-win-next win)) delta))
1550                 (setf (xwem-win-x (xwem-win-next win))
1551                       (+ (xwem-win-x (xwem-win-next win)) delta)))
1552               (funcall setsizefn (xwem-win-next win)
1553                        (- (funcall getsizefn (xwem-win-next win)) delta))
1554               (funcall setsizefn win (+ (funcall getsizefn win) delta)))
1555
1556           (if (and (xwem-win-p (xwem-win-prev win))
1557                    (>= (- (funcall getsizefn (xwem-win-prev win)) delta)
1558                        minsize))
1559               (progn
1560                 (funcall setsizefn (xwem-win-prev win)
1561                          (- (funcall getsizefn (xwem-win-prev win)) delta))
1562                 (if height-p
1563                     (setf (xwem-win-y win) (- (xwem-win-y win) delta))
1564                   (setf (xwem-win-x win) (- (xwem-win-x win) delta)))
1565                 (funcall setsizefn win (+ (funcall getsizefn win) delta)))
1566
1567             ;; If we are here than changing window size possible
1568             ;; causes changing parent size.
1569             (let ((opht (funcall getsizefn par))
1570                   delta1)
1571               (if (<= opht (+ delta wsize))
1572                   (setq delta1 (* opht opht 2))
1573
1574                 (setq delta1 (/ (* delta opht 100)
1575                                 (* (- opht wsize delta) 100))))
1576
1577               (if height-p
1578                   (setf (xwem-win-height par) (+ opht delta1))
1579                 (setf (xwem-win-width par) (+ opht delta1)))
1580
1581               (funcall setsizefn win (+ wsize delta1))
1582               (funcall setsizefn par opht)
1583               ))))
1584       )))
1585
1586 (defun xwem-window-enlarge (n &optional height-p window)
1587   "Make WINDOW N pixels bigger.
1588 If HEIGHT-P is non-nil then enlarge vertically.
1589 If WINDOW is ommited then selected window will be used."
1590   (xwem-window-change-size (or window (xwem-win-selected)) n height-p))
1591
1592 (defun xwem-window-shrink (n &optional height-p window)
1593   "Make WINDON N pixels smaller.
1594 If HEIGHT-P is non-nil then shrink vertically.
1595 If WINDOW is ommited then selected window will be used."
1596   (xwem-window-change-size (or  window (xwem-win-selected)) (- n) height-p))
1597
1598 ;;;###xwem-autoload
1599 (defun xwem-window-set-size (win new-width new-height)
1600   "Set WIN's size to be NEW-WIDTH, NEW-HEIGHT."
1601   (xwem-window-change-size win (- new-width (xwem-win-width win)) nil)
1602   (xwem-window-change-size win (- new-height (xwem-win-height win)) t))
1603
1604 (defsubst xwem-win-redraw-selected-frame ()
1605   "Redraw selected frame."
1606   (xwem-win-redraw-frame (xwem-frame-selected)))
1607
1608 (defun xwem-win-init ()
1609   "Initialize xwem windows."
1610   (add-hook 'xwem-win-switch-hook
1611             #'(lambda (owin nwin)
1612                 (when (xwem-win-p owin)
1613                   (xwem-win-redraw-win owin))
1614                 (when (xwem-win-p nwin)
1615                   (xwem-win-redraw-win nwin))))
1616
1617   (add-hook 'xwem-frame-select-hook 'xwem-win-redraw-selected-frame)
1618   (add-hook 'xwem-frame-deselect-hook 'xwem-win-redraw-selected-frame)
1619   (add-hook 'xwem-frame-redraw-hook 'xwem-win-redraw-frame)
1620   )
1621
1622 ;;; Win properties
1623 (defvar xwem-win-supported-properties '(domain-faces)
1624   "List of supported window properties.")
1625
1626 (defun xwem-win-properties (win)
1627   "Return list of win's properties."
1628   (let ((wplist (xwem-win-plist win))
1629         (rplist nil))
1630     (while wplist
1631       (when (memq (car wplist) xwem-win-supported-properties)
1632         (setq rplist (plist-put rplist (car wplist) (cadr wplist))))
1633       (setq wplist (cddr wplist)))
1634     rplist))
1635
1636 \f
1637 (provide 'xwem-win)
1638
1639 ;;;; On-load actions:
1640 ;; - Initialize windows
1641 (xwem-win-init)
1642
1643 ;;; xwem-win.el ends here