cgit.sxemacs.org Git - packages/blob - xemacs-packages/xlib/lisp/xlib-xshape.el

   1 ;;; xlib-xshape.el --- Shape extension support.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Mon Nov 17 19:23:03 MSK 2003
   7 ;; Keywords: xlib, xwem
   8 ;; X-CVS: $Id: xlib-xshape.el,v 1.6 2005-04-04 19:55:30 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 ;;
  32
  33 ;;; Code:
  34 \f
  35 (require 'xlib-xlib)
  36
  37 (defconst X-XShape-op-QueryVersion              0)
  38 (defconst X-XShape-op-Rectangles                1)
  39 (defconst X-XShape-op-Mask                      2)
  40 (defconst X-XShape-op-Combine                   3)
  41 (defconst X-XShape-op-Offset                    4)
  42 (defconst X-XShape-op-QueryExtents              5)
  43 (defconst X-XShape-op-SelectInput               6)
  44 (defconst X-XShape-op-InputSelected             7)
  45 (defconst X-XShape-op-GetRectangles             8)
  46
  47 ;; ops
  48 (defconst X-XShapeSet 0)
  49 (defconst X-XShapeUnion 1)
  50 (defconst X-XShapeIntersect 2)
  51 (defconst X-XShapeSubtract 3)
  52 (defconst X-XShapeInvert 4)
  53
  54 ;; kinds
  55 (defconst X-XShape-Bounding 0)
  56 (defconst X-XShape-Clip 1)
  57
  58 ;; events
  59 (defconst X-ShapeNotify 0)              ; actuallly (0 + extension event base)
  60
  61 (defun X-XShapeQueryVersion (xdpy)
  62   "On display XDPY query for version of Shape extension."
  63   (X-Dpy-p xdpy 'X-XRecordQueryVersion)
  64
  65   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
  66          (ListOfFields
  67           (list (vector 1 (nth 4 xrec-ext)) ; opcode
  68                 [1 X-XShape-op-QueryVersion]
  69                 [2 1]                   ; length
  70                 ))
  71          (msg (X-Create-message ListOfFields))
  72          (ReceiveFields
  73           (list [1 success]             ;success field
  74                 nil
  75                 (list [1 nil]           ;not used
  76                       [2 integerp]      ;sequence number
  77                       [4 nil]           ;length
  78                       [2 integerp]      ;major version
  79                       [2 integerp]      ;minor version
  80                       [20 nil]))))      ;pad
  81     (X-Dpy-send-read xdpy msg ReceiveFields)))
  82
  83 (defun X-XShapeRectangles (xdpy dest-win dest-kind op x-off y-off rectangles &optional ordering)
  84   "This request specifies an array of rectangles, relative to the
  85 origin of the window DEST-WIN plus the specified offset \\(X-OFF and
  86 y-OFF\\) that together define a region.  This region is combined \\(as
  87 specified by the operator OP\\) with the existing client region
  88 \\(specified by KIND\) of the destination window DEST-WIN, and the
  89 result is stored as the specified client region of the destination
  90 window.  Note that the list of rectangles can be empty, specifying an
  91 empty region; this is not the same as passing `X-None' to
  92 `X-XShapeMask'. If known by the client, ordering relations on the
  93 rectangles can be specified with the ordering argument.  This may
  94 provide faster operation by the server.  The meanings of the ordering
  95 values are the same as in the core protocol `XSetClipRectangles'
  96 request.  If an incorrect ordering is specified, the server may
  97 generate a Match error, but it is not required to do so.  If no error
  98 is generated, the graphics results are undefined. Except for
  99 `X-UnSorted', the rectangles should be nonintersecting, or the
 100 resulting region will be undefined.  `X-UnSorted' means that the
 101 rectangles are in arbitrary order.  `X-YSorted' means that the
 102 rectangles are nondecreasing in their Y origin.  `X-YXSorted'
 103 additionally constrains `X-YSorted' order in that all rectangles with
 104 an equal Y origin are nondecreasing in their X origin.  `X-YXBanded'
 105 additionally constrains `X-YXSorted' by requiring that, for every
 106 possible Y scanline, all rectangles that include that scanline have
 107 identical Y origins and Y extents."
 108   (X-Dpy-p xdpy 'X-XShapeRectangles)
 109   (X-Win-p dest-win 'X-XShapeRectangles)
 110
 111   (unless ordering
 112     (setq ordering X-UnSorted))
 113
 114   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 115          (ListOfFields
 116           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 117                 [1 X-XShape-op-Rectangles]
 118                 [2 (+ 4 (* 2 (length rectangles)))]
 119                 [1 op]                  ; operation
 120                 [1 dest-kind]           ; destination kind
 121                 [1 ordering]            ;
 122                 [1 nil]                 ; unused
 123                 [4 (X-Win-id dest-win)] ; destination window
 124                 [2 x-off]
 125                 [2 y-off]))
 126          (msg (concat (X-Create-message ListOfFields) (X-Generate-message-for-list rectangles 'X-Rect-message))))
 127     (X-Dpy-send xdpy msg)))
 128
 129 (defun X-XShapeMask (xdpy dest-win dest-kind op x-off y-off src)
 130   "The SRC in this request is a 1-bit deep pixmap, or `X-None'.  If
 131 SRC is `X-None', the specified client region is removed from the
 132 window, causing the effective region to revert to the default region.
 133 The `X-ShapeNotify' event generated by this request and subsequent
 134 ShapeQueryExtents will report that a client shape has not been
 135 specified.  If a valid pixmap is specified, it is converted to a
 136 region, with bits set to one included in the region and bits set to
 137 zero excluded, and an offset from the window origin as specified by
 138 X-OFF and Y-OFF.  The resulting region is then combined \\(as
 139 specified by the operator OP\\) with the existing client region
 140 \\(indicated by DEST-KIND\\) of the destination window, and the result
 141 is stored as the specified client region of the destination window.
 142 The source pixmap and destination window must have been created on the
 143 same screen, or else a Match error results."
 144   (X-Dpy-p xdpy 'X-XShapeMask)
 145   (X-Win-p dest-win 'X-XShapeMask)
 146
 147   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 148          (ListOfFields
 149           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 150                 [1 X-XShape-op-Mask]
 151                 [2 5]
 152                 [1 op]                  ; operation
 153                 [1 dest-kind]           ; destination kind
 154                 [2 nil]                 ; unused
 155                 [4 (X-Win-id dest-win)] ; destination window
 156                 [2 x-off]
 157                 [2 y-off]
 158                 [4 (if (X-Drawable-p src) (X-Drawable-id src) src)]))
 159          (msg (X-Create-message ListOfFields)))
 160     (X-Dpy-send xdpy msg)))
 161
 162 (defun X-XShapeCombine (xdpy dest-win dest-kind op x-off y-off src src-kind)
 163   "The client region, indicated by SRC-KIND, of the source window SRC
 164 is offset from the window DEST-WIN origin by X-OFF and Y-OFF and
 165 combined with the client region, indicated by DEST-KIND, of the
 166 destination window DEST-WIN.  The result is stored as the specified
 167 client region of the destination window.  The source and destination
 168 windows must be on the same screen, or else a Match error results."
 169   (X-Dpy-p xdpy 'X-XShapeCombine)
 170   (X-Drawable-p dest-win 'X-XShapeCombine)
 171   (X-Drawable-p src 'X-XShapeCombine)
 172
 173   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 174          (ListOfFields
 175           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 176                 [1 X-XShape-op-Combine]
 177                 [2 5]
 178                 [1 op]                  ; operation
 179                 [1 dest-kind]           ; destination kind
 180                 [1 src-kind]
 181                 [1 nil]                 ; unused
 182                 [4 (X-Win-id dest-win)] ; destination window
 183                 [2 x-off]
 184                 [2 y-off]
 185                 [4 (X-Drawable-id src)]))
 186          (msg (X-Create-message ListOfFields)))
 187     (X-Dpy-send xdpy msg)))
 188
 189 (defun X-XShapeOffset (xdpy dest-win dest-kind x-off y-off)
 190   "The client region, indicated by DEST-KIND, is moved relative
 191 to its current position by the amounts X-OFF and Y-OFF."
 192   (X-Dpy-p xdpy 'X-XShapeOffset)
 193   (X-Win-p dest-win 'X-XShapeOffset)
 194
 195   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 196          (ListOfFields
 197           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 198                 [1 X-XShape-op-Offset]
 199                 [2 4]
 200                 [1 dest-kind]           ; destination kind
 201                 [3 nil]                 ; unused
 202                 [4 (X-Win-id dest-win)] ; destination window
 203                 [2 x-off]
 204                 [2 y-off]))
 205          (msg (X-Create-message ListOfFields)))
 206     (X-Dpy-send xdpy msg)))
 207
 208 (defun X-XShapeQueryExtents (xdpy dest-win)
 209   "The boundingShaped and clipShaped results are True if the
 210 corresponding client regions have been specified, else they
 211 are False.  The x, y, width, and height values define the
 212 extents of the client regions, when a client region has not
 213 been specified, the extents of the corresponding default
 214 region are reported."
 215   (X-Dpy-p xdpy 'X-XShapeQueryExtents)
 216
 217   )
 218
 219 (defun X-XShapeSelectInput (xdpy dest-win enable)
 220   "Specifying enable as T causes the server to send the requesting
 221 client a `X-ShapeNotify' event whenever the bounding or clip region of
 222 the specified window is altered by any client.  Specifying enable as
 223 NIL causes the server to stop sending such events."
 224   (X-Dpy-p xdpy 'X-XShapeSelectInput)
 225   (X-Win-p dest-win 'X-XShapeSelectInput)
 226
 227   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 228          (ListOfFields
 229           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 230                 [1 X-XShape-op-SelectInput]
 231                 [2 3]
 232                 [4 (X-Win-id dest-win)] ; destination window
 233                 [1 enable]
 234                 [3 nil]))
 235          (msg (X-Create-message ListOfFields)))
 236     (X-Dpy-send xdpy msg)))
 237
 238 (defun X-XShapeInputSelected (xdpy dest-win)
 239   "Return non-nil if on display XDPY DEST-WIN is enabled to receive
 240 `X-ShapeNotify' events."
 241   (X-Dpy-p xdpy 'X-XShapeInputSelected)
 242   (X-Win-p dest-win 'X-XShapeInputSelected)
 243
 244   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 245          (ListOfFields
 246           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 247                 [1 X-XShape-op-InputSelected]
 248                 [2 2]                   ; length
 249                 [4 (X-Win-id dest-win)]))
 250          (msg (X-Create-message ListOfFields))
 251          (ReceiveFields
 252           (list [1 success]             ;success field
 253                 nil
 254                 (list [1 booleanp]      ; enabled
 255                       [2 integerp]      ; sequence number
 256                       [4 nil]           ; length
 257                       [24 nil])))       ;pad
 258          (r (X-Dpy-send-read xdpy msg ReceiveFields)))
 259     (and (car r) (nth 1 r))))
 260
 261 (defun X-XShapeGetRectangles (xdpy dest-win dest-kind)
 262   "A list of rectangles describing the region indicated by DEST-KIND,
 263 and the ordering of those rectangles, is returned.  The meaning of the
 264 ordering values is the same as in the `X-XShapeRectangles' request."
 265   (X-Dpy-p xdpy 'X-XShapeInputSelected)
 266   (X-Win-p dest-win 'X-XShapeInputSelected)
 267
 268   (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
 269          (ListOfFields
 270           (list (vector 1 (nth 4 xrec-ext)) ; opcode
 271                 [1 X-XShape-op-GetRectangles]
 272                 [2 3]                   ; length
 273                 [4 (X-Win-id dest-win)]
 274                 [1 dest-kind]
 275                 [3 nil]))
 276          (msg (X-Create-message ListOfFields))
 277          (ReceiveFields
 278           (list [1 success]             ;success field
 279                 nil
 280                 (list [1 integerp]      ; ordering
 281                       [2 integerp]      ; sequence number
 282                       [4 length-1]      ; length
 283                       [20 nil]
 284                       [length-1
 285                        ([2 integerp]
 286                         [2 integerp]
 287                         [2 integerp]
 288                         [2 integerp])]))))
 289
 290     ;; TODO: maybe convert to X-Rect ?
 291     (X-Dpy-send-read xdpy msg ReceiveFields)))
 292
 293 (provide 'xlib-xshape)
 294
 295 ;;; xlib-xshape.el ends here