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

   1 ;;; xwem-frame.el -- Frames ops for XWEM.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: 21 Mar 2003
   8 ;; Keywords: xlib, xwem
   9 ;; X-CVS: $Id: xwem-frame.el,v 1.15 2005-04-04 19:54:11 lg Exp $
  10
  11 ;; This file is part of XWEM.
  12
  13 ;; XWEM is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26 ;; 02111-1307, USA.
  27
  28 ;;; Synched up with: Not in FSF
  29
  30 ;;; Commentary
  31
  32 ;; This file contain operations on XWEM frames.
  33 ;;
  34
  35 ;;; Code
  36 \f
  37 (require 'xlib-xlib)
  38 (require 'xlib-xinerama)
  39
  40 (require 'xwem-load)
  41 (require 'xwem-misc)
  42
  43 ;;; Variables
  44 (defgroup xwem-frame nil
  45   "Group to customize xwem frames."
  46   :prefix "xwem-frame-"
  47   :prefix "xwem-face-"
  48   :group 'xwem)
  49
  50 (defcustom xwem-frame-background "gray60"
  51   "*Frame background color."
  52   :type 'color
  53   :group 'xwem-frame)
  54
  55 (defcustom xwem-frame-cursor-shape '(X-XC-top_left_arrow)
  56   "*Cursors shape which will be used when pointer is over xwem frame."
  57   :type (xwem-cursor-shape-choice)
  58   :set (xwem-cus-set-cursor-shape xwem-frame-cursor
  59          (mapcar 'xwem-frame-xwin (xwem-frames-list)))
  60   :initialize 'custom-initialize-default
  61   :group 'xwem-frame)
  62
  63 (defcustom xwem-frame-cursor-foreground-color "#111111"
  64   "*Cursor's foreground color used when pointer is on xwem's frame."
  65   :type 'color
  66   :set (xwem-cus-set-cursor-foreground xwem-frame-cursor)
  67   :initialize 'custom-initialize-default
  68   :group 'xwem-frame)
  69
  70 (defcustom xwem-frame-cursor-background-color "#EEEEEE"
  71   "*Cursor's background color used when pointer is on xwem's frame."
  72   :type 'color
  73   :set (xwem-cus-set-cursor-background xwem-frame-cursor)
  74   :initialize 'custom-initialize-default
  75   :group 'xwem-frame)
  76
  77 (defconst xwem-frame-builtin-properties
  78   '(inner-border-width outer-border-width title-height title-thickness)
  79   "List of valid builtin frame properties.")
  80
  81 ;;;###autoload
  82 (defcustom xwem-frame-default-properties
  83   (list 'inner-border-width 3           ; Internal border of xwem's frame
  84         'inner-border-thickness 1       ; Internal border thickness
  85         'outer-border-width 0           ; X border
  86         'background "gray60"            ; background color
  87         'title-height 18)
  88   "*Default properties list for xwem frames."
  89   :type '(restricted-sexp :match-alternatives (valid-plist-p))
  90   :group 'xwem-frame)
  91
  92 ;;;###autoload
  93 (defcustom xwem-embedded-frame-default-properties
  94   (list 'inner-border-width 0
  95         'inner-border-thickness 0
  96         'outer-border-width 0)
  97   "*Default properties for embedded xwem frames.
  98 Values in `xwem-embedded-frame-default-properties' overrides values in
  99 `xwem-frame-default-properties'."
 100   :type '(restricted-sexp :match-alternatives (valid-plist-p))
 101   :group 'xwem-frame)
 102
 103 ;;;###autoload
 104 (defcustom xwem-dedicated-frame-defalut-properties
 105   (list 'inner-border-width 2
 106         'inner-border-thickness 1
 107         'outer-border-width 0)
 108   "*Default properties for dedicated xwem frames.
 109 Values in `xwem-dedicated-frame-defalut-properties' overrides values in
 110 `xwem-frame-default-properties'."
 111   :type '(restricted-sexp :match-alternatives (valid-plist-p))
 112   :group 'xwem-frame)
 113
 114 (defcustom xwem-frame-on-delim-resize-mode 'normal
 115   "*Mode to outline current window when doing `xwem-frame-on-delim-resize'."
 116   :type '(choice (const :tag "Normal border" normal)
 117                  (const :tag "Opaque" opaque)
 118                  )
 119   :group 'xwem-frame)
 120
 121 (defcustom xwem-frame-iresize-mode 'normal
 122   "*Default type of drawing outlines when resizing frame interactively.
 123 Opaque mode can do unexpected things, such as eat your food from
 124 refrigerator, so set it to Opaque on your own risk."
 125   :type '(choice (const :tag "Normal border" normal)
 126                  (const :tag "Contiguous borders" contiguous)
 127                  (const :tag "Outline Corners" corners)
 128                  (const :tag "Grid" grid)
 129                  (const :tag "Opaque" opaque)
 130                  )
 131   :group 'xwem-frame)
 132
 133 (defcustom xwem-frame-imove-mode 'normal
 134   "*Default type of drawing outlines when moving frame interactively."
 135   :type '(choice (const :tag "Normal border" normal)
 136                  (const :tag "Contiguous border" contiguous)
 137                  (const :tag "Outline Corners" corners)
 138                  (const :tag "Grid" grid)
 139                  (const :tag "Opaque" opaque)
 140                  )
 141   :group 'xwem-frame)
 142
 143 (defcustom xwem-frame-imoveresize-mode-function
 144   'xwem-frame-imoveresize-mode-function-default
 145   "Function to call in way to select move or resize mode.
 146 It is passed with two arguments - FRAME and WHAT.
 147 Where FRAME is frame which is about to move/resize and WHAT is one of
 148 'resize or 'move.
 149 It should return one of:
 150  'normal     - Normal resize/move mode, just outline frame rectangle.
 151  'contiguous - Butified 'normal mode.
 152  'corners    - Outline frame corners.
 153  'grid       - Outline frame and draw grid inside.
 154  'opaque     - Opaque move/resize mode."
 155   :type 'function
 156   :group 'xwem-frame)
 157
 158 (defcustom xwem-frame-imoveresize-use-minibuffer t
 159   "*If non-nil, frame's geometry will be show while imove/iresize."
 160   :type 'boolean
 161   :group 'xwem-frame)
 162
 163 (defun xwem-frame-imoveresize-mode-function-default (frame what)
 164   "Default value of `xwem-frame-imoveresize-mode-function'.
 165 Return `xwem-frame-iresize-mode' if WHAT is 'resize.
 166 Return `xwem-frame-imove-mode' if WHAT is 'move."
 167   (if (eq what 'resize)
 168       xwem-frame-iresize-mode
 169     xwem-frame-imove-mode))
 170
 171 (defcustom xwem-frame-rolling-switch t
 172   "*Non-nil mean that \\<xwem-global-map>\\[xwem-frame-next] and
 173 \\<xwem-global-map>\\[xwem-frame-previous] will always switch, even if
 174 there no next or previous frame."
 175   :type 'boolean
 176   :group 'xwem-frame)
 177
 178 (defcustom xwem-frame-autoiconify-mode nil
 179   "Non-nil mean frame possible automatically iconifies when switching.
 180 If switching from OFR to NFR frame values mean next:
 181  nil       - No frame will be iconified.
 182  intersect - OFR will be iconified if it intersects with NFR.
 183  always    - OFR always iconfied."
 184   :type '(choice (const :tag "Disabled" nil)
 185                  (conts :tag "Intersect" intersect)
 186                  (const :tag "Always" always))
 187   :group 'xwem-frame)
 188
 189 (defcustom xwem-frame-autoselect-embedded t
 190   "*Non-nil mean if embedded frame selected as client, also select frame."
 191   :type 'boolean
 192   :group 'xwem-frame)
 193
 194 (defcustom xwem-frame-keep-number nil
 195   "*Non-nil mean frames keeps their numbers when intermediate frame destroyed."
 196   :type 'boolean
 197   :group 'xwem-frame)
 198
 199 ;; Hooks
 200 (defcustom xwem-frame-select-hook nil
 201   "*Hooks to call when new frame just selected."
 202   :type 'hook
 203   :group 'xwem-frame)
 204
 205 (defcustom xwem-frame-deselect-hook nil
 206   "*Hooks to call when selected frame is about to be deselected."
 207   :type 'hook
 208   :group 'xwem-frame)
 209
 210 (defcustom xwem-frame-creation-hook nil
 211   "Hooks called with one argument - frame, when frame just created."
 212   :type 'hook
 213   :group 'xwem-hooks)
 214
 215 (defcustom xwem-frame-change-hook nil
 216   "Hooks called with one argument - frame, when frame changed."
 217   :type 'hook
 218   :group 'xwem-hooks)
 219
 220 (defcustom xwem-frame-destroy-hook nil
 221   "Hooks called with one argument - frame, when frame destroyed."
 222   :type 'hook
 223   :group 'xwem-hooks)
 224
 225 (defcustom xwem-frame-resize-hook nil
 226   "Hooks called with one argument - frame, when frame resized."
 227   :type 'hook
 228   :group 'xwem-hooks)
 229
 230 (defcustom xwem-frame-move-hook nil
 231   "Hooks called with one argument - frame, when frame moved."
 232   :type 'hook
 233   :group 'xwem-hooks)
 234
 235 (defcustom xwem-frame-redraw-hook nil
 236   "Hooks called with one argument - frame, when frame redrawed."
 237   :type 'hook
 238   :group 'xwem-hooks)
 239
 240 (defcustom xwem-frame-configuration-exporting t
 241   "*Non-nil mean, frame configuration exports after each frame command.
 242 Non-nil value is useful when using xwem-agent.  It allows you restore
 243 frames on (S)XEmacs restart."
 244   :type 'boolean
 245   :group 'xwem-frame)
 246
 247 ;;; Internal variables
 248
 249 (defconst xwem-frame-ev-mask
 250   (Xmask-or XM-Exposure
 251             XM-StructureNotify
 252             XM-SubstructureRedirect
 253             XM-SubstructureNotify
 254             XM-KeyPress XM-ButtonPress XM-ButtonRelease
 255             XM-ResizeRedirect)
 256   "Events mask for xwem's frame.")
 257
 258 (defvar xwem-frame-cursor nil
 259   "Cursor used for xwem frame.")
 260
 261 (defvar xwem-frame-types
 262   '(desktop embedded embedded-desktop dedicated)
 263   "List of xwem frame types.")
 264
 265 ;;;###xwem-autoload
 266 (defvar xwem-frames-list nil
 267   "List of all xwem frames.")
 268
 269 (defvar xwem-frame-noredisplay nil
 270   "If this non-nil than frame it reffers should not be redisplayed.
 271 Internal variable, do not use.")
 272
 273 (defvar xwem-frame-dumped-config nil)
 274
 275 \f
 276 ;;;###xwem-autoload
 277 (defun xwem-frames-list (&optional type)
 278   "Return list of xwem frames of TYPE.
 279 If TYPE is ommited - list of frames of any type is returned."
 280   (remove* nil xwem-frames-list
 281            :test #'(lambda (f1 f2)
 282                      (not (and (xwem-frame-p f2)
 283                                (not (eq (xwem-frame-state f2) 'destroyed))
 284                                (or (null type)
 285                                    (eq (xwem-frame-type f2) type)))))))
 286
 287 ;;; Frame macros
 288 (defmacro xwem-frame-link-insert-after (frame1 frame2)
 289   "Make FRAME2 to be after FRAME1."
 290   `(let ((nf (xwem-frame-link-next ,frame1)))
 291      (when (xwem-frame-p nf)
 292        (setf (xwem-frame-link-prev nf) ,frame2))
 293      (setf (xwem-frame-link-next ,frame1) ,frame2)
 294      (setf (xwem-frame-link-prev ,frame2) ,frame1)
 295      (setf (xwem-frame-link-next ,frame2) nf)))
 296
 297 (defmacro xwem-frame-link-insert-before (frame1 frame2)
 298   "Make FRAME2 to be before FRAME1."
 299   `(let ((pf (xwem-frame-link-prev ,frame1)))
 300      (when (xwem-frame-p pf)
 301        (setf (xwem-frame-link-next pf) ,frame2))
 302      (setf (xwem-frame-link-prev ,frame1) ,frame2)
 303      (setf (xwem-frame-link-next ,frame2) ,frame1)
 304      (setf (xwem-frame-link-prev ,frame2) pf)))
 305
 306 (defmacro xwem-frame-link-remove (frame)
 307   "Remove FRAME from linkage."
 308   `(let ((nfr (xwem-frame-link-next ,frame))
 309          (pfr (xwem-frame-link-prev ,frame)))
 310      (when (xwem-frame-p pfr)
 311        (setf (xwem-frame-link-next pfr) nfr))
 312      (when (xwem-frame-p nfr)
 313        (setf (xwem-frame-link-prev nfr) pfr))))
 314
 315 (defmacro xwem-frame-link-head (frame)
 316   "Returns head frame of FRAME's linkage."
 317   `(let ((fr ,frame))
 318      (while (xwem-frame-p (xwem-frame-link-prev fr))
 319        (setq fr (xwem-frame-link-prev fr)))
 320      fr))
 321
 322 (defmacro xwem-frame-linkage-map (frame fn)
 323   "Call FN for each frame in FRAME's linkage.
 324 FN called with one argument - frame."
 325   ;; TODO: avoid infinit recursion
 326   `(let ((fr (xwem-frame-link-head ,frame)))
 327
 328      (while (xwem-frame-p fr)
 329        (funcall ,fn fr)
 330        (setq fr (xwem-frame-link-next fr)))))
 331
 332 ;;; X properties
 333 (defmacro xwem-frame-XProperty-get (frame prop-atom-string)
 334   `(xwem-XProperty-get (xwem-frame-xwin ,frame) ,prop-atom-string))
 335 (defmacro xwem-frame-XProperty-set (frame prop-atom-string prop-val)
 336   `(xwem-XProperty-set (xwem-frame-xwin ,frame) ,prop-atom-string ,prop-val))
 337
 338 (define-xwem-deffered xwem-frame-export-frame-configuration ()
 339   "Export frame configuration to root window.
 340
 341 Profiling results on 9 frames with 32 windows:
 342 Function Name                          Call Count  Elapsed Time  Average Time
 343 =====================================  ==========  ============  ============
 344 xwem-frame-export-frame-configuration  50          0.016508      0.00033016
 345 "
 346   (xwem-XProperty-set (xwem-rootwin) "XWEM_FRAME_CONFIGURATION"
 347                       (with-temp-buffer
 348                         (xwem-frame-config-dump1 (xwem-frame-configuration)
 349                                                  (current-buffer))
 350                         (read (buffer-substring (point-min) (point-max))))))
 351
 352 (defun xwem-frame-frame-command-post-hook ()
 353   "Function to use in `xwem-post-command-hook'.
 354 It exports frame configuration after each xwem command."
 355   (when xwem-frame-configuration-exporting
 356     (xwem-frame-export-frame-configuration)))
 357
 358 (defun xwem-frame-import-frame-configuration ()
 359   "Import frame configuration fram root window."
 360   (eval (xwem-XProperty-get (xwem-rootwin) "XWEM_FRAME_CONFIGURATION")))
 361
 362 ;;; Functions
 363 (define-xwem-deffered xwem-frame-apply-state (frame)
 364   "Apply FRAME's state to life."
 365   (cond ((eq (xwem-frame-state frame) 'mapped)
 366          (XMapWindow (xwem-dpy) (xwem-frame-xwin frame)))
 367         ((eq (xwem-frame-state frame) 'unmapped)
 368          (XUnmapWindow (xwem-dpy) (xwem-frame-xwin frame)))))
 369
 370 (defun xwem-frame-unmap (frame)
 371   "Unmap frame FRAME."
 372   (setf (xwem-frame-state frame) 'unmapped)
 373   (xwem-frame-apply-state frame))
 374
 375 ;;;###xwem-autoload
 376 (defun xwem-frame-map (frame)
 377   "Map frame FRAME."
 378   (setf (xwem-frame-state frame) 'mapped)
 379   (xwem-frame-apply-state frame))
 380
 381 (define-xwem-deffered xwem-frame-apply-raise-lower (frame)
 382   "Apply FRAME's raise/lower state to life."
 383   (let ((rl (xwem-frame-get-prop frame 'raise-lower-state)))
 384     (cond ((eq rl 'raise)
 385            (xwem-misc-raise-xwin (xwem-frame-xwin frame)))
 386           ((eq rl 'lower)
 387            (xwem-misc-lower-xwin (xwem-frame-xwin frame))))))
 388
 389 ;;;###autoload(autoload 'xwem-frame-lower "xwem-frame" "" t)
 390 (define-xwem-command xwem-frame-lower (frame)
 391   "Lower FRAME's window."
 392   (xwem-interactive (list (xwem-frame-selected)))
 393
 394   (xwem-frame-put-prop frame 'raise-lower-state 'lower)
 395   (xwem-frame-apply-raise-lower frame))
 396 (put 'xwem-frame-lower 'xwem-frame-command t)
 397
 398 ;;;###autoload(autoload 'xwem-frame-raise "xwem-frame" "" t)
 399 (define-xwem-command xwem-frame-raise (frame)
 400   "Raise FRAME's window."
 401   (xwem-interactive (list (xwem-frame-selected)))
 402
 403   (xwem-frame-map frame)                ; make sure frame is mapped
 404   (xwem-frame-put-prop frame 'raise-lower-state 'raise)
 405   (xwem-frame-apply-raise-lower frame))
 406 (put 'xwem-frame-raise 'xwem-frame-command t)
 407
 408 (defun xwem-frame-embedded-for-frame (frame)
 409   "Return XWEM frame for which FRAME is embedded."
 410   (let* ((cl (and (xwem-frame-p frame)
 411                   (xwem-frame-get-prop frame 'xwem-embedded-cl)))
 412          (rv (and (xwem-cl-p cl)
 413                   (xwem-cl-frame cl))))
 414     rv))
 415
 416 (defun xwem-frame-unembedd (frame &optional new-type)
 417   "Unembedd FRAME."
 418   (when (xwem-frame-embedded-p frame)
 419     (let* ((cl (xwem-frame-get-prop frame 'xwem-embedded-cl))
 420            (tpnt (car (XTranslateCoordinates
 421                        (xwem-dpy) (xwem-frame-xwin frame)
 422                        (xwem-rootwin) (xwem-frame-x frame)
 423                        (xwem-frame-y frame)))))
 424       ;; Remove clients stuff
 425       (xwem-cl-destroy cl)
 426
 427       ;; Unmark FRAME as embedded
 428       (xwem-cl-rem-prop cl 'xwem-embedded-frame)
 429       (xwem-frame-rem-prop frame 'xwem-embedded-cl)
 430
 431       ;; Set new frame TYPE
 432       (setf (xwem-frame-type frame) (or new-type 'desktop))
 433
 434       (XReparentWindow (xwem-dpy) (xwem-frame-xwin frame) (xwem-rootwin)
 435                        (X-Point-x tpnt) (X-Point-y tpnt))
 436       (xwem-frame-set-pos frame (X-Point-x tpnt) (X-Point-y tpnt))
 437       (xwem-frame-apply-state frame))))
 438
 439 ;;;###xwem-autoload
 440 (defun xwem-select-frame (frame)
 441   "Set FRAME to be selected frame.
 442 Actually all the work done in `xwem-select-window'."
 443   (or (xwem-frame-alive-p frame)
 444       (error 'xwem-error "Selecting dead frame"))
 445   (xwem-select-window (xwem-frame-selwin frame)))
 446
 447 (defun xwem-frame-autoiconify-on-deselect ()
 448   "Maybe iconify FRAME, when deselecting FRAME."
 449   (when (eq xwem-frame-autoiconify-mode 'always)
 450     ;; NOTE: double deffering
 451     (xwem-deffered-funcall
 452      (lambda (frame)
 453        (when (xwem-frame-p frame)
 454          (xwem-frame-unmap frame)))
 455      (xwem-frame-selected))))
 456
 457 (defun xwem-frame-autoiconify-on-select ()
 458   "Maybe iconify some frames when selecting FRAME."
 459   (when (and (eq xwem-frame-autoiconify-mode 'intersect)
 460              (xwem-frame-desktop-p (xwem-frame-selected)))
 461     (let ((nfr-rect (X-Geom-to-X-Rect
 462                      (xwem-frame-xgeom (xwem-frame-selected))))
 463           (frames (xwem-frames-list 'desktop)))
 464       (while frames
 465         (when (and (not (eq (xwem-frame-selected) (car frames)))
 466                    (xwem-frame-mapped-p (car frames))
 467                    (X-Rect-intersect-p
 468                     nfr-rect (X-Geom-to-X-Rect
 469                               (xwem-frame-xgeom (car frames)))))
 470           ;; NOTE: double deffering
 471           (xwem-deffered-funcall
 472            (lambda (frame)
 473              (when (xwem-frame-p frame)
 474                (xwem-frame-unmap frame)))
 475            (car frames)))
 476         (setq frames (cdr frames))))))
 477
 478 ;;;###xwem-autoload(autoload 'xwem-make-frame-1 "xwem-frame")
 479 (defun* xwem-make-frame-1 (type &key params props noselect)
 480   "Create new frame with optional frame properties PROPS.
 481 If EMBEDDED-p is non-nil than create embedded frame.
 482 If NOSELECT is non-nil then do not select newly created frame to be
 483 current."
 484   (let* ((fplist (copy-list xwem-frame-default-properties))
 485          (frame (apply 'make-xwem-frame params))
 486          fwin parwin)
 487
 488     (setf (xwem-frame-type frame) type)
 489     (setf (xwem-frame-state frame) 'unmapped)
 490
 491     ;;; Initialise FRAME's geometry
 492     (unless (xwem-frame-xgeom frame)
 493       (setf (xwem-frame-xgeom frame) (make-X-Geom)))
 494
 495     (unless (xwem-frame-x frame)
 496       (setf (xwem-frame-x frame) 0))
 497     (unless (xwem-frame-y frame)
 498       (setf (xwem-frame-y frame) 0))
 499     (unless (xwem-frame-width frame)
 500       (setf (xwem-frame-width frame) (X-Geom-width (xwem-rootgeom))))
 501     (unless (xwem-frame-height frame)
 502       (setf (xwem-frame-height frame)
 503             (- (X-Geom-height (xwem-rootgeom))
 504                (if (X-Geom-p (xwem-minib-xgeom xwem-minibuffer))
 505                    (X-Geom-height (xwem-minib-xgeom xwem-minibuffer))
 506                  0))))
 507
 508     ;;; Initialize FRAME's X window
 509     (setq fwin (XCreateWindow
 510                 (xwem-dpy) nil
 511                 (xwem-frame-x frame)
 512                 (xwem-frame-y frame)
 513                 (xwem-frame-width frame)
 514                 (xwem-frame-height frame)
 515                 0                       ; border width
 516                 nil                     ;DefaultDepth
 517                 nil                     ;CopyFromParent
 518                 nil                     ;CopyFromParent
 519                 (make-X-Attr :override-redirect
 520                              (not (xwem-frame-embedded-p frame))
 521                              :backing-store nil
 522                              :background-pixmap
 523                              (unless (xwem-frame-embedded-p frame)
 524                                X-ParentRelative)
 525                              :cursor xwem-frame-cursor
 526                              :event-mask xwem-frame-ev-mask)))
 527     (X-Win-put-prop fwin 'xwem-frame frame)
 528     (setf (xwem-frame-xwin frame) fwin)
 529
 530     ;; Install events handlers
 531     (X-Win-EventHandler-add-new
 532      fwin 'xwem-frame-events-handler 150)
 533     (X-Win-EventHandler-add-new
 534      fwin 'xwem-ev-reconfig 40 (list X-ConfigureRequest))
 535
 536     ;; XXX Setup WM_XXX stuff
 537     (XSetWMProtocols (xwem-dpy) fwin
 538                      (list (X-Atom-find-by-name (xwem-dpy) "WM_DELETE_WINDOW")
 539                            (X-Atom-find-by-name (xwem-dpy) "WM_TAKE_FOCUS")))
 540     (XSetWMClass (xwem-dpy) fwin
 541                  (list (symbol-name (xwem-frame-type frame))
 542                        "xwem-frame"))
 543     (XSetWMName (xwem-dpy) fwin "xwem-frame")
 544
 545     ;; Install grabbing
 546     (xwem-kbd-install-grab 'xwem-frame-prefix fwin)
 547
 548     ;;; Initialise FRAME properties
 549     ;; Adjust frame properties in case FRAME is embedded or dedicated
 550     ;; frame.
 551     (setq fplist (xwem-misc-merge-plists
 552                   fplist
 553                   (cond ((xwem-frame-embedded-p frame)
 554                          xwem-embedded-frame-default-properties)
 555                         ((xwem-frame-dedicated-p frame)
 556                          xwem-dedicated-frame-defalut-properties))))
 557
 558     ;;; Initialize FRAME's root window
 559     (setq parwin (xwem-win-new (list :frame frame) nil))
 560     (setf (xwem-frame-selwin frame) parwin)
 561     (setf (xwem-frame-rootwin frame) parwin)
 562
 563     ;; Set FRAME properties
 564     (xwem-frame-set-properties frame (xwem-misc-merge-plists fplist props))
 565
 566     ;; Setup rootwin's geometry
 567     (xwem-frame-setup-root-win frame)
 568
 569     ;; Find an empty place in xwem-frames-list or add to the end of
 570     ;; frames list.
 571     (let ((allframes xwem-frames-list))
 572       (while (and allframes (xwem-frame-p (car allframes)))
 573         (setq allframes (cdr allframes)))
 574       (if allframes
 575           (setcar allframes frame)
 576         (setq xwem-frames-list
 577               (append xwem-frames-list (list frame)))))
 578
 579     ;; Handle as client, i.e. make frame to be embedded
 580     (when (xwem-frame-embedded-p frame)
 581       (let ((ecl (xwem-xwin-try-to-manage (xwem-frame-xwin frame))))
 582         (when (xwem-cl-p ecl)
 583           (xwem-frame-put-prop frame 'xwem-embedded-cl ecl)
 584           (xwem-cl-put-sys-prop ecl 'xwem-embedded-frame frame))))
 585
 586     ;; Finally map and maybe select newly created frame
 587     (unless (xwem-frame-property frame 'initially-unmapped)
 588       (xwem-frame-map frame))
 589
 590     (unless noselect
 591       (xwem-select-frame frame))
 592
 593     ;; Now run on-create hooks
 594     (run-hook-with-args 'xwem-frame-creation-hook frame)
 595     frame))
 596
 597 (defun xwem-init-frame-at-rect (xrect)
 598   "Create frame to fit in XRECT rectangle."
 599   (let ((xmrect (make-X-Rect
 600                  :x 0 :y 0 :width (X-Geom-width (xwem-rootgeom))
 601                  :height (if (xwem-minib-xgeom xwem-minibuffer)
 602                              (X-Geom-height (xwem-minib-xgeom xwem-minibuffer))
 603                            (+ (* 2 xwem-minibuffer-border-width)
 604                               (frame-pixel-height
 605                                (xwem-minib-frame xwem-minibuffer))
 606                               xwem-minibuffer-outer-border-width
 607                               xwem-minibuffer-outer-border-width)))))
 608
 609     (when (X-Rect-intersect-p xmrect xrect)
 610       ;; Take into account this intersection
 611       (setf (X-Rect-height xrect)
 612             (- (X-Rect-height xrect)
 613                (X-Rect-height xmrect))))
 614
 615     (xwem-make-frame-1 'desktop
 616                        :params (list :xgeom (X-Rect-to-X-Geom xrect))
 617                        :noselect t)))
 618
 619 (defun xwem-frame-adjust-geom (frame new-rect)
 620   "Adjust FRAME geom according to NEW-RECT and xwem-minibuffer geom."
 621   (let ((mrect (X-Geom-to-X-Rect (xwem-minib-xgeom xwem-minibuffer)))
 622         (brd (X-Geom-border-width (xwem-minib-xgeom xwem-minibuffer)))
 623         ngeom)
 624     (when (eq (xwem-cl-state (xwem-minib-cl xwem-minibuffer)) 'active)
 625       (when brd
 626         (incf (X-Rect-width mrect) (+ brd brd))
 627         (incf (X-Rect-height mrect) (+ brd brd)))
 628
 629       (when (X-Rect-intersect-p new-rect mrect)
 630         (setf (X-Rect-height new-rect)
 631               (- (X-Rect-height new-rect)
 632                  (X-Rect-height mrect)))))
 633
 634     (setq ngeom (X-Rect-to-X-Geom new-rect))
 635     (setf (X-Geom-border-width ngeom)
 636           (X-Geom-border-width (xwem-frame-xgeom frame)))
 637     (decf (X-Geom-width ngeom) (* 2 (X-Geom-border-width ngeom)))
 638     (decf (X-Geom-height ngeom) (* 2 (X-Geom-border-width ngeom)))
 639
 640     (setf (xwem-frame-xgeom frame) ngeom)))
 641
 642 (defun xwem-frame-default-select-hook ()
 643   "Do various default things when frame selected.
 644 To be used in `xwem-frame-select-hook'."
 645   (xwem-frame-autoiconify-on-select)
 646   (xwem-frame-deffered-redraw-inner-border (xwem-frame-selected)))
 647
 648 (defun xwem-frame-default-deselect-hook ()
 649   "Do various default things when frame deselected.
 650 To be used in `xwem-frame-deselect-hook'."
 651   (xwem-frame-autoiconify-on-deselect)
 652   (xwem-frame-deffered-redraw-inner-border (xwem-frame-selected)))
 653
 654 (defun xwem-frame-create-initial ()
 655   "Create initial frames."
 656   ;; Try to import frame configuration from root window
 657   (xwem-frame-import-frame-configuration)
 658
 659   (if xwem-frame-dumped-config
 660       ;; Create frames from saved configuration
 661       (xwem-frame-config-restore1)
 662
 663     ;; Xinerama stuff
 664     (let ((xin (X-XIneramaQueryScreens (xwem-dpy)))
 665           frame frame-old)
 666       (if (car xin)
 667           ;; XInerama enabled, so construct frames linkage
 668           (while (setq xin (cdr xin))
 669             (setq frame (xwem-init-frame-at-rect (car xin)))
 670             (when frame-old
 671               (xwem-frame-link-insert-after frame-old frame))
 672             (setq frame-old frame))
 673
 674         ;; No XInerama, crate just one frame
 675         (xwem-init-frame-at-rect (X-Geom-to-X-Rect (xwem-rootgeom)))))
 676
 677     ;; Select very first frame
 678     (xwem-select-frame (car (xwem-frames-list)))))
 679
 680 ;;;###xwem-autoload
 681 (defun xwem-frames-init ()
 682   "xwem frames initializer."
 683   (xwem-message 'init "Initializing frames ...")
 684
 685   (setq xwem-frames-list nil)
 686   (setq xwem-current-frame nil)
 687
 688   ;; Create frame cursors
 689   (setq  xwem-frame-cursor
 690          (xwem-make-cursor xwem-frame-cursor-shape
 691                            xwem-frame-cursor-foreground-color
 692                            xwem-frame-cursor-background-color))
 693
 694   ;; Add autoiconifier hooks
 695   (add-hook 'xwem-frame-select-hook 'xwem-frame-default-select-hook)
 696   (add-hook 'xwem-frame-deselect-hook 'xwem-frame-default-deselect-hook)
 697
 698   ;; Add post command hook to export frames configuration
 699   (add-hook 'xwem-post-command-hook 'xwem-frame-frame-command-post-hook)
 700
 701   ;; Create initial frames
 702   (xwem-frame-create-initial)
 703
 704   (xwem-message 'init "Initializing frames ... done"))
 705
 706 ;;;###xwem-autoload
 707 (defun xwem-frames-fini ()
 708   "Finialize frames."
 709   (mapc 'xwem-frame-destroy (xwem-frames-list)))
 710
 711 ;;;###autoload(autoload 'xwem-make-frame "xwem-frame" "" t)
 712 (define-xwem-command xwem-make-frame (type &optional arg)
 713   "Interactively create new XWEM frame.
 714 With prefix ARG create frame of 'desktop type."
 715   (xwem-interactive (list (or (and xwem-prefix-arg 'desktop)
 716                               (xwem-completing-read
 717                                "XWEM Frame type [desktop]: "
 718                                (mapcar (lambda (cc) (list (symbol-name cc)))
 719                                        xwem-frame-types)))
 720                           xwem-prefix-arg))
 721   (when (stringp type)
 722     (if (string= type "")
 723         (setq type 'desktop)
 724       (setq type (intern-soft type))))
 725
 726   (xwem-make-frame-1 type))
 727
 728 (defun xwem-frame-find (how arg)
 729   "Find frame by ARG. HOW is search type, one of 'xwin 'win 'cl or 'name."
 730   (let ((flist (xwem-frames-list))
 731         (rf nil))
 732
 733     (while flist
 734       (if (cond ((and (eq how 'xwin)
 735                       (X-Win-p arg)
 736                       (= (X-Win-id arg)
 737                          (X-Win-id (xwem-frame-xwin (car flist)))))
 738                  t)
 739
 740                 ((and (eq how 'win)
 741                       (eq (xwem-win-frame arg) (car flist)))
 742                  t)
 743
 744                 ((and (eq how 'cl)
 745                       (eq (xwem-cl-frame arg) (car flist)))
 746                  t)
 747
 748                 ((and (eq how 'name)
 749                       (string= arg (xwem-frame-name (car flist))))
 750                  t)
 751
 752                 (t nil))
 753           (progn
 754             (setq rf (car flist))
 755             (setq flist nil))
 756
 757         (setq flist (cdr flist))))
 758     rf))
 759
 760 (defun xwem-frame-other-frame (frame)
 761   "Return other frame for FRAME.
 762 NOTE: not yet implemented"
 763
 764   ;; Try linkage, and then try closest frame
 765   (let ((oframe (xwem-frame-link-next frame)))
 766     (unless (xwem-frame-p oframe)
 767       (setq oframe (xwem-frame-link-prev frame))
 768       (unless (xwem-frame-p oframe)
 769         (setq oframe (cadr (memq frame (xwem-frames-list
 770                                         (xwem-frame-type frame)))))
 771         (unless (xwem-frame-p oframe)
 772           (setq oframe (cadr (memq frame (nreverse
 773                                           (xwem-frames-list
 774                                            (xwem-frame-type frame))))))
 775           (unless (xwem-frame-p oframe)
 776             (setq oframe (car (xwem-frames-list)))))))
 777     oframe))
 778
 779 ;;;###xwem-autoload
 780 (defun xwem-frame-other (frame &optional type)
 781   "Same as `xwem-frame-other-frame', but return nil, if no good other frame found.
 782 TYPE is ane of 'any, 'linkage"
 783   (unless type
 784     (setq type 'any))
 785
 786   ;; First try linkaged frames
 787   (let ((allframes (xwem-frames-list))
 788         (oframe (xwem-frame-link-next frame)))
 789     (unless (xwem-frame-mapped-p oframe)
 790       (setq oframe (xwem-frame-link-prev frame)))
 791
 792     ;; Now try parent in case when FRAME is embedded frame.
 793     (unless (xwem-frame-mapped-p oframe)
 794       (when (xwem-frame-embedded-p frame)
 795         (let ((cl (xwem-frame-get-prop frame 'xwem-embedded-cl)))
 796           (when (xwem-cl-p cl)
 797             (setq oframe (xwem-cl-frame cl))))))
 798
 799     (when (and (not (xwem-frame-mapped-p oframe))
 800                (eq type 'any))
 801       ;; Scan frames list only for 'any TYPE
 802       (while (and allframes (not (xwem-frame-mapped-p oframe)))
 803         (when (and (xwem-frame-mapped-p (car allframes))
 804                    (not (eq frame (car allframes))))
 805           (setq oframe (car allframes))
 806           (setq allframes nil))
 807         (setq allframes (cdr allframes))))
 808     oframe))
 809
 810 ;;;###xwem-autoload
 811 (defun xwem-frame-num (frame)
 812   "Return FRAME index in `xwem-frames-list'."
 813   (- (length xwem-frames-list)
 814      (length (memq frame xwem-frames-list))))
 815
 816 (defun xwem-frame-xy-in-p (x y frame)
 817   "Return non-nil if point at X Y is in FRAME."
 818   (and (>= x (xwem-frame-x frame))
 819        (<= x (+ (xwem-frame-x frame) (xwem-frame-width frame)))
 820        (>= y (xwem-frame-y frame))
 821        (<= y (+ (xwem-frame-y frame) (xwem-frame-height frame)))))
 822
 823 (defun xwem-frame-at (x y &optional maped-p)
 824   "Return frame which contain point at X Y.
 825 If MAPED-P is non-nil - search only mapped frame."
 826   (loop for frame in (xwem-frames-list)
 827     if (and (or (null maped-p)
 828                 (eq (xwem-frame-state frame) 'mapped))
 829             (xwem-frame-xy-in-p x y frame))
 830     return frame))
 831
 832 ;;;###xwem-autoload(autoload 'xwem-frame-apply-xgeom-1 "xwem-frame" nil nil)
 833 ;;;###xwem-autoload(autoload 'xwem-frame-apply-xgeom "xwem-frame" nil nil)
 834 (define-xwem-deffered xwem-frame-apply-xgeom (frame)
 835   "Apply FRAME's geometry to life."
 836   (XConfigureWindow (xwem-dpy) (xwem-frame-xwin frame)
 837                     (make-X-Conf
 838                      :x (xwem-frame-x frame)
 839                      :y (xwem-frame-y frame)
 840                      :width (xwem-frame-width frame)
 841                      :height (xwem-frame-height frame)
 842                      :border-width (xwem-frame-border-width frame)))
 843
 844   (xwem-frame-setup-root-win frame)
 845   (run-hook-with-args 'xwem-frame-resize-hook frame))
 846
 847 (define-xwem-deffered xwem-frame-apply-position (frame)
 848   "Apply FRAME's position to life."
 849   (when (xwem-frame-p frame)
 850     (XMoveWindow (xwem-dpy) (xwem-frame-xwin frame)
 851                  (xwem-frame-x frame) (xwem-frame-y frame))
 852     (run-hook-with-args 'xwem-frame-move-hook frame)))
 853
 854 ;;;###xwem-autoload
 855 (defun xwem-frame-set-pos (frame new-x new-y)
 856   "Set FRAME position at NEW-X and NEW-Y."
 857   (setf (xwem-frame-x frame) new-x)
 858   (setf (xwem-frame-y frame) new-y)
 859
 860   (xwem-frame-apply-position frame))
 861
 862 (define-xwem-deffered xwem-frame-apply-size (frame)
 863   "Apply FRAME's size to life."
 864   (when (xwem-frame-p frame)
 865     (xwem-debug 'xwem-frame "Applying size: %dx%d"
 866                 '(xwem-frame-width frame) '(xwem-frame-height frame))
 867     (XResizeWindow (xwem-dpy) (xwem-frame-xwin frame)
 868                    (xwem-frame-width frame) (xwem-frame-height frame))
 869
 870     (run-hook-with-args 'xwem-frame-resize-hook frame)))
 871
 872 ;;;###xwem-autoload
 873 (defun xwem-frame-set-size (frame new-width new-height)
 874   "Resize FRAME to NEW-WIDTH and NEW-HEIGHT."
 875   (when new-width
 876     (setf (xwem-frame-width frame) new-width))
 877   (when new-height
 878     (setf (xwem-frame-height frame) new-height))
 879
 880   (xwem-frame-setup-root-win frame)
 881   (xwem-frame-apply-size frame))
 882
 883 ;;; Frame Events handling
 884 (defun xwem-frame-hexpose (frame xev)
 885   "Expose event handler."
 886   (xwem-debug 'xwem-frame "Exposure event count: %S"
 887               '(X-Event-xexpose-count xev))
 888
 889   (when (zerop (X-Event-xexpose-count xev))
 890     ;; Redraw only when no other exposure events follow
 891     (and (xwem-frame-p frame)
 892          (xwem-frame-draw frame nil))))
 893
 894 (defun xwem-frame-remove (frame &optional select-other)
 895   "Remove FRAME from frames list, switch to other frame if SELECT-OTHER is non-nil."
 896   (let ((oframe (xwem-frame-other frame 'any))) ; other frame
 897
 898     ;; Remove FRAME from linkage if any
 899     (xwem-frame-link-remove frame)
 900
 901     ;; Now Remove FRAME from frame list
 902     (unless xwem-frame-keep-number
 903       (setq xwem-frames-list (delq frame xwem-frames-list)))
 904
 905     ;; If frame is not selected it mean that it was embedded
 906     (if (and select-other (xwem-frame-p oframe) (not (eq oframe frame)))
 907         (xwem-select-frame oframe)
 908       (setq xwem-current-frame nil))))
 909
 910 (defun xwem-frame-total-remove (frame)
 911   "Totally remove FRAME."
 912   ;; Firstly we need to remove FRAME from frames list.
 913   (let ((embed-cl (xwem-frame-get-prop frame 'xwem-embedded-cl))
 914         (oframe (xwem-frame-other frame)))
 915
 916     ;; If FRAME is selected, select some other frame
 917     (setq xwem-current-frame nil)
 918     (when (xwem-frame-p oframe)
 919       (xwem-select-frame oframe))
 920
 921     ;; Block events handling
 922     (XSelectInput (xwem-dpy) (xwem-frame-xwin frame) 0)
 923     (setf (X-Win-event-handlers (xwem-frame-xwin frame)) nil)
 924     (X-Win-rem-prop (xwem-frame-xwin frame) 'xwem-frame)
 925
 926     ;; Remove clients from FRAME
 927     (mapc #'(lambda (fcl)
 928               (XReparentWindow (xwem-dpy) (xwem-cl-xwin fcl) (xwem-rootwin)
 929                                (X-Geom-width (xwem-rootgeom))
 930                                (X-Geom-height (xwem-rootgeom)))
 931               (xwem-withdraw fcl))
 932           (xwem-frame-clients frame))
 933
 934     ;; Destroy any X wins
 935     (unless (eq (xwem-frame-state frame) 'destroyed)
 936       (XDestroySubwindows (xwem-dpy) (xwem-frame-xwin frame))
 937       (XDestroyWindow (xwem-dpy) (xwem-frame-xwin frame))
 938       (setf (xwem-frame-state frame) 'destroyed))
 939
 940     ;; If we are embedded frame than emulate our destroing
 941     (when (xwem-cl-p embed-cl)
 942       (xwem-cl-destroy embed-cl))
 943
 944     ;; Remove frame from frames list and select another frame
 945     (xwem-frame-remove frame t)
 946
 947     (xwem-unwind-protect
 948         ;; Now run on-destroy hooks
 949         (run-hook-with-args 'xwem-frame-destroy-hook frame)
 950       ;; Mark FRAME as non valid for referencing.
 951       (X-invalidate-cl-struct frame))))
 952
 953 (defun xwem-frame-hconfigure (frame xev)
 954   "FRAME just received ConfigureNotify event XEV."
 955   (let ((owid (xwem-frame-width frame))
 956         (ohei (xwem-frame-height frame))
 957         (nwid (X-Event-xconfigure-width xev)) ;new width
 958         (nhei (X-Event-xconfigure-height xev))) ;new height
 959
 960     (unless (and (= owid nwid) (= ohei nhei))
 961       (xwem-frame-set-size frame nwid nhei)
 962       (run-hook-with-args 'xwem-frame-resize-hook frame))))
 963
 964 (defun xwem-frame-hclient (frame xev)
 965   "FRAME just received XClientMessage event XEV."
 966   (xwem-debug 'xwem-frame
 967               "FRAME[%d] got ClientMessage, Atom=%S(%s).."
 968               '(xwem-frame-num frame) '(X-Atom-id (X-Event-xclient-atom xev))
 969               '(X-Atom-name (X-Event-xclient-atom xev)))
 970
 971   (cond ((string= (X-Atom-name (X-Event-xclient-atom xev)) "WM_PROTOCOLS")
 972          (let ((wmda (X-Atom-find (xwem-dpy) (caar (X-Event-xclient-msg xev)))))
 973            (when (X-Atom-p wmda)
 974              (cond ((string= (X-Atom-name wmda) "WM_DELETE_WINDOW")
 975                     (xwem-debug 'xwem-frame "Killing frame, because of WM_DELETE_WINDOW client message")
 976                     (xwem-frame-total-remove frame))
 977                    ((string= (X-Atom-name wmda) "WM_TAKE_FOCUS")
 978                     (xwem-debug 'xwem-frame "Frame(%s): Taking focus .."
 979                                 '(xwem-frame-name frame))
 980                     (xwem-focus-set (xwem-frame-cl frame)))))
 981            ))))
 982
 983 (defun xwem-frame-hkeybutton (frame xev)
 984   "On FRAME handle KeyPress, ButtonPress or ButtonRelease event XEV."
 985   (xwem-overriding-local-map 'xwem-frame-prefix
 986     (when (eq (xwem-dispatch-command-xevent xev) 'done)
 987       (signal 'X-Events-stop nil))))
 988
 989 (defun xwem-frame-events-handler (xdpy win xev)
 990   "Event handler for frame."
 991   (let ((frame (X-Win-get-prop win 'xwem-frame)))
 992     (when (xwem-frame-p frame)
 993       (xwem-debug 'xwem-frame "Got event ev=%S, win=%S, frame: %d"
 994                   '(X-Event-name xev) '(X-Win-id win) '(xwem-frame-num frame))
 995       (X-Event-CASE xev
 996         (:X-Expose
 997          (xwem-frame-hexpose frame xev))
 998
 999         ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
1000          (xwem-frame-hkeybutton frame xev))
1001
1002         (:X-DestroyNotify
1003          (setf (xwem-frame-state frame) 'destroyed)
1004          (xwem-frame-total-remove frame))
1005
1006         (:X-ClientMessage (xwem-frame-hclient frame xev))
1007
1008         ;; For emebedded frames
1009         (:X-ConfigureNotify
1010          (when (xwem-frame-embedded-p frame)
1011            (xwem-frame-hconfigure frame xev)))
1012         (:X-MapNotify
1013          (when (xwem-frame-embedded-p frame)
1014            (xwem-frame-map frame)))
1015         (:X-UnmapNotify
1016          (when (xwem-frame-embedded-p frame)
1017            (xwem-frame-unmap frame)))
1018         ))))
1019
1020 ;;;; Frame Events handling ends here
1021
1022 (defun xwem-frame-draw (frame full)
1023   "Draw FRAME. If FULL is t then fully redraw it, i.e. ClearWindow first."
1024   (unless (eq frame xwem-frame-noredisplay)
1025     (when full
1026       (XClearArea (xwem-dpy) (xwem-frame-xwin frame) 0 0
1027                   (xwem-frame-width frame)
1028                   (xwem-frame-height frame) nil))
1029
1030     (xwem-frame-draw-inner-border frame)
1031     (run-hook-with-args 'xwem-frame-redraw-hook frame)))
1032
1033 ;;; Frame configuration section
1034 ;;;###xwem-autoload
1035 (defun xwem-frame-configuration-p (frame-config)
1036   "Return non-nil if FRAME-CONFIG is looks like frame configuration."
1037   (and (listp frame-config)
1038        (eq 'xwem-frame-configuration
1039            (car frame-config))))
1040
1041 (defun xwem-frame-config-find-sframe (frame sframe-list)
1042   "Find saved frame by FRAME."
1043   (while (and sframe-list
1044               (not (eq (xwem-frame-saved-frame (car sframe-list)) frame)))
1045     (setq sframe-list (cdr sframe-list)))
1046   (car sframe-list))
1047
1048 ;;;###xwem-autoload
1049 (defun xwem-frame-configuration ()
1050   "Return current xwem frame configuration."
1051   ;; TODO: save domain faces
1052   (cons 'xwem-frame-configuration
1053         (mapcar #'(lambda (frame)
1054                     (make-xwem-frame-saved
1055                      :frame frame
1056                      :selected-p (xwem-frame-selected-p frame)
1057                      :type (xwem-frame-type frame)
1058                      :name (xwem-frame-name frame)
1059                      :xgeom (copy-X-Geom (xwem-frame-xgeom frame))
1060                      :state (xwem-frame-state frame)
1061                      :plist (append (xwem-frame-properties frame)
1062                                     (unless (xwem-frame-mapped-p frame)
1063                                       '(initially-unmapped t)))
1064                      :winconfig (xwem-window-configuration frame)))
1065                 (xwem-frames-list))))
1066
1067 ;;;###xwem-autoload
1068 (defun xwem-set-frame-configuration (frame-config &optional no-delete)
1069   "Restore the frames to the state described by FRAME-CONFIG."
1070   (unless (xwem-frame-configuration-p frame-config)
1071     (signal 'wrong-type-argument
1072             (list 'xwem-frame-configuration-p frame-config)))
1073
1074   ;; TODO:
1075   ;;   - Maybe recreate frames that in config, but already destroyed?
1076   (let ((conf (cdr frame-config))
1077         frames-to-delete)
1078     (mapc #'(lambda (frame)
1079               (let ((sframe (xwem-frame-config-find-sframe frame conf)))
1080                 (if (xwem-frame-saved-p sframe)
1081                     (progn
1082                       (setf (xwem-frame-name frame)
1083                             (xwem-frame-saved-name sframe)
1084                             (xwem-frame-state frame)
1085                             (xwem-frame-saved-state sframe))
1086                       (xwem-frame-adjust-geom
1087                        frame (xwem-frame-saved-xgeom sframe))
1088                       (xwem-set-window-configuration
1089                        (xwem-frame-saved-winconfig sframe)))
1090
1091                   (setq frames-to-delete (cons frame frames-to-delete)))))
1092           (xwem-frames-list))
1093
1094     (if no-delete
1095         (mapc 'xwem-frame-hide frames-to-delete)
1096       (mapc 'xwem-frame-destroy frames-to-delete))
1097     ))
1098
1099 (defun xwem-frame-config-dump1 (config buffer &optional append)
1100   "Dump frames CONFIG to BUFFER.
1101 If APPEND is non-nil, do not erase FILE, just append to the end."
1102   ;; TODO: dump also domain faces
1103   (let ((ccf (copy-sequence config))
1104         wcf)
1105     (with-current-buffer (or buffer (current-buffer))
1106       (if append
1107           (progn
1108             (goto-char (point-max))
1109             (insert "\n"))
1110         (erase-buffer))
1111
1112       (insert "(setq xwem-frame-dumped-config (list 'xwem-frame-configuration\n")
1113       (mapc #'(lambda (sfr)
1114                 (setf (xwem-frame-saved-frame sfr) nil)
1115
1116                 ;; Adjust win config
1117                 (setq wcf (xwem-frame-saved-winconfig sfr))
1118                 (setf (xwem-win-config-frame wcf) nil)
1119                 (setf (xwem-win-config-current-cl wcf) nil)
1120                 (flet ((clrwin (swin)
1121                          (setf (xwem-win-saved-clients swin) nil)
1122                          (setf (xwem-win-saved-cl swin) nil)
1123                          (when (xwem-win-saved-first-vchild swin)
1124                            (clrwin (xwem-win-saved-first-vchild swin)))
1125                          (when (xwem-win-saved-first-hchild swin)
1126                            (clrwin (xwem-win-saved-first-hchild swin)))
1127                          (when (xwem-win-saved-next swin)
1128                            (clrwin (xwem-win-saved-next swin)))
1129                          (when (xwem-win-saved-prev swin)
1130                            (clrwin (xwem-win-saved-prev swin)))))
1131                   (clrwin (xwem-win-config-saved-root-window wcf)))
1132
1133                 (insert (format "%S\n" sfr)))
1134             (cdr ccf))
1135       (insert "))\n"))))
1136
1137 (defun xwem-frame-config-dump (config &optional file)
1138   "Dump frame configuration CONFIG to FILE.
1139 If FILE ommited, than ~/.xwem/xwem-configs.el will be used."
1140   (unless (xwem-frame-configuration-p config)
1141     (error 'xwem-error "Not an xwem frame configuration" config))
1142
1143   (unless file
1144     (setq file (expand-file-name "xwem-configs.el" xwem-dir)))
1145
1146   (let* ((find-file-hooks nil)          ; omit autoinsert and others
1147          (buf (find-file-noselect file)))
1148     (xwem-frame-config-dump1 config buf)
1149     (save-buffer buf)))
1150
1151 (defun xwem-frame-config-restore1 ()
1152   "Internal frame config restorer."
1153   (let (frame-to-select)
1154     (mapc #'(lambda (sfr)
1155               (let ((swin (xwem-frame-saved-winconfig sfr))
1156                     nframe)
1157                 (setq nframe (xwem-make-frame-1
1158                               (xwem-frame-saved-type sfr)
1159                               :params (list :name (xwem-frame-saved-name sfr)
1160                                             :xgeom (xwem-frame-saved-xgeom sfr))
1161                               :props (xwem-frame-saved-plist sfr)
1162                               :noselect t))
1163                 (when (xwem-frame-p nframe)
1164                   (setf (xwem-win-config-frame swin) nframe)
1165                   (xwem-set-window-configuration swin)
1166
1167                   (when (and  (xwem-frame-saved-selected-p sfr)
1168                               (not frame-to-select))
1169                     (setq frame-to-select nframe)))
1170                 ))
1171           (cdr xwem-frame-dumped-config))
1172     (when frame-to-select
1173       (xwem-select-frame frame-to-select)))
1174
1175   ;; dumped config has been restored
1176   (setq xwem-frame-dumped-config nil))
1177
1178 (defun xwem-frame-config-restore (&optional file)
1179   "Restore saved frames configuration from FILE.
1180 Default FILE is ~/.xwem/xwem-configs.el"
1181   (unless file
1182     (setq file (expand-file-name "xwem-configs.el" xwem-dir)))
1183
1184   (load-file file)
1185   (unless (xwem-frame-configuration-p xwem-frame-dumped-config)
1186     (error 'xwem-error "no frames configuration to restore"))
1187
1188   (xwem-frame-config-restore1))
1189
1190 ;;; Frame configuration section ends here
1191 ;;;###autoload(autoload 'xwem-frame-next "xwem-frame" "" t)
1192 (define-xwem-command xwem-frame-next (arg)
1193   "Switch to ARG next frame."
1194   (xwem-interactive "p")
1195
1196   (let ((frame (nth arg (memq (xwem-frame-selected) (xwem-frames-list)))))
1197     (when (and xwem-frame-rolling-switch
1198                (not (xwem-frame-p frame)))
1199       ;; Assume first frame if there no next
1200       (setq frame (car (xwem-frames-list))))
1201
1202     (unless (xwem-frame-p frame)
1203       (error 'xwem-error "Invalid frame"))
1204
1205     (xwem-select-frame frame)))
1206 (put 'xwem-frame-next 'xwem-frame-command t)
1207
1208 ;;;###autoload(autoload 'xwem-frame-previous "xwem-frame" "" t)
1209 (define-xwem-command xwem-frame-previous (arg)
1210   "Switch to ARG previous frame."
1211   (xwem-interactive "p")
1212
1213   (let ((frame (nth arg (memq (xwem-frame-selected)
1214                               (reverse (xwem-frames-list))))))
1215     (when (and xwem-frame-rolling-switch
1216                (not (xwem-frame-p frame)))
1217       ;; Assume last frame if there no previous
1218       (setq frame (car (last (xwem-frames-list)))))
1219
1220     (unless (xwem-frame-p frame)
1221       (error 'xwem-error "Invalid frame"))
1222
1223     (xwem-select-frame frame)))
1224 (put 'xwem-frame-previous 'xwem-frame-command t)
1225
1226 ;;;###autoload(autoload 'xwem-frame-switch "xwem-frame" "Switch to frame by name." t)
1227 (define-xwem-command xwem-frame-switch (name)
1228   "Switch to frame by NAME."
1229   (xwem-interactive
1230    (list (xwem-completing-read
1231           "XWEM Frame: "
1232           (mapcar #'(lambda (fr)
1233                       (list (xwem-frame-name fr)))
1234                   (xwem-frames-list)))))
1235
1236   ;; Find frame by name
1237   (let ((frms (xwem-frames-list))
1238         (frame nil))
1239     (while (and frms (not (string= (xwem-frame-name (car frms)) name)))
1240       (setq frms (cdr frms)))
1241     (setq frame (car frms))
1242
1243     (unless (xwem-frame-alive-p frame)
1244       (error 'xwem-error "No such frame"))
1245
1246     (xwem-select-frame frame)))
1247
1248 ;;;###autoload(autoload 'xwem-frame-switch-nth "xwem-frame" "" t)
1249 (define-xwem-command xwem-frame-switch-nth (arg)
1250   "Switch xwem frame.
1251 If ARG is numeric prefix, then switch to ARG frame.
1252 If ARG ommited, 0 as ARG value will be used.
1253 If ARG is list and selected frame is embedded, than unembedd it."
1254   (xwem-interactive "P")
1255
1256   (when (null arg)
1257     (setq arg 0))
1258   (if (numberp arg)
1259       (let ((frame (nth (abs arg) xwem-frames-list)))
1260         (if (xwem-frame-p frame)
1261             (xwem-select-frame frame)
1262           (xwem-message 'warning "No such %S frame." (abs arg))))
1263
1264     ;; UNEMBED selected frame
1265     (let ((frame (xwem-frame-selected)))
1266       (when (xwem-frame-embedded-p frame)
1267         (xwem-frame-unembedd frame)
1268         (xwem-select-frame frame)))
1269     ))
1270
1271 ;;;###autoload(autoload 'xwem-frame-switch-nth-linkage "xwem-frame" "" t)
1272 (define-xwem-command xwem-frame-switch-nth-linkage (arg)
1273   "Raise all frames that in linkage of frame with number NUM."
1274   (xwem-interactive "P")
1275
1276   (when (null arg) (setq arg 0))
1277   (if (numberp arg)
1278       (let ((frame (nth (abs arg) xwem-frames-list)))
1279         (if (not (xwem-frame-p frame))
1280           (xwem-message 'warning "No such %S frame." (abs arg))
1281
1282           ;; Select linkage
1283           (xwem-frame-linkage-map frame 'xwem-frame-raise)
1284           (xwem-select-frame frame)))
1285     (xwem-message 'warning "Strange arg value: %S" arg)))
1286
1287 ;;;###autoload(autoload 'xwem-frame-destroy "xwem-frame" "" t)
1288 (define-xwem-command xwem-frame-destroy (frame &optional arg)
1289   "Destroy FRAME. If FRAME is not given selected frame assumed.
1290 If prefix ARG is given - close all clients managed in FRAME."
1291   (xwem-interactive (list (xwem-frame-selected) xwem-prefix-arg))
1292
1293   ;; In case of prefix ARG - close all clients
1294   (when arg
1295     (mapc 'xwem-client-kill
1296           (xwem-clients-list #'(lambda (cl)
1297                                  (eq (xwem-cl-frame cl) frame)))))
1298
1299   (when (xwem-frame-p frame)
1300     (xwem-frame-total-remove frame)))
1301 (put 'xwem-frame-destroy 'xwem-frame-command t)
1302
1303 (defun xwem-frame-goto (n direction &optional frame)
1304   "Goto window at DIRECTION on FRAME N times.
1305 DIRECTION is one of 'next, 'prev, 'next-vert, ..."
1306   (let* ((gframe (or frame (xwem-frame-selected)))
1307          (cwin (xwem-frame-selwin gframe)))
1308
1309     ;; Adjust N and DIRECTION if needed
1310     (when (and (eq direction 'next)
1311                (< n 0))
1312       (setq n (- n)
1313             direction 'prev))
1314
1315     (while (> n 0)
1316       (cond ((eq direction 'next)
1317              (setq cwin (xwem-window-next cwin)))
1318             ((eq direction 'prev)
1319              (setq cwin (xwem-window-prev cwin)))
1320             ((eq direction 'next-vert)
1321              (setq cwin (xwem-window-next-vertical cwin)))
1322             (t (error
1323                 'xwem-error "Bad DIRECTION in `xwem-frame-goto'" direction)))
1324       (setq n (1- n)))
1325
1326     (xwem-select-window cwin)))
1327
1328 ;;;###autoload(autoload 'xwem-frame-goto-next "xwem-frame" "" t)
1329 (define-xwem-command xwem-frame-goto-next (arg)
1330   "Goto ARG next window in selected frame."
1331   (xwem-interactive "p")
1332   (xwem-frame-goto arg 'next))
1333
1334 ;;;###autoload(autoload 'xwem-frame-goto-prev "xwem-frame" "" t)
1335 (define-xwem-command xwem-frame-goto-prev (arg)
1336   "Goto ARG previous window in selected frame."
1337   (xwem-interactive "p")
1338   (xwem-frame-goto arg 'prev))
1339
1340 ;;;###autoload(autoload 'xwem-frame-goto-next-vert "xwem-frame" "" t)
1341 (define-xwem-command xwem-frame-goto-next-vert (arg)
1342   "Goto ARG next window in vertical direction in selected frame."
1343   (xwem-interactive "p")
1344   (xwem-frame-goto arg 'next-vert))
1345
1346 ;;;###autoload(autoload 'xwem-frame-goto-next-hor "xwem-frame" "" t)
1347 (define-xwem-command xwem-frame-goto-next-hor (arg)
1348   "Goto ARG next window in horizontal direction in selected frame."
1349   (xwem-interactive "p")
1350   (xwem-frame-goto arg 'next-hor))
1351
1352 ;;;###autoload(autoload 'xwem-frame-goto-prev-vert "xwem-frame" "" t)
1353 (define-xwem-command xwem-frame-goto-prev-vert (arg)
1354   "Goto ARG previous window in vertical direction in selected frame."
1355   (xwem-interactive "p")
1356   (xwem-frame-goto arg 'priv-vert))
1357
1358 ;;;###autoload(autoload 'xwem-frame-goto-prev-hor "xwem-frame" "" t)
1359 (define-xwem-command xwem-frame-goto-prev-hor (arg)
1360   "Goto ARG previous window in horizontal direction in selected frame."
1361   (xwem-interactive "p")
1362   (xwem-frame-goto arg 'prev-hor))
1363
1364 ;;;###autoload(autoload 'xwem-frame-split-sbs "xwem-frame" "" t)
1365 (define-xwem-command xwem-frame-split-sbs (n &optional frame side)
1366   "Makes N frames side by size of FRAME.
1367 SIDE is one of 'vertical or 'horizontal, if ommited or not one of
1368 above - 'horizontal will be used.
1369
1370 Example:
1371 SIDE is 'horiz
1372 +--------+                             +----+----+--...--+----+
1373 +--------+                             +----+----+--...--+----+
1374 | 1      | `xwem-frame-split-sbs' |--> | 1  | 2  |       | N  |
1375 |        |                             |    |    |       |    |
1376 +--------+                             +----+----+--...--+----+
1377
1378 Widths sum of all N frames after sbs split is equal to width of frame
1379 before."
1380   (xwem-interactive "p")
1381
1382   (let* ((vertp (eq side 'vertical))
1383          (frm (or frame (xwem-frame-selected)))
1384          (wi (xwem-frame-width frm))
1385          (he (xwem-frame-height frm))
1386          (nwi wi)
1387          (nhe he)
1388          (wost 0)
1389          (host 0)
1390          xoff yoff)
1391
1392     (when (xwem-frame-embedded-p frm)
1393       (error 'xwem-error "Can't split embedded frame"))
1394
1395     (if vertp
1396         (progn
1397           (setq nhe (/ he (1+ n)))
1398           (setq host (% he (1+ n))))
1399       (setq nwi (/ wi (1+ n)))
1400       (setq wost (% wi (1+ n))))
1401
1402     (setq xoff (+ nwi wost))
1403     (setq yoff (+ nhe host))
1404
1405     ;; Resize frame
1406     (xwem-frame-set-size frm xoff yoff)
1407
1408     ;; TODO: - inherit same parent in case FRM is embedded
1409     ;;       - install frames linkage
1410     (let ((oframe frm)
1411           (nframe nil)
1412           (samex (xwem-frame-x frm))
1413           (samey (xwem-frame-y frm)))
1414       (while (> n 0)
1415         (setq nframe
1416               (xwem-make-frame-1 (xwem-frame-type frm)
1417                                  :params
1418                                  (list :xgeom
1419                                        (make-X-Geom :x (if vertp
1420                                                            samex
1421                                                          (+ samex xoff))
1422                                                     :y (if vertp
1423                                                            (+ samey yoff)
1424                                                          samey)
1425                                                     :width nwi
1426                                                     :height nhe))
1427                                  :noselect t))
1428         ;; Now setup linkage
1429         (xwem-frame-link-insert-after oframe nframe)
1430         (setq oframe nframe)
1431
1432         (if vertp
1433             (setq yoff (+ yoff nhe))
1434           (setq xoff (+ xoff nwi)))
1435         (setq n (1- n))))
1436     ))
1437 (put 'xwem-frame-iresize 'xwem-frame-command t)
1438
1439 ;;;###autoload(autoload 'xwem-frame-sbs-hor-split "xwem-frame" "" t)
1440 (define-xwem-command xwem-frame-sbs-hor-split (n)
1441   "Make horizontal sbs split N times for selected frame."
1442   (xwem-interactive "p")
1443   (xwem-frame-split-sbs n))
1444 (put 'xwem-frame-sbs-hor-split 'xwem-frame-command t)
1445
1446 ;;;###autoload(autoload 'xwem-frame-sbs-vert-split "xwem-frame" "" t)
1447 (define-xwem-command xwem-frame-sbs-vert-split (n)
1448   "Make vertical sbs split N times for selected frame."
1449   (xwem-interactive "p")
1450   (xwem-frame-split-sbs n nil 'vertical))
1451 (put 'xwem-frame-sbs-vert-split 'xwem-frame-command t)
1452
1453 ;;;###autoload(autoload 'xwem-frame-fit-screen "xwem-frame" "" t)
1454 (define-xwem-command xwem-frame-fit-screen (frame)
1455   "Fit FRAME to screen sizes."
1456   (xwem-interactive (list (xwem-frame-selected)))
1457
1458   ;; Take into acount XInerama layout
1459   (let ((frect (X-Geom-to-X-Rect (xwem-frame-xgeom frame)))
1460         (xin (X-XIneramaQueryScreens (xwem-dpy))))
1461     (if (car xin)
1462         (progn
1463           ;; XInerama enabled
1464           (while (and (setq xin (cdr xin))
1465                       (not (X-Rect-intersect-p (car xin) frect))))
1466           (setq xin (car xin)))
1467
1468       ;; No XInerama, so use root geometry
1469       (setq xin (X-Geom-to-X-Rect (xwem-rootgeom))))
1470
1471     (xwem-frame-adjust-geom frame xin)
1472
1473     (xwem-frame-set-size
1474      frame (xwem-frame-width frame) (xwem-frame-height frame))
1475     (xwem-frame-set-pos
1476      frame (xwem-frame-x frame) (xwem-frame-y frame))
1477
1478     ;; XXX uninstall linkage if any
1479     (xwem-frame-link-remove frame)))
1480 (put 'xwem-frame-fit-screen 'xwem-frame-command t)
1481
1482 ;;;###autoload(autoload 'xwem-frame-transpose "xwem-frame" "" t)
1483 (define-xwem-command xwem-frame-transpose (arg)
1484   "Transpose frames ARG times."
1485   (xwem-interactive "p")
1486   (error 'xwem-error "`xwem-frame-transpose' not implemented yet."))
1487
1488 ;;;###autoload(autoload 'xwem-frame-showroot "xwem-frame" "" t)
1489 (define-xwem-command xwem-frame-showroot ()
1490   "Show root window, i.e. unmap all xwem frames."
1491   (xwem-interactive)
1492   (mapc 'xwem-frame-unmap (xwem-frames-list))
1493   (xwem-select-client nil))
1494
1495 ;;;###autoload(autoload 'xwem-frame-hide "xwem-frame" "" t)
1496 (define-xwem-command xwem-frame-hide (frame &optional no-select)
1497   "Hide FRAME.
1498 When called interactively, FRAME is selected frame.
1499 With prefix ARG, do not select new frame."
1500   (xwem-interactive (list (xwem-frame-selected)
1501                           xwem-prefix-arg))
1502
1503   (let ((oframe (xwem-frame-other frame))
1504         em-cl)
1505     (when (xwem-frame-mapped-p frame)
1506       ;; We are about to hide FRAME, so select other frame
1507       (when (and (not no-select)
1508                  (xwem-frame-p oframe))
1509         (xwem-select-frame oframe))
1510
1511       ;; In case FRAME is embedded frame - iconify coressponding
1512       ;; client.
1513       (if (xwem-cl-p (setq em-cl (xwem-frame-get-prop
1514                                   frame 'xwem-embedded-cl)))
1515           (xwem-iconify em-cl)
1516         (xwem-frame-unmap frame)))))
1517 (put 'xwem-frame-hide 'xwem-frame-command t)
1518
1519 ;;;###autoload(autoload 'xwem-transpose-frames "xwem-frame" "" t)
1520 (define-xwem-command xwem-transpose-frames (arg)
1521   "Transpose selected frame with ARG other frame."
1522   (xwem-interactive "p")
1523
1524   (let* ((sfr (xwem-frame-selected))
1525          (ofr (xwem-frame-other sfr))
1526          sg og)
1527
1528     (when (xwem-frame-p ofr)
1529       (setq sg (copy-sequence (xwem-frame-xgeom sfr))
1530             og (copy-sequence (xwem-frame-xgeom ofr)))
1531
1532       (xwem-frame-set-pos sfr (X-Geom-x og) (X-Geom-y og))
1533       (xwem-frame-set-pos ofr (X-Geom-x sg) (X-Geom-y sg))
1534
1535       (xwem-frame-set-size sfr (X-Geom-width og) (X-Geom-height og))
1536       (xwem-frame-set-size ofr (X-Geom-width sg) (X-Geom-height sg))
1537
1538       ;; Finally exchange positions (aka frame number) in
1539       ;; `xwem-frames' list
1540       (xwem-list-exchange-els xwem-frames-list sfr ofr))))
1541 (put 'xwem-transpose-frames 'xwem-frame-command t)
1542
1543 ;;;###autoload(autoload 'xwem-frame-set-name "xwem-frame" "" t)
1544 (define-xwem-command xwem-frame-set-name (name &optional frame)
1545   "Set FRAME's name to NAME."
1546   (xwem-interactive (list (xwem-read-from-minibuffer
1547                            (format "New frame name (old: %s): "
1548                                    (xwem-frame-name (xwem-frame-selected))))
1549                           (xwem-frame-selected)))
1550
1551   (setf (xwem-frame-name frame) name)
1552
1553   ;; Finally run hooks
1554   (run-hook-with-args 'xwem-frame-change-hook frame))
1555 (put 'xwem-frame-set-name 'xwem-frame-command t)
1556
1557 ;; XXX: what this?
1558 (defun xwem-frame-in-delim-p (win x y)
1559   "Return non-nil if X Y is inside some delimeter."
1560   (catch 'found
1561     (let ((hc (xwem-win-hchild win))
1562           (vc (xwem-win-vchild win))
1563           rwin)
1564
1565       (while (xwem-win-p hc)
1566         ;; For horizontal split
1567         (when (and (> x (+ (xwem-win-x hc) (xwem-win-width hc)))
1568                    (< x (+ (xwem-win-x hc) (xwem-win-width hc)
1569                            (xwem-win-delim-width hc)))
1570                    (> y (xwem-win-y hc))
1571                    (< y (+ (xwem-win-y hc) (xwem-win-height hc))))
1572           (throw 'found hc))
1573         (when (setq rwin (xwem-frame-in-delim-p hc x y))
1574           (throw 'found rwin))
1575         (setq hc (xwem-win-next hc)))
1576
1577       (while (xwem-win-p vc)
1578         (when (and (> x (xwem-win-x vc))
1579                    (< x (+ (xwem-win-x vc) (xwem-win-width vc)))
1580                    (> y (+ (xwem-win-y vc) (xwem-win-height vc)))
1581                    (< y (+ (xwem-win-y vc) (xwem-win-height vc)
1582                            (xwem-win-delim-width vc))))
1583           (throw 'found vc))
1584         (when (setq rwin (xwem-frame-in-delim-p vc x y))
1585           (throw 'found rwin))
1586         (setq vc (xwem-win-next vc)))
1587       nil)))
1588
1589 ;;;###autoload(autoload 'xwem-frame-on-delim-resize "xwem-frame" "" t)
1590 (define-xwem-command xwem-frame-on-delim-resize ()
1591   "Resize window dragging delimiter."
1592   (xwem-interactive)
1593
1594   (let* ((x (X-Event-xbutton-event-x xwem-last-xevent))
1595          (y (X-Event-xbutton-event-y xwem-last-xevent))
1596          (frame (or (X-Win-get-prop
1597                      (X-Event-xbutton-event xwem-last-xevent) 'xwem-frame)
1598                     (xwem-frame-at x y)))
1599          (in-xy (and (xwem-frame-p frame)
1600                      (xwem-frame-in-delim-p
1601                       (xwem-frame-rootwin frame) x y)))
1602          (win in-xy)
1603          xrect type cursor done xev)
1604
1605     (when (xwem-win-p win)
1606       ;; Findout resize tipe (vertical or horisontal)
1607       (if (> y (+ (xwem-win-y win)
1608                   (xwem-win-height win)))
1609           (setq type 'vert)
1610         (setq type 'horz))
1611
1612       ;; Fill xrects
1613       (setq xrect (make-X-Rect :x (xwem-win-x win)
1614                                :y (xwem-win-y win)
1615                                :width (xwem-win-width win)
1616                                :height (xwem-win-height win)))
1617
1618       ;; Create cursor
1619       (setq cursor (xwem-make-cursor
1620                     (if (eq type 'vert)
1621                         X-XC-sb_v_double_arrow
1622                       X-XC-sb_h_double_arrow)))
1623
1624       (xwem-mouse-grab cursor (xwem-frame-xwin frame)
1625                        (Xmask-or XM-ButtonRelease XM-ButtonMotion))
1626       (unless (eq xwem-frame-on-delim-resize-mode 'opaque)
1627         (xwem-misc-outline xrect 'normal (xwem-frame-xwin frame)))
1628       (xwem-unwind-protect
1629           (while (and (not done)        ; still not done?
1630                       (setq xev (xwem-next-event)) ; deliver event before win check
1631                       (xwem-win-next win)) ; still has delimiter?
1632             (X-Event-CASE xev
1633               (:X-ButtonRelease (setq done t))
1634
1635               (:X-MotionNotify
1636                (cond ((and (eq type 'vert)
1637                            (> (X-Event-xmotion-event-y xev) 0)
1638                            (> (X-Event-xmotion-event-y xev)
1639                               (+ (X-Rect-y xrect) xwem-win-min-height))
1640                            (not (= (X-Event-xmotion-event-y xev)
1641                                    (+ (X-Rect-y xrect)
1642                                       (X-Rect-height xrect)))))
1643                       (unless (eq xwem-frame-on-delim-resize-mode 'opaque)
1644                         (xwem-misc-outline
1645                          xrect 'normal (xwem-frame-xwin frame)))
1646                       (setf (X-Rect-height xrect)
1647                             (- (X-Event-xmotion-event-y xev) (X-Rect-y xrect)))
1648                       (if (eq xwem-frame-on-delim-resize-mode 'opaque)
1649                           (xwem-window-enlarge-vertically
1650                            (- (X-Rect-height xrect) (xwem-win-height win)) win)
1651                         (xwem-misc-outline
1652                          xrect 'normal (xwem-frame-xwin frame))))
1653
1654                      ((and (eq type 'horz)
1655                            (> (X-Event-xmotion-event-x xev) 0)
1656                            (> (X-Event-xmotion-event-x xev)
1657                               (+ (X-Rect-x xrect) xwem-win-min-width))
1658                            (not (= (X-Event-xmotion-event-x xev)
1659                                    (+ (X-Rect-x xrect) (X-Rect-width xrect)))))
1660                       (unless (eq xwem-frame-on-delim-resize-mode 'opaque)
1661                         (xwem-misc-outline
1662                          xrect 'normal (xwem-frame-xwin frame)))
1663                       (setf (X-Rect-width xrect)
1664                             (- (X-Event-xmotion-event-x xev) (X-Rect-x xrect)))
1665                       (if (eq xwem-frame-on-delim-resize-mode 'opaque)
1666                           (xwem-window-enlarge-horizontally
1667                            (- (X-Rect-width xrect) (xwem-win-width win)) win)
1668                         (xwem-misc-outline
1669                          xrect 'normal (xwem-frame-xwin frame))))))))
1670
1671         (xwem-mouse-ungrab)
1672         (XFreeCursor (xwem-dpy) cursor)
1673
1674         (unless (eq xwem-frame-on-delim-resize-mode 'opaque)
1675           (xwem-misc-outline xrect 'normal (xwem-frame-xwin frame))
1676
1677           (if (eq type 'vert)
1678               (xwem-window-enlarge-vertically (- (X-Rect-height xrect)
1679                                                  (xwem-win-height win)) win)
1680             (xwem-window-enlarge-horizontally (- (X-Rect-width xrect)
1681                                                  (xwem-win-width win)) win)))
1682         ))))
1683 (put 'xwem-frame-on-delim-resize 'xwem-frame-command t)
1684
1685 ;;;###autoload(autoload 'xwem-frame-on-delim-menu "xwem-frame" "" t)
1686 (define-xwem-command xwem-frame-on-delim-menu ()
1687   "Popup menu when delimiter clicked."
1688   (xwem-interactive)
1689
1690   (let* ((x (X-Event-xbutton-event-x xwem-last-xevent))
1691          (y (X-Event-xbutton-event-y xwem-last-xevent))
1692          (frame (xwem-frame-at x y))
1693          (win (and (xwem-frame-p frame)
1694                    (xwem-frame-in-delim-p
1695                     (xwem-frame-rootwin frame) x y))))
1696
1697     (when (xwem-win-p win)
1698       (xwem-popup-menu (xwem-generate-window-menu "Window" win)))))
1699
1700 ;;;###xwem-autoload
1701 (defun xwem-frame-imove-internal (frame sx sy &optional imove-mode)
1702   "Interactively move FRAME."
1703   (when (xwem-frame-embedded-p frame)
1704     (error 'xwem-error "Can't interactively move embedded frame"))
1705
1706   (unless imove-mode
1707     (setq imove-mode
1708           (funcall xwem-frame-imoveresize-mode-function frame 'move)))
1709
1710   (let ((step 1)
1711         (done nil)
1712         last-xrect curr-xrect xev
1713         pevs)
1714
1715     (setq last-xrect (X-Geom-to-X-Rect (xwem-frame-xgeom frame))
1716           curr-xrect (copy-X-Rect last-xrect))
1717
1718     (xwem-mouse-grab xwem-cursor-move nil ;(xwem-frame-xwin frame)
1719                      (Xmask-or XM-ButtonPress XM-ButtonRelease
1720                                XM-ButtonMotion XM-PointerMotion))
1721     (if (eq imove-mode 'opaque)
1722         (xwem-frame-map frame)
1723       (xwem-misc-outline last-xrect imove-mode))
1724     ;; Normally we should do this event loop under GrabServer, but
1725     ;; grabbing server causes XEmacs to freeze in some
1726     ;; circumstances. --lg
1727     (xwem-unwind-protect
1728         (while (not done)
1729           (setq xev (xwem-next-event nil (list X-ButtonPress X-ButtonRelease
1730                                                X-MotionNotify X-MapRequest)))
1731           (X-Event-CASE xev
1732             (:X-MapRequest
1733              (setq pevs (append pevs (list xev))))
1734             ((:X-ButtonPress :X-ButtonRelease) (setq done t))
1735
1736             (:X-MotionNotify
1737              ;; Update curr-xrect
1738              (setf (X-Rect-x curr-xrect)
1739                    (+ (X-Rect-x curr-xrect)
1740                       (- (X-Event-xmotion-root-x xev) sx)))
1741              (setq sx (X-Event-xmotion-root-x xev))
1742              (setf (X-Rect-y curr-xrect)
1743                    (+ (X-Rect-y curr-xrect)
1744                       (- (X-Event-xmotion-root-y xev) sy)))
1745              (setq sy (X-Event-xmotion-root-y xev))
1746
1747              (when (or (> (abs (- (X-Rect-x curr-xrect)
1748                                   (X-Rect-x last-xrect))) step)
1749                        (> (abs (- (X-Rect-y curr-xrect)
1750                                   (X-Rect-y last-xrect))) step))
1751                (unless (eq imove-mode 'opaque)
1752                  (xwem-misc-outline last-xrect imove-mode))
1753
1754                (setf (X-Rect-x last-xrect) (X-Rect-x curr-xrect))
1755                (setf (X-Rect-y last-xrect) (X-Rect-y curr-xrect))
1756                (if (eq imove-mode 'opaque)
1757                    (xwem-frame-set-pos
1758                     frame (X-Rect-x last-xrect) (X-Rect-y last-xrect))
1759                  (xwem-misc-outline last-xrect imove-mode))))))
1760
1761       (xwem-mouse-ungrab)
1762       (unless (eq imove-mode 'opaque)
1763         (xwem-misc-outline last-xrect imove-mode))
1764
1765       ;; Apply changes
1766       (xwem-frame-set-pos frame (X-Rect-x last-xrect) (X-Rect-y last-xrect)))
1767
1768     ;; Dispatch map requests
1769     (mapc 'X-Dpy-event-dispatch pevs)))
1770
1771 ;;;###autoload(autoload 'xwem-frame-imove "xwem-frame" "" t)
1772 (define-xwem-command xwem-frame-imove ()
1773   "Interactively move FRAME."
1774   (xwem-interactive)
1775
1776   (unless (or (interactive-p)
1777               (= (X-Event-type xwem-last-xevent) X-ButtonPress))
1778     (error 'xwem-error "`xwem-frame-imove'' must be binded to mouse event"))
1779
1780   (let* ((srx (X-Event-xbutton-root-x xwem-last-xevent))
1781          (sry (X-Event-xbutton-root-y xwem-last-xevent))
1782          (frame (or (xwem-xwin-frame (X-Event-xbutton-event xwem-last-xevent))
1783                     (xwem-frame-at srx sry))))
1784
1785     (unless (xwem-frame-p frame)
1786       (error 'xwem-error "`xwem-frame-imove' on non-frame"))
1787
1788     (xwem-frame-imove-internal frame srx sry)))
1789 (put 'xwem-frame-imove 'xwem-frame-command t)
1790
1791 ;;;###autoload(autoload 'xwem-frame-iresize "xwem-frame" "" t)
1792 (define-xwem-command xwem-frame-iresize ()
1793   "Interactively resize frame"
1794   (xwem-interactive)
1795
1796   (unless (or (interactive-p)
1797               (= (X-Event-type xwem-last-xevent) X-ButtonPress))
1798     (error 'xwem-error "`xwem-frame-iresize' must be binded to mouse event"))
1799
1800   (let* ((srx (X-Event-xbutton-root-x xwem-last-xevent))
1801          (sry (X-Event-xbutton-root-y xwem-last-xevent))
1802          (frame (or (xwem-xwin-frame (X-Event-xbutton-event xwem-last-xevent))
1803                     (xwem-frame-at srx sry)))
1804          (iresize-mode
1805           (funcall xwem-frame-imoveresize-mode-function frame 'resize))
1806          (last-xrect (and (xwem-frame-p frame)
1807                           (make-X-Rect :x (xwem-frame-x frame)
1808                                        :y (xwem-frame-y frame)
1809                                        :width (- srx (xwem-frame-x frame))
1810                                        :height (- sry (xwem-frame-y frame)))))
1811          (curr-xrect (copy-X-Rect last-xrect))
1812          step-x step-y min-height min-width
1813          done xev)
1814
1815     (unless (xwem-frame-p frame)
1816       (error 'xwem-error "`xwem-frame-iresize' on non-frame"))
1817
1818     ;; Setup steps
1819     (when (xwem-frame-dedicated-p frame)
1820       (let ((sg (xwem-cl-step-geom (xwem-frame-cl frame)))
1821             (mg (xwem-cl-min-geom (xwem-frame-cl frame))))
1822         (setq step-x (car sg)
1823               step-y (cdr sg)
1824               min-width (car mg)
1825               min-height (cdr mg))))
1826     (unless step-x (setq step-x 1))
1827     (unless step-y (setq step-y 1))
1828
1829     ;; Calculate minimal width/height of frame.
1830     ;; Simple sum win's min width/height so many times how many
1831     ;; windows
1832     (unless min-width
1833       (setq min-width
1834             (+ xwem-win-min-width
1835                (- (xwem-frame-width frame)
1836                   (xwem-win-width (xwem-frame-rootwin frame)))))
1837       (xwem-win-map #'(lambda (w)
1838                         (let ((pwin (xwem-win-parent w)))
1839                           (when (and (and pwin (xwem-win-hchild pwin)))
1840                             (incf min-width
1841                                   (+ xwem-win-min-width
1842                                      (car xwem-win-horizontal-delim-width))))))
1843                     (xwem-frame-selwin frame)))
1844     (unless min-height
1845       (setq min-height
1846             (+ xwem-win-min-height
1847                (- (xwem-frame-height frame)
1848                   (xwem-win-height (xwem-frame-rootwin frame)))))
1849       (xwem-win-map #'(lambda (w)
1850                         (let ((pwin (xwem-win-parent w)))
1851                           (when (and (and pwin (xwem-win-vchild pwin)))
1852                             (incf min-height
1853                                   (+ xwem-win-min-height
1854                                      (car xwem-win-vertical-delim-width))))))
1855                     (xwem-frame-selwin frame)))
1856
1857     ;; Adjust last-xrect according to calculated min-width/height
1858     (when (< (X-Rect-width last-xrect) min-width)
1859       (setf (X-Rect-width last-xrect) min-width))
1860     (when (< (X-Rect-height last-xrect) min-height)
1861       (setf (X-Rect-height last-xrect) min-height))
1862
1863     (xwem-mouse-grab xwem-cursor-resize (xwem-frame-xwin frame)
1864                      (Xmask-or XM-ButtonRelease XM-ButtonMotion))
1865     (unless (eq iresize-mode 'opaque)
1866       (xwem-misc-outline last-xrect iresize-mode))
1867     (xwem-unwind-protect
1868         (while (not done)
1869           (X-Event-CASE (setq xev (xwem-next-event))
1870             (:X-ButtonRelease (setq done t))
1871
1872             (:X-MotionNotify
1873              ;; Update curr-xrect
1874              (setf (X-Rect-width curr-xrect)
1875                    (- (X-Event-xmotion-root-x xev) (X-Rect-x curr-xrect)))
1876              (setf (X-Rect-height curr-xrect)
1877                    (- (X-Event-xmotion-root-y xev) (X-Rect-y curr-xrect)))
1878
1879              (when (and (or (>= (X-Rect-width curr-xrect) min-width)
1880                             (>= (X-Rect-height curr-xrect) min-height))
1881                         (or (> (abs (- (X-Rect-width curr-xrect)
1882                                        (X-Rect-width last-xrect))) step-x)
1883                             (> (abs (- (X-Rect-height curr-xrect)
1884                                        (X-Rect-height last-xrect))) step-y)))
1885                (unless (eq iresize-mode 'opaque)
1886                  (xwem-misc-outline last-xrect iresize-mode))
1887                (when (>= (X-Rect-width curr-xrect) min-width)
1888                  (setf (X-Rect-width last-xrect) (X-Rect-width curr-xrect)))
1889                (when (>= (X-Rect-height curr-xrect) min-height)
1890                  (setf (X-Rect-height last-xrect) (X-Rect-height curr-xrect)))
1891                (if (eq iresize-mode 'opaque)
1892                    (xwem-frame-set-size
1893                     frame (X-Rect-width last-xrect) (X-Rect-height last-xrect))
1894                  (xwem-misc-outline last-xrect iresize-mode))
1895                ))))
1896       (xwem-mouse-ungrab)
1897       (unless (eq iresize-mode 'opaque)
1898         (xwem-misc-outline last-xrect iresize-mode))
1899
1900       ;; Apply changes
1901       (xwem-frame-set-pos frame (X-Rect-x last-xrect) (X-Rect-y last-xrect))
1902       (xwem-frame-set-size
1903        frame (X-Rect-width last-xrect) (X-Rect-height last-xrect)))
1904     ))
1905 (put 'xwem-frame-iresize 'xwem-frame-command t)
1906
1907 ;;;###xwem-autoload
1908 (defun xwem-frame-clients (frame)
1909   "Make list of all clients FRAME holds."
1910   (xwem-clients-list `(lambda (cl)
1911                         (eq (xwem-cl-frame cl) ,frame))))
1912
1913 (define-xwem-face xwem-frame-inner-border-face
1914   `(((light nonselected) (:foreground "gray80" :background "gray80"))
1915     ((medium nonselected) (:foreground "gray50" :background "gray50"))
1916     ((dark nonselected) (:foreground "gray20" :background "gray20"))
1917     ((light selected) (:foreground "cyan2" :background "cyan2"))
1918     ((medium selected) (:foreground "royalblue" :background "royalblue"))
1919     ((dark selected) (:foreground "blue4" :background "blue4")))
1920   "Face to draw frame's inner border."
1921   :group 'xwem-frame
1922   :group 'xwem-faces)
1923
1924 ;;; Outline inner border
1925 (defun xwem-frame-draw-inner-border (frame)
1926   "Draw inner border for FRAME."
1927   (let* ((bw (xwem-frame-property frame 'inner-border-width))
1928          (th (or (xwem-frame-property frame 'inner-border-thickness) 1))
1929          (tag1 (if (xwem-frame-selected-p frame) 'selected 'nonselected))
1930          (wgc (xwem-face-get-gc 'xwem-frame-inner-border-face
1931                 (list 'light tag1) frame))
1932          (bgc (xwem-face-get-gc 'xwem-frame-inner-border-face
1933                 (list 'dark tag1) frame))
1934          (gc (xwem-face-get-gc 'xwem-frame-inner-border-face
1935                (list 'medium tag1) frame))
1936          (off th))
1937
1938     (when (> bw 0)
1939       (XDrawRectangles
1940        (xwem-dpy) (xwem-frame-xwin frame)
1941        gc (mapcar #'(lambda (notused)
1942                       (prog1
1943                           (make-X-Rect :x off :y off
1944                                        :width (- (xwem-frame-width frame)
1945                                                  (* 2 off) 1)
1946                                        :height (- (xwem-frame-height frame)
1947                                                   (* 2 off) 1))
1948                         (incf off)))
1949                   (make-list (- bw (* 2 th)) nil)))
1950
1951       (xwem-misc-draw-shadow (xwem-dpy) (xwem-frame-xwin frame)
1952                              wgc bgc 0 0 (xwem-frame-width frame)
1953                              (xwem-frame-height frame) th)
1954       (xwem-misc-draw-shadow (xwem-dpy) (xwem-frame-xwin frame)
1955                              bgc wgc (- bw th) (- bw th)
1956                              (- (xwem-frame-width frame) (* 2 (- bw th)))
1957                              (- (xwem-frame-height frame) (* 2 (- bw th)))
1958                              th)
1959       )))
1960
1961 (define-xwem-deffered xwem-frame-deffered-redraw-inner-border (frame)
1962   "Redraw inner border for selected frame."
1963   (and (xwem-frame-p frame)
1964        (xwem-frame-draw-inner-border frame)))
1965
1966 ;;; Showing mode
1967 (defvar xwem-frame-showing-mode-hook nil
1968   "Hooks to call when entering/leaving showing mode.
1969 Each hook called with two arguments: FRAME and MODE,
1970 where mode is one of:
1971
1972   `enter' - FRAME enters showing mode.
1973   `leave' - FRAME leaving showing mode.")
1974
1975 (defun xwem-frame-enter-showing-mode (frame)
1976   "Enable showing mode for FRAME."
1977   (unless (eq (xwem-frame-property frame 'showing-mode) 'on)
1978     (let ((fcls (xwem-frame-clients frame)))
1979       (mapc 'xwem-iconify fcls)
1980
1981       (xwem-frame-put-prop frame 'showing-mode 'on)
1982       (run-hook-with-args 'xwem-frame-showing-mode-hook frame 'enter))))
1983
1984 (defun xwem-frame-leave-showing-mode (frame)
1985   "Disable showing mode."
1986   (unless (eq (xwem-frame-property frame 'showing-mode) 'off)
1987     (let ((fcls (xwem-frame-clients frame)))
1988       (mapcar 'xwem-manage fcls)
1989
1990       (xwem-frame-put-prop frame 'showing-mode 'off)
1991       (run-hook-with-args 'xwem-frame-showing-mode-hook frame 'leave))))
1992
1993 ;;; Frame properties
1994 (defvar xwem-frame-supported-properties nil
1995   "*List of supported frame properties.")
1996
1997 (defmacro define-xwem-frame-property (prop doc &rest keys-val)
1998   "Define new frame property PROP.
1999 DOC is doc-string for property and KEYS-VAL is a list of keyword-value
2000 pairs.  Supported keywords are:
2001
2002   :type   - Type of property (same as in `defcustom')
2003   :set    - Function to set property.
2004   :get    - Function to get property value.
2005   :notifiers - Functions to call when new value for property is set.
2006 "
2007   `(progn
2008      (add-to-list 'xwem-frame-supported-properties (quote ,prop))
2009      (put (quote ,prop) 'xwem-property-definition (list :doc ,doc ,@keys-val))))
2010
2011 (defun xwem-frame-get-prop-keyword (prop keyword &optional default)
2012   "Return PROP's KEYWORD value.
2013 Return DEFAULT is KEYWORD not found."
2014   (plist-get (get prop 'xwem-property-definition) keyword default))
2015
2016 ;;;###xwem-autoload
2017 (defun xwem-frame-add-property-notifier (prop notifier)
2018   (let ((notifiers (xwem-frame-get-prop-keyword prop :notifiers)))
2019     (if notifiers
2020         (setcdr (last notifiers) (cons notifier nil))
2021       (put prop 'xwem-property-definition
2022            (plist-put (get prop 'xwem-property-definition)
2023                       :notifiers (list notifier))))))
2024
2025 ;;;###xwem-autoload
2026 (defun xwem-frame-set-property (frame prop val)
2027   "Set FRAME's propertie PROP to VAL.
2028 If FRAME is nil - selected frame is used."
2029   (unless frame
2030     (setq frame (xwem-frame-selected)))
2031   (unless (equal (xwem-frame-property frame prop) val)
2032     (funcall (xwem-frame-get-prop-keyword prop :set 'xwem-frame-put-prop)
2033              frame prop val)
2034     ;; Call notifiers
2035     (mapc #'(lambda (notifier) (funcall notifier frame prop val))
2036           (xwem-frame-get-prop-keyword prop :notifiers))))
2037
2038 ;;;###xwem-autoload
2039 (defun xwem-frame-set-properties (frame props-plist)
2040   "Set FRAME properties PROPS."
2041   (while props-plist
2042     (xwem-frame-set-property frame (car props-plist) (cadr props-plist))
2043     (setq props-plist (cddr props-plist))))
2044
2045 ;;;###xwem-autoload
2046 (defun xwem-frame-property (frame prop)
2047   "Return value for FRAME's property PROP.
2048 If FRAME is nil - selected frame is used."
2049   (funcall (xwem-frame-get-prop-keyword prop :get 'xwem-frame-get-prop)
2050            (or frame (xwem-frame-selected)) prop))
2051
2052 ;;;###xwem-autoload
2053 (defun xwem-frame-properties (&optional frame)
2054   "Return a list of FRAME's properties.
2055 List is copied, you are free to modify it for your needs.
2056 Note that only supported properties are returned.
2057 If FRAME is omitted - selected frame is used."
2058   (let ((fplist (xwem-frame-plist (or frame (xwem-frame-selected))))
2059         rplist)
2060     (while fplist
2061       (when (memq (car fplist) xwem-frame-supported-properties)
2062         (setq rplist (plist-put rplist (car fplist) (cadr fplist))))
2063       (setq fplist (cddr fplist)))
2064     rplist))
2065
2066 ;; Define some basic properties
2067 (defun xwem-frame-setup-root-win (frame)
2068   (let ((tl (xwem-frame-property frame 'title-layout))
2069         (th (xwem-frame-property frame 'title-height))
2070         (ibw (xwem-frame-property frame 'inner-border-width))
2071         (fw (xwem-frame-width frame))
2072         (fh (xwem-frame-height frame))
2073         (root-win (xwem-frame-rootwin frame))
2074         x y w h)
2075     (cond ((eq tl 'top)
2076            (setq x ibw
2077                  y (+ th ibw)
2078                  w (- fw ibw ibw)
2079                  h (- fh th ibw ibw)))
2080           ((eq tl 'bottom)
2081            (setq x ibw
2082                  y ibw
2083                  w (- fw ibw ibw)
2084                  h (- fh th ibw ibw)))
2085           ((eq tl 'left)
2086            (setq x (+ ibw th)
2087                  y ibw
2088                  w (- fw th ibw ibw)
2089                  h (- fh ibw ibw)))
2090           ((eq tl 'right)
2091            (setq x ibw
2092                  y ibw
2093                  w (- fw th ibw ibw)
2094                  h (- fh ibw ibw)))
2095
2096           ((eq tl 'none)
2097            (setq x ibw
2098                  y ibw
2099                  w (- fw ibw ibw)
2100                  h (- fh ibw ibw))))
2101     (setf (xwem-win-x root-win) x
2102           (xwem-win-y root-win) y)
2103     (xwem-win-set-width root-win w)
2104     (xwem-win-set-height root-win h)))
2105
2106 (defun xwem-frame-set-title-height (frame prop new-height)
2107   "Set FRAME's title height property PROP to NEW-HEIGHT."
2108   (let ((old-height (xwem-frame-property frame prop)))
2109     (xwem-frame-put-prop frame prop new-height)
2110
2111     ;; Adjust root window position/size
2112     (when (and new-height old-height (xwem-frame-rootwin frame))
2113       (incf (xwem-win-y (xwem-frame-rootwin frame))
2114             (- new-height old-height))
2115       (xwem-frame-setup-root-win frame))))
2116
2117 (defun xwem-frame-get-title-height (frame prop)
2118   "Return FRAME's title height."
2119   (or (xwem-frame-get-prop frame prop)
2120       0))
2121
2122 (define-xwem-frame-property title-height
2123   "Frame's title height in pixels."
2124   :type 'number
2125   :set 'xwem-frame-set-title-height
2126   :get 'xwem-frame-get-title-height)
2127
2128 (defcustom xwem-frame-default-title-layout 'top
2129   "*Default FRAME's title layout."
2130   :type '(choice (const :tag "No title" none)
2131                  (const :tag "Top" top)
2132                  (const :tag "Bottom" bottom)
2133                  (const :tag "Left" left)
2134                  (const :tag "Right" right))
2135   :group 'xwem-frame)
2136
2137 (defun xwem-frame-get-title-layout (frame prop)
2138   "Return FRAME's title layout."
2139   (or (xwem-frame-get-prop frame prop)
2140       xwem-frame-default-title-layout))
2141
2142 (defun xwem-frame-set-title-layout (frame prop new-layout)
2143   "Set FRAME's title layout property PROP to NEW-LAYOUT."
2144   (unless (memq new-layout '(left right top bottom none))
2145     (error 'xwem-error "Invalid title layout %S" new-layout))
2146
2147   (xwem-frame-put-prop frame prop new-layout)
2148   (xwem-frame-setup-root-win frame))
2149
2150 (define-xwem-frame-property title-layout
2151   "Frame's title layout property."
2152   :type '(choice (const :tag "Top" top)
2153                  (const :tag "Bottom" bottom)
2154                  (const :tag "Left" left)
2155                  (const :tag "Right" right))
2156   :get 'xwem-frame-get-title-layout
2157   :set 'xwem-frame-set-title-layout)
2158
2159 (defun xwem-frame-get-outer-border-width (frame prop)
2160   "Return FRAME's outer border width."
2161   (X-Geom-border-width (xwem-frame-xgeom  frame)))
2162
2163 (defun xwem-frame-set-outer-border-width (frame prop val)
2164   "Return FRAME's outer border width."
2165   (when (numberp val)
2166     (setf (X-Geom-border-width (xwem-frame-xgeom  frame)) val)
2167     (XSetWindowBorderWidth (xwem-dpy) (xwem-frame-xwin frame)
2168                            (X-Geom-border-width (xwem-frame-xgeom  frame)))))
2169
2170 (define-xwem-frame-property outer-border-width
2171   "Frame's outer border width in pixels."
2172   :type 'number
2173   :get 'xwem-frame-get-outer-border-width
2174   :set 'xwem-frame-set-outer-border-width)
2175
2176 (defun xwem-frame-set-outer-border-color (frame prop val)
2177   "Set FRAME's outer border color to VAL."
2178   (xwem-frame-put-prop frame prop val)
2179
2180   (when val
2181     (XSetWindowBorder (xwem-dpy) (xwem-frame-xwin frame)
2182                       (XAllocColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
2183                                    (xwem-make-color val)))))
2184
2185 (define-xwem-frame-property outer-border-color
2186   "Frame's outer border color."
2187   :type 'color
2188   :set 'xwem-frame-set-outer-border-color)
2189
2190 (defun xwem-frame-set-inner-border-width (frame prop val)
2191   "Set FRAME's inner border property PROP to VAL."
2192   (xwem-frame-put-prop frame prop val)
2193
2194   ;; Setup windows
2195   (when (xwem-frame-rootwin frame)
2196     (xwem-frame-setup-root-win frame)
2197     (xwem-deffered-funcall 'xwem-frame-draw frame t)))
2198
2199 (defun xwem-frame-get-inner-border-width (frame prop)
2200   (or (xwem-frame-get-prop frame 'inner-border-width)
2201       0))
2202
2203 (define-xwem-frame-property inner-border-width
2204   "Frame's inner border width in pixels."
2205   :type 'number
2206   :get 'xwem-frame-get-inner-border-width
2207   :set 'xwem-frame-set-inner-border-width)
2208
2209 (defun xwem-frame-set-inner-border-thickness (frame prop val)
2210   "Set FRAME's inner border width PROP to VAL."
2211   (when (and val (> (* val 2) (xwem-frame-property frame 'inner-border-width)))
2212     (error 'xwem-error "To large thickness to fill in title-height"))
2213
2214   (xwem-frame-put-prop frame prop val)
2215   (when val
2216     (xwem-deffered-funcall 'xwem-frame-draw frame nil)))
2217
2218 (define-xwem-frame-property inner-border-thickness
2219   "Frame's inner border thickness."
2220   :type 'number
2221   :set 'xwem-frame-set-inner-border-thickness)
2222
2223 (defun xwem-frame-set-background (frame prop val)
2224   "Set FRAME's background color to VAL."
2225   (xwem-frame-put-prop frame prop val)
2226
2227   (when val
2228     (XSetWindowBackground (xwem-dpy) (xwem-frame-xwin frame)
2229                           (XAllocColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
2230                                        (xwem-make-color val)))
2231     (xwem-deffered-funcall 'xwem-frame-draw frame t)))
2232
2233 (define-xwem-frame-property background
2234   "Frame's background color."
2235   :type 'color
2236   :set 'xwem-frame-set-background)
2237
2238 (defun xwem-frame-set-showing-mode (frame prop val)
2239   "Set FRAME's showing mode PROP to VAL."
2240   (xwem-frame-put-prop frame prop val)
2241   (if val
2242       (xwem-frame-enter-showing-mode frame)
2243     (xwem-frame-leave-showing-mode frame)))
2244
2245 (define-xwem-frame-property showing-mode
2246   "Frame's showing mode."
2247   :type 'boolean
2248   :set 'xwem-frame-set-showing-mode)
2249
2250 \f
2251 (provide 'xwem-frame)
2252
2253 ;;; xwem-frame.el ends here