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

   1 ;;; xwem-holer.el --- Making holes in xwem frames.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Thu Jan 15 12:39:04 MSK 2004
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-holer.el,v 1.7 2005-04-04 19:54:12 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; This XWEM addon allow you to create/manipulate holes in XWEM
  32 ;; frames.
  33 ;;
  34 ;; Add something following to your ~/.xwem/xwemrc.el to start using
  35 ;; holer:
  36 ;;
  37 ;;   (define-key xwem-global-map (xwem-kbd "H-x h") 'xwem-holer-prefix)
  38 ;;
  39 ;; Note: in xwem2.0-rc2 binded by default to `H-x h'
  40
  41 ;;; BUGS:
  42 ;;
  43 ;;  - You can create/manipulate holes only on selected frame.
  44
  45 ;;; Code:
  46 \f
  47 (require 'xlib-xshape)
  48
  49 (require 'xwem-load)
  50 (require 'xwem-compat)
  51 (require 'xwem-frame)
  52
  53 (defgroup xwem-holer nil
  54   "Group to customize xwem holer."
  55   :prefix "xwem-holer-"
  56   :group 'xwem)
  57
  58 (defcustom xwem-holer-outline-width 3
  59   "Width of outliner."
  60   :type 'number
  61   :group 'xwem-holer)
  62
  63 (defcustom xwem-holer-outline-color "blue2"
  64   "*Color of holer outliner."
  65   :type 'color
  66   :group 'xwem-holer)
  67
  68 (defcustom xwem-holer-move-cursor-shape 'X-XC-fleur
  69   "*Shape of cursor when moving holer."
  70   :type (xwem-cursor-shape-choice)
  71   :group 'xwem-holer)
  72
  73 (defcustom xwem-holer-move-cursor-foreground "#0000AA"
  74   "*Cursor's foreground when moving holer."
  75   :type 'color
  76   :group 'xwem-holer)
  77
  78 (defcustom xwem-holer-move-cursor-background "#000088"
  79   "*Cursor's background when moving holer."
  80   :type 'color
  81   :group 'xwem-holer)
  82
  83 (defcustom xwem-holer-resize-cursor-foreground "#0000AA"
  84   "*Cursor's foreground when resizing holer."
  85   :type 'color
  86   :group 'xwem-holer)
  87
  88 (defcustom xwem-holer-resize-cursor-background "#000088"
  89   "*Cursor's background when resizing holer."
  90   :type 'color
  91   :group 'xwem-holer)
  92
  93 (defcustom xwem-holer-min-pixels 10
  94   "*Minimum pixels to change holer geometry.
  95 Set it higher value to speed up moving/resizing."
  96   :type 'number
  97   :group 'xwem-holer)
  98
  99 ;;; Internal variables
 100
 101 \f
 102 ;;; Define holer prefix map
 103 ;;;###autoload(autoload 'xwem-holer-prefix "xwem-holer" nil nil 'keymap)
 104 (xwem-define-prefix-command 'xwem-holer-prefix t)
 105 (defvar xwem-holer-map (symbol-function 'xwem-holer-prefix)
 106   "Keymap for holer (\\<xwem-global-map>\\[xwem-holer-prefix]) commands.
 107 Bindings:
 108 \\{xwem-holer-map}")
 109
 110 (define-key xwem-holer-map [button1] 'xwem-holer-imove-or-create)
 111 (define-key xwem-holer-map [button2] 'xwem-holer-idestroy)
 112 (define-key xwem-holer-map [button3] 'xwem-holer-iresize)
 113 (define-key xwem-holer-map (xwem-kbd "h") 'xwem-holer-ihide)
 114 (define-key xwem-holer-map (xwem-kbd "s") 'xwem-holer-ishow)
 115 (define-key xwem-holer-map (xwem-kbd "d") 'xwem-holer-idestroy-all)
 116
 117 \f
 118 (defvar xwem-holers-list nil "List of all holers.")
 119
 120 (defstruct xwem-holer
 121   frame
 122   state                         ; 'shown or 'hidden
 123   x y width height
 124
 125   click-xoff click-yoff         ; offset within holer where click occured
 126
 127   outliner-win                  ;
 128   xmask xmask-gc xmask-bgc
 129
 130   mode                          ; nil, 'move, 'resize-bl,
 131                                 ; 'resize-br, 'resize-tl or
 132                                 ; 'resize-tr, 'hidden
 133
 134   ;; cursors
 135   move-cursor
 136   resize-bl-cursor resize-br-cursor
 137   resize-tl-cursor resize-tr-cursor
 138   )
 139
 140 (defmacro xwem-holer-xdpy (holer)
 141   "Return HOLER's display."
 142   `(X-Win-dpy (xwem-frame-xwin (xwem-holer-frame holer))))
 143
 144 (defsubst xwem-holer-add (holer)
 145   "Add HOLER to the `xwem-holers-list'."
 146   (pushnew holer xwem-holers-list))
 147
 148 (defsubst xwem-holer-del (holer)
 149   "Remove HOLER from `xwem-holers-list'."
 150   (setq xwem-holers-list (delete holer xwem-holers-list)))
 151
 152 (defsubst xwem-holer-find-by-frame (frame)
 153   "Find holer by FRAME.
 154 Return list of holers for FRAME."
 155   (let (holers)
 156     (mapc (lambda (h)
 157             (when (eq (xwem-holer-frame h) frame)
 158               (setq holers (cons h holers))))
 159           xwem-holers-list)
 160     holers))
 161
 162 \f
 163 (defun xwem-holer-clear (holer)
 164   "Clear HOLER's xmask."
 165   (let* ((xgeom (xwem-frame-xgeom (xwem-holer-frame holer)))
 166          (width (X-Geom-width xgeom))
 167          (height (X-Geom-height xgeom)))
 168     (XFillRectangle (xwem-holer-xdpy holer) (xwem-holer-xmask holer)
 169                     (xwem-holer-xmask-gc holer) 0 0 width height)))
 170
 171 (defun xwem-holer-show (holer)
 172   "Show holer on HOLER's frame."
 173   (setf (xwem-holer-state holer) 'shown)
 174   (XMapWindow (xwem-holer-xdpy holer) (xwem-holer-outliner-win holer))
 175   (xwem-holer-frame-redisplay (xwem-holer-frame holer)))
 176
 177 (defun xwem-holer-hide (holer)
 178   "Hide HOLER."
 179   (XUnmapWindow (xwem-holer-xdpy holer) (xwem-holer-outliner-win holer))
 180   (setf (xwem-holer-state holer) 'hidden)
 181   (xwem-holer-frame-redisplay (xwem-holer-frame holer)))
 182
 183 (define-xwem-deffered xwem-holer-frame-redisplay (frame)
 184   "Redisplay holes in FRAME."
 185   (let* ((xwin (xwem-frame-xwin frame))
 186          (xdpy (X-Win-dpy xwin)))
 187     (X-XShapeMask xdpy xwin X-XShape-Bounding X-XShapeSet 0 0 nil)
 188     (mapc (lambda (h)
 189             (when (eq (xwem-holer-state h) 'shown)
 190               (X-XShapeMask xdpy xwin
 191                             X-XShape-Bounding X-XShapeIntersect
 192                             0 0 (xwem-holer-xmask h))))
 193           (xwem-holer-find-by-frame frame))))
 194
 195 (defun xwem-holer-create (frame x y width height)
 196   "Create new holer for FRAME with geometry +X+Y+WIDTHxHEIGHT."
 197
 198   (let* ((holer (make-xwem-holer :frame frame
 199                                  :x x :y y
 200                                  :width width :height height))
 201          (xdpy (xwem-holer-xdpy holer))
 202          (xgeom (xwem-frame-xgeom frame)))
 203     (setf (xwem-holer-xmask holer)
 204           (XCreatePixmap xdpy
 205                          (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
 206                          (xwem-frame-xwin frame) 1
 207                          (X-Geom-width xgeom) (X-Geom-height xgeom)))
 208     (setf (xwem-holer-xmask-gc holer)
 209           (XCreateGC xdpy (xwem-holer-xmask holer)
 210                      (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
 211                                 :foreground 1.0
 212                                 :background 0.0)))
 213     (setf (xwem-holer-xmask-bgc holer)
 214           (XCreateGC xdpy (xwem-holer-xmask holer)
 215                      (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
 216                                 :foreground 0.0
 217                                 :background 1.0)))
 218
 219     (xwem-holer-clear holer)
 220     (XFillRectangle xdpy (xwem-holer-xmask holer)
 221                     (xwem-holer-xmask-bgc holer)
 222                     x y width height)
 223
 224     ;; Create cursors
 225     (setf (xwem-holer-move-cursor holer)
 226           (xwem-make-cursor (eval xwem-holer-move-cursor-shape)
 227                             xwem-holer-move-cursor-foreground
 228                             xwem-holer-move-cursor-background))
 229     (setf (xwem-holer-resize-bl-cursor holer)
 230           (xwem-make-cursor X-XC-bottom_left_corner
 231                             xwem-holer-resize-cursor-foreground
 232                             xwem-holer-resize-cursor-background))
 233     (setf (xwem-holer-resize-br-cursor holer)
 234           (xwem-make-cursor X-XC-bottom_right_corner
 235                             xwem-holer-resize-cursor-foreground
 236                             xwem-holer-resize-cursor-background))
 237     (setf (xwem-holer-resize-tl-cursor holer)
 238           (xwem-make-cursor X-XC-top_left_corner
 239                             xwem-holer-resize-cursor-foreground
 240                             xwem-holer-resize-cursor-background))
 241     (setf (xwem-holer-resize-tr-cursor holer)
 242           (xwem-make-cursor X-XC-top_right_corner
 243                             xwem-holer-resize-cursor-foreground
 244                             xwem-holer-resize-cursor-background))
 245
 246     ;; Outline holer
 247     (setf (xwem-holer-outliner-win holer)
 248           (XCreateWindow xdpy (xwem-frame-xwin frame)
 249                          (- x xwem-holer-outline-width)
 250                          (- y xwem-holer-outline-width)
 251                          width height xwem-holer-outline-width
 252                          nil nil nil
 253                          (make-X-Attr :override-redirect t
 254                                       :border-pixel
 255                                       (XAllocNamedColor
 256                                        xdpy (XDefaultColormap xdpy)
 257                                        xwem-holer-outline-color))))
 258     (X-Win-put-prop (xwem-holer-outliner-win holer) 'xwem-holer holer)
 259
 260     (xwem-holer-add holer)
 261     (xwem-holer-show holer)
 262     holer))
 263
 264 (defun xwem-holer-move (holer x y)
 265   "Move HOLER to X Y."
 266   (let ((xdpy (xwem-holer-xdpy holer)))
 267     (setf (xwem-holer-x holer) x)
 268     (setf (xwem-holer-y holer) y)
 269
 270     (xwem-holer-clear holer)
 271     (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer)
 272                     (xwem-holer-x holer) (xwem-holer-y holer)
 273                     (xwem-holer-width holer) (xwem-holer-height holer))
 274
 275     (XMoveWindow xdpy (xwem-holer-outliner-win holer)
 276                  (- x xwem-holer-outline-width)
 277                  (- y xwem-holer-outline-width))
 278     (xwem-holer-frame-redisplay (xwem-holer-frame holer))))
 279
 280 (defun xwem-holer-move-resize (holer x y width height)
 281   "Move and resize HOLER to X Y WIDTH HEIGHT geometry."
 282   (let ((xdpy (xwem-holer-xdpy holer)))
 283     (setf (xwem-holer-x holer) x)
 284     (setf (xwem-holer-y holer) y)
 285     (setf (xwem-holer-width holer) width)
 286     (setf (xwem-holer-height holer) height)
 287
 288     (xwem-holer-clear holer)
 289     (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer)
 290                     (xwem-holer-x holer) (xwem-holer-y holer)
 291                     (xwem-holer-width holer) (xwem-holer-height holer))
 292
 293     (XMoveResizeWindow xdpy (xwem-holer-outliner-win holer)
 294                        (- x xwem-holer-outline-width)
 295                        (- y xwem-holer-outline-width)
 296                        (xwem-holer-width holer)
 297                        (xwem-holer-height holer))
 298     (xwem-holer-frame-redisplay (xwem-holer-frame holer))))
 299
 300 (defun xwem-holer-destroy (holer)
 301   "Destroy HOLER."
 302   (let ((xdpy (xwem-holer-xdpy holer)))
 303     (xwem-holer-del holer)              ; remove from `xwem-holers-list'
 304
 305     (XFreePixmap xdpy (xwem-holer-xmask holer))
 306     (XFreeGC xdpy (xwem-holer-xmask-gc holer))
 307     (XFreeGC xdpy (xwem-holer-xmask-bgc holer))
 308
 309     ;; Finally destroy outliner window
 310     (X-Win-rem-prop (xwem-holer-outliner-win holer) 'xwem-holer)
 311     (XDestroyWindow xdpy (xwem-holer-outliner-win holer))
 312
 313     (xwem-holer-frame-redisplay (xwem-holer-frame holer))))
 314
 315 ;;; Subroutines using when resizing
 316 (defun xwem-holer-change-mode-to-opposite (holer &optional width-p)
 317   "Change HOLER's resize mode to opposite when resizing."
 318   (let ((ww '(resize-tr resize-br resize-tl resize-bl))
 319         (hh '(resize-bl resize-tl resize-br resize-tr))
 320         (c (memq (xwem-holer-mode holer)
 321                  '(resize-tl resize-bl resize-tr resize-br))))
 322     (when c
 323       (setf (xwem-holer-mode holer)
 324             (nth (- 4 (length c)) (if width-p ww hh))))))
 325
 326 (defun xwem-holer-calculate-new-geom (hl frx fry)
 327   "Return list '(x y width height) represented new geometry for holer HL."
 328   (let ((mode (xwem-holer-mode hl))
 329         x y w h)
 330     (cond ((eq mode 'resize-tl)
 331            (setq x frx
 332                  y fry
 333                  w (+ (- (xwem-holer-x hl) x) (xwem-holer-width hl))
 334                  h (+ (- (xwem-holer-y hl) y) (xwem-holer-height hl))))
 335           ((eq mode 'resize-bl)
 336            (setq x frx
 337                  y (xwem-holer-y hl)    ; didnt affected
 338                  h (- fry (xwem-holer-y hl))
 339                  w (+ (- (xwem-holer-x hl) x) (xwem-holer-width hl))))
 340           ((eq mode 'resize-tr)
 341            (setq x (xwem-holer-x hl)
 342                  y fry
 343                  w (- frx x)
 344                  h (+ (- (xwem-holer-y hl) y) (xwem-holer-height hl))))
 345           ((eq mode 'resize-br)
 346            (setq x (xwem-holer-x hl)
 347                  y (xwem-holer-y hl)
 348                  w (- frx (xwem-holer-x hl))
 349                  h (- fry (xwem-holer-y hl))))
 350           )
 351     (list x y w h)))
 352
 353 (defun xwem-holer-event-handler (xdpy win xev)
 354   "Handle events come from root window."
 355   (X-Event-CASE xev
 356     (:X-MotionNotify
 357      (let ((hl (X-Win-get-prop win 'xwem-holer))
 358            frxgeom frx fry)
 359        (when (xwem-holer-p hl)
 360          (setq frxgeom (xwem-frame-xgeom (xwem-holer-frame hl)))
 361          (setq frx (- (X-Event-xmotion-root-x xev) (X-Geom-x frxgeom)))
 362          (setq fry (- (X-Event-xmotion-root-y xev) (X-Geom-y frxgeom)))
 363          (cond ((eq (xwem-holer-mode hl) 'move)
 364                 ;; Translate root coordinates to frame coordinates.
 365                 ;; Using XTranslateCoordinates will slow down.
 366                 (let ((x (- frx (xwem-holer-click-xoff hl)))
 367                       (y (- fry (xwem-holer-click-yoff hl))))
 368                   (when (or (>= (abs (- x (xwem-holer-x hl)))
 369                                 xwem-holer-min-pixels)
 370                             (>= (abs (- y (xwem-holer-y hl)))
 371                                 xwem-holer-min-pixels))
 372                     (xwem-holer-move hl x y))))
 373
 374                ;; Interactively resize holer
 375                ((memq (xwem-holer-mode hl)
 376                       '(resize-bl resize-br resize-tl resize-tr))
 377                 ;; Calculate new geometry
 378                 (let* ((ngeom (xwem-holer-calculate-new-geom hl frx fry))
 379                        (x (nth 0 ngeom))
 380                        (y (nth 1 ngeom))
 381                        (w (nth 2 ngeom))
 382                        (h (nth 3 ngeom)))
 383
 384                   ;; When width or height is less then zero check is
 385                   ;; there need to change resize mode.
 386                   (when (or (< w 0) (< h 0))
 387                     (when (< w 0)
 388                       (xwem-holer-change-mode-to-opposite hl t))
 389                     (when (< h 0)
 390                       (xwem-holer-change-mode-to-opposite hl))
 391                     (setq ngeom (xwem-holer-calculate-new-geom hl frx fry)
 392                           x (nth 0 ngeom)
 393                           y (nth 1 ngeom)
 394                           w (nth 2 ngeom)
 395                           h (nth 3 ngeom)))
 396
 397                   (when (and x y (> w 0) (> h 0)
 398                              (or (>= (abs (- w (xwem-holer-width hl)))
 399                                      xwem-holer-min-pixels)
 400                                  (>= (abs (- h (xwem-holer-height hl)))
 401                                      xwem-holer-min-pixels)))
 402                     (xwem-holer-move-resize hl x y w h))))
 403                ))))
 404
 405     (:X-ButtonRelease
 406      (XUngrabPointer xdpy)
 407      (X-Win-EventHandler-rem (X-Event-xmotion-event xev)
 408                              'xwem-holer-event-handler)
 409      (let ((hl (X-Win-get-prop win 'xwem-holer)))
 410        (when (xwem-holer-p hl)
 411          (setf (xwem-holer-mode hl) nil))))
 412     ))
 413
 414 (defun xwem-holer-find-frame (xev)
 415   "Using ButtonPress XEV find out xwem frame."
 416   (let* ((srx (X-Event-xbutton-root-x xev))
 417          (sry (X-Event-xbutton-root-y xev))
 418          (frame (or (xwem-xwin-frame (X-Event-xbutton-child xev))
 419                     (xwem-frame-at srx sry t))))
 420     frame))
 421
 422 (defun xwem-holer-find-holer (xev)
 423   "Using ButtonPress XEV find out holer under pointer."
 424   (when (= (X-Event-type xev) X-ButtonPress)
 425     (let* ((xdpy (X-Event-dpy xev))
 426            (frame (xwem-holer-find-frame xev))
 427            (chw (and (xwem-frame-p frame)
 428                      (cdr (XTranslateCoordinates
 429                            xdpy (XDefaultRootWindow xdpy)
 430                            (xwem-frame-xwin frame)
 431                            (X-Event-xbutton-root-x xev)
 432                            (X-Event-xbutton-root-y xev)))))
 433            (hl (and (X-Win-p chw) (X-Win-get-prop chw 'xwem-holer))))
 434       (when (xwem-holer-p hl)
 435         (let ((tpnt (car (XTranslateCoordinates
 436                           xdpy (XDefaultRootWindow xdpy)
 437                           (xwem-holer-outliner-win hl)
 438                           (X-Event-xbutton-root-x xev)
 439                           (X-Event-xbutton-root-y xev)))))
 440           (setf (xwem-holer-click-xoff hl) (X-Point-x tpnt))
 441           (setf (xwem-holer-click-yoff hl) (X-Point-y tpnt))
 442           hl)))))
 443
 444 (define-xwem-command xwem-holer-imove ()
 445   "Move holer."
 446   (xwem-interactive "_")
 447
 448   (let* ((xev xwem-last-xevent)
 449          (hl (xwem-holer-find-holer xev)))
 450     (when (xwem-holer-p hl)
 451       (setf (xwem-holer-mode hl) 'move)
 452       (XGrabPointer (X-Event-dpy xev)
 453                     (xwem-holer-outliner-win hl)
 454                     (Xmask-or XM-ButtonPress
 455                               XM-ButtonRelease XM-ButtonMotion)
 456                     (xwem-holer-move-cursor hl))
 457       (X-Win-EventHandler-add-new (xwem-holer-outliner-win hl)
 458                                   'xwem-holer-event-handler))))
 459
 460 (define-xwem-command xwem-holer-imove-or-create ()
 461   "Move already existing holer or create new."
 462   (xwem-interactive "_")
 463
 464   (let* ((xev xwem-last-xevent)
 465          (hl (xwem-holer-find-holer xev)))
 466     (if (xwem-holer-p hl)
 467         (call-interactively 'xwem-holer-imove)
 468
 469       ;; Create new holer
 470       (let ((frame (xwem-holer-find-frame xev))
 471             frxgeom frx fry)
 472
 473         (when (xwem-frame-p frame)
 474           (setq frxgeom (xwem-frame-xgeom frame))
 475           (setq frx (- (X-Event-xmotion-root-x xev) (X-Geom-x frxgeom)))
 476           (setq fry (- (X-Event-xmotion-root-y xev) (X-Geom-y frxgeom)))
 477
 478           (xwem-holer-create frame (- frx 1) (- fry 1) 1 1)
 479           ;; After this resizing should appear in 'resize-br mode
 480           (call-interactively 'xwem-holer-iresize))))))
 481
 482 (define-xwem-command xwem-holer-iresize ()
 483   "Resize holer."
 484   (xwem-interactive "_")
 485
 486   (let* ((xev xwem-last-xevent)
 487          (hl (xwem-holer-find-holer xev)))
 488     (when (xwem-holer-p hl)
 489       (let ((cx (xwem-holer-click-xoff hl))
 490             (cy (xwem-holer-click-yoff hl))
 491             (hw (/ (xwem-holer-width hl) 2)) ; half of width
 492             (hh (/ (xwem-holer-height hl) 2)) ; half of height
 493             cursor)
 494         (cond ((and (> cx hw) (> cy hh))
 495                (setf (xwem-holer-mode hl) 'resize-br)
 496                (setq cursor (xwem-holer-resize-br-cursor hl)))
 497
 498               ((> cx hw)
 499                (setf (xwem-holer-mode hl) 'resize-tr)
 500                (setq cursor (xwem-holer-resize-tr-cursor hl)))
 501
 502               ((and (<= cx hw) (> cy hh))
 503                (setf (xwem-holer-mode hl) 'resize-bl)
 504                (setq cursor (xwem-holer-resize-bl-cursor hl)))
 505
 506               ((<= cx hw)
 507                (setf (xwem-holer-mode hl) 'resize-tl)
 508                (setq cursor (xwem-holer-resize-tl-cursor hl))))
 509
 510         (XGrabPointer (X-Event-dpy xev)
 511                       (xwem-holer-outliner-win hl)
 512                       (Xmask-or XM-ButtonPress
 513                                 XM-ButtonRelease XM-ButtonMotion)
 514                       cursor)
 515         (X-Win-EventHandler-add-new (xwem-holer-outliner-win hl)
 516                                     'xwem-holer-event-handler)
 517         (while (xwem-holer-mode hl)
 518           (dispatch-event (next-event)))
 519         ))))
 520
 521 (define-xwem-command xwem-holer-idestroy (ev)
 522   "Destroy holer."
 523   (xwem-interactive (list xwem-last-event))
 524
 525   (when (not (button-event-p ev))
 526     (error 'xwem-error "`xwem-holer-idestroy' must be bound to mouse event"))
 527
 528   (let* ((xev xwem-last-xevent)
 529          (hl (xwem-holer-find-holer xev)))
 530     (when (xwem-holer-p hl)
 531       (xwem-holer-destroy hl)
 532
 533       (xwem-message 'info "Holler at %dx%d destroyed."
 534                     (X-Event-xbutton-root-x xev)
 535                     (X-Event-xbutton-root-y xev)))))
 536
 537 (define-xwem-command xwem-holer-ihide (frame)
 538   "Hide all holers for FRAME.
 539 If FRAME is ommited - `xwem-frame-selected' assumed."
 540   (xwem-interactive (list (xwem-frame-selected)))
 541   (mapc 'xwem-holer-hide (xwem-holer-find-by-frame frame)))
 542
 543 (define-xwem-command xwem-holer-ishow (frame)
 544   "Show all holers for FRAME.
 545 If FRAME is ommited - `xwem-frame-selected' assumed."
 546   (xwem-interactive (list (xwem-frame-selected)))
 547   (mapc 'xwem-holer-show (xwem-holer-find-by-frame frame)))
 548
 549 (define-xwem-command xwem-holer-idestroy-all (frame)
 550   "Destroy all holers for FRAME."
 551   (xwem-interactive (list (xwem-frame-selected)))
 552   (mapc 'xwem-holer-destroy (xwem-holer-find-by-frame frame)))
 553
 554 \f
 555 (provide 'xwem-holer)
 556
 557 ;;; xwem-holer.el ends here