Source

xwem / lisp / xwem-struct.el

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
;;; xwem-struct.el --- Core XWEM structures.

;; Copyright (C) 2004,2005 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Tue Aug 24 12:43:45 MSD 2004
;; Keywords: xwem
;; X-CVS: $Id$

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; 

;;; Code:

(require 'xlib-xc)

(eval-when-compile
  ;; Shut up compiler
  (defvar xwem-current-cl)
  (defvar xwem-last-cl)
  (defvar xwem-frames-list)
  (defvar xwem-clients)
  (defvar xwem-client-ev-mask))

(define-error 'xwem-error "XWEM error")


;;;; Root window
(defvar xwem-root-display nil
  "Default X Display for XWEM.
Use `xwem-dpy' to get it.")
(defvar xwem-root-window nil
  "Default root window of `xwem-dpy'.")
(defvar xwem-root-geometry nil
  "Geometry of `xwem-rootwin'.")

;;;###xwem-autoload
(defmacro xwem-dpy ()
  "Return default X display for XWEM."
  'xwem-root-display)
;;;###xwem-autoload
(defmacro xwem-rootwin ()
  "Return default root window of `xwem-dpy'."
  'xwem-root-window)
;;;###xwem-autoload
(defmacro xwem-rootgeom ()
  'xwem-root-geometry)

(defsetf xwem-dpy () (xdpy)
  "Set default X display for XWEM."
  `(progn
     (setq xwem-root-display ,xdpy)
     (unless (X-Dpy-p (xwem-dpy))
       (error 'xwem-error "Can't open display"))
     (setq xwem-root-window (XDefaultRootWindow (xwem-dpy)))
     (setq xwem-root-geometry (XGetGeometry (xwem-dpy) (xwem-rootwin)))))

;;;; Frame structures
(defstruct xwem-frame
  type                                  ; frame type (desktop, embedded, dedicated, embedded-desktop, etc)
  xwin                                  ; X window 
  xgeom                                 ; frame geometry
  (name "default")                      ; frame name
  rootwin                               ; XWEM's root window for frame
  selwin                                ; XWEM's selected window
  link-next                             ; Link to next xwem's frame in linkage
  link-prev                             ; Link to prev xwem's frame in linkage
  state                                 ; 'mapped, 'unmapped, 'destroyed

  plist)                                ; User defined plist

(defstruct xwem-frame-saved
  frame                                 ; nil or `xwem-frame'
  selected-p                            ; non-nil if frame was selected
  type
  name
  xgeom
  state                                 ; 
  plist                                 ; as in xwem-frame
  winconfig)

(defsubst xwem-frame-get-prop (frame prop)
  (plist-get (xwem-frame-plist frame) prop))

(defsubst xwem-frame-rem-prop (frame prop)
  "From FRAME's plist remove property PROP."
  (setf (xwem-frame-plist frame)
        (plist-remprop (xwem-frame-plist frame) prop)))

(defsubst xwem-frame-put-prop (frame prop val)
  "Put PROP with VAL to FRAME's properties list."
  (if prop
      (setf (xwem-frame-plist frame)
            (plist-put (xwem-frame-plist frame) prop val))
    (xwem-frame-rem-prop frame prop)))
(put 'xwem-frame-put-prop 'lisp-indent-function 2)

(defvar xwem-current-frame nil
  "Currently selected frame.
Do not access/modify this variable directly, use `xwem-frame-selected'.")

(defmacro xwem-frame-selected ()
  "Return selected frame."
  'xwem-current-frame)
(defsetf xwem-frame-selected () (frame)
  `(setq xwem-current-frame ,frame))

(defsubst xwem-frame-selected-p (frame)
  "Return non-nil if FRAME is selected."
  (eq frame (xwem-frame-selected)))

(defsubst xwem-frame-desktop-p (frame)
  "Return non-nil if FRAME is desktop."
  (memq (xwem-frame-type frame)
        '(desktop embedded-desktop)))

(defsubst xwem-frame-embedded-p (frame)
  "Return non-nil if FRAME is embedded frame."
  (memq (xwem-frame-type frame)
        '(embedded embedded-desktop)))

(defsubst xwem-frame-dedicated-p (frame)
  "Return non-nil if FRAME is dedicated frame."
  (memq (xwem-frame-type frame)
        '(dedicated)))

(defmacro xwem-frame-x (frame)
  `(X-Geom-x (xwem-frame-xgeom ,frame)))
(defsetf xwem-frame-x (frame) (x)
  `(setf (X-Geom-x (xwem-frame-xgeom ,frame)) ,x))

(defmacro xwem-frame-y (frame)
  `(X-Geom-y (xwem-frame-xgeom ,frame)))
(defsetf xwem-frame-y (frame) (y)
  `(setf (X-Geom-y (xwem-frame-xgeom ,frame)) ,y))

(defmacro xwem-frame-width (frame)
  `(X-Geom-width (xwem-frame-xgeom ,frame)))
(defsetf xwem-frame-width (frame) (width)
  `(setf (X-Geom-width (xwem-frame-xgeom ,frame)) ,width))

(defmacro xwem-frame-height (frame)
  `(X-Geom-height (xwem-frame-xgeom ,frame)))
(defsetf xwem-frame-height (frame) (height)
  `(setf (X-Geom-height (xwem-frame-xgeom ,frame)) ,height))

(defmacro xwem-frame-border-width (frame)
  `(X-Geom-border-width (xwem-frame-xgeom ,frame)))
(defsetf xwem-frame-border-width (frame) (height)
  `(setf (X-Geom-border-width (xwem-frame-xgeom ,frame)) ,height))

(defmacro xwem-frame-title-height (frame)
  "Return FRAME's title height."
  `(xwem-frame-property ,frame 'title-height))
(defsetf xwem-frame-title-height (frame) (new-title-height)
  "Set FRAME's title height to NEW-TITLE-HEIGHT."
  `(xwem-frame-set-property ,frame 'title-height ,new-title-height))

(defmacro xwem-frame-inner-border-width (frame)
  "Return FRAME's inner border width."
  `(xwem-frame-property ,frame 'inner-border-width))
(defsetf xwem-frame-inner-border-width (frame) (new-inner-border-width)
  "Set FRAME's inner border width to be NEW-INNER-BORDER-WIDTH."
  `(xwem-frame-set-property ,frame 'inner-border-width ,new-inner-border-width))

(defsubst xwem-frame-alive-p (frame)
  "Return non-nil if FRAME is alive XWEM frame."
  (and (xwem-frame-p frame)
       (memq frame xwem-frames-list)
       (not (eq (xwem-frame-type frame) 'destroyed))))

(defsubst xwem-frame-mapped-p (frame)
  "Return non-nil if xwem FRAME is mapped."
  (and (xwem-frame-p frame)
       (eq (xwem-frame-state frame) 'mapped)))

(defsubst xwem-frame-cl (frame)
  "Return currently active xwem client in FRAME."
  (xwem-win-cl (xwem-frame-selwin frame)))


;;;; Win structures
(defstruct xwem-win
  id                                    ; unique window id
  geom                                  ; window geometry (border width is internal window width)
  clients                               ; xwem clients list managed in window
  cl                                    ; Current window's client
  frame                                 ; xwem frame
  dead                                  ; non-nil if window is dead
  deleted                               ; non-nil if window was deleted
  next                                  ; next window in windows chain
  prev                                  ; previous window in windows chain
  hchild                                ; horisontal child (if any)
  vchild                                ; vertical child (if any)
  parent                                ; parent window
  
  plist)                                ; User defined plist

(defstruct (xwem-win-saved (:predicate xwem-iswinsaved-p))
  id                                    ; saved window id
  geom                                  ; saved window geometry
  clients                               ; clients managed in window
  cl                                    ; Current window's client
  plist                                 ; properties
  selwin-p                              ; non-nil if window is selected in frame
  first-hchild first-vchild
  next prev)

(defstruct (xwem-win-config (:predicate xwem-iswinconfig-p))
  frame                                 ; window's frame
  frame-xgeom                           ; saved frame X-Geom
  frame-properties                      ; saved frame properties
  current-cl                            ; cl in selected window
  min-width min-height
  saved-root-window)

(defsubst xwem-win-alive-p (window)
  "Return non-nil if WINDOW is alive."
  (and (xwem-win-p window)
       (xwem-frame-alive-p (xwem-win-frame window))
       (not (xwem-win-deleted window))
       (not (xwem-win-dead window))))

(defmacro xwem-win-x (win)
  `(X-Geom-x (xwem-win-geom ,win)))
(defsetf xwem-win-x (win) (x)
  `(setf (X-Geom-x (xwem-win-geom ,win)) ,x))

(defmacro xwem-win-y (win)
  `(X-Geom-y (xwem-win-geom ,win)))
(defsetf xwem-win-y (win) (y)
  `(setf (X-Geom-y (xwem-win-geom ,win)) ,y))

(defmacro xwem-win-width (win)
  `(X-Geom-width (xwem-win-geom ,win)))
(defsetf xwem-win-width (win) (width)
  `(setf (X-Geom-width (xwem-win-geom ,win)) ,width))

(defmacro xwem-win-height (win)
  `(X-Geom-height (xwem-win-geom ,win)))
(defsetf xwem-win-height (win) (height)
  `(setf (X-Geom-height (xwem-win-geom ,win)) ,height))

(defmacro xwem-win-border-width (win)
  `(X-Geom-border-width (xwem-win-geom ,win)))
(defsetf xwem-win-border-width (win) (border-width)
  `(setf (X-Geom-border-width (xwem-win-geom ,win)) ,border-width))

(defsubst xwem-win-get-prop (win prop)
  "Get WIN's property PROP."
  (plist-get (xwem-win-plist win) prop))

(defsubst xwem-win-rem-prop (win prop)
  "Remove WIN's property PROP."
  (setf (xwem-win-plist win)
        (plist-remprop (xwem-win-plist win) prop)))

(defsubst xwem-win-put-prop (win prop val)
  "Set WIN's property PROP to VAL."
  (if val
      (setf (xwem-win-plist win)
            (plist-put (xwem-win-plist win) prop val))
    (xwem-win-rem-prop win prop)))
(put 'xwem-win-put-prop 'lisp-indent-function 2)

(defmacro xwem-win-selected ()
  "Return selected window."
  '(and (xwem-frame-alive-p (xwem-frame-selected))
        (xwem-frame-selwin (xwem-frame-selected))))

(defmacro xwem-win-selected-p (win)
  "Return non-nil if WIN is currently selected window."
  `(eq ,win (xwem-win-selected)))

(defsubst xwem-win-selwin-p (win)
  "Return non-nil if WIN is localy selected window in WIN's frame."
  (and (xwem-win-p win)
       (eq win (xwem-frame-selwin (xwem-win-frame win)))))

(defsubst xwem-win-cl-current-p (cl &optional win)
  "Return non-nil if CL is current WIN's client."
  (unless win
    (setq win (xwem-cl-win cl)))
  (when (xwem-win-p win)
    (eq cl (xwem-win-cl win))))


;;;; Client structures
(defstruct xwem-hints
  ;; TODO: add more
  wm-normal-hints
  wm-hints
  wm-class
  wm-command
  wm-name
  wm-icon-name
  wm-transient-for
  wm-protocols)

(defstruct xwem-cl
  xwin                                  ; CL's X window
  (ev-mask 0)                           ; CL's event maks
  initial-xattrs                        ; X-Attr when CL just initialized
  initial-xgeom                         ; X-Geom when CL just initialized

  xgeom                                 ; Current CL's X-Geom
  new-xgeom                             ; Wishable CL's X-Geom (for refiting)

  hints                                 ; xwem-hints
  transient-for                         ; non-nil if client is transient for window

  manage-spec                           ; MANAGE-SPEC which was used to manage client.
  win                                   ; xwem-win now (only for windowing manage types)
  translist                             ; list of transient-for windows for this client

  (state 'unknown)                      ; state of client, 'active, 'inactive, 'iconified, 'unknown, etc
  start-time                            ; start-time
  recency                               ; last time when CL was active

  local-variables                       ; client local variables list
  sys-plist                             ; system plist
  plist                                 ; user defined plist
  )

(defmacro xwem-cl-destroyed-p (cl)
  "Return non-nil if CL has already destroyed xwin."
  `(eq (xwem-cl-state ,cl) 'destroyed))

(defmacro xwem-cl-win-geom (cl)
  "Get geometry for client CL. Actually return xwem window geometry."
  `(xwem-win-geom (xwem-cl-win ,cl)))

;; User plist
(defsubst xwem-cl-get-prop (cl prop)
  "From CL's property list get property PROP."
  (plist-get (xwem-cl-plist cl) prop))

(defsubst xwem-cl-rem-prop (cl prop)
  "From CL's property list remove property PROP."
  (setf (xwem-cl-plist cl) (plist-remprop (xwem-cl-plist cl) prop)))

(defsubst xwem-cl-put-prop (cl prop val)
  "In CL's property list put property PROP with value VAL.
If VAL is nil - remove property."
  (if val
      (setf (xwem-cl-plist cl) (plist-put (xwem-cl-plist cl) prop val))
    (xwem-cl-rem-prop cl prop)))
(put 'xwem-cl-put-prop 'lisp-indent-function 2)

;; System plist
(defsubst xwem-cl-get-sys-prop (cl prop)
  "From CL's system property list get property PROP."
  (plist-get (xwem-cl-sys-plist cl) prop))

(defsubst xwem-cl-rem-sys-prop (cl prop)
  "From CL's system property list remove property PROP."
  (setf (xwem-cl-sys-plist cl) (plist-remprop (xwem-cl-sys-plist cl) prop)))

(defsubst xwem-cl-put-sys-prop (cl prop val)
  "In CL's system property list put property PROP with value VAL.
If VAL is nil - remove property."
  (if val
      (setf (xwem-cl-sys-plist cl) (plist-put (xwem-cl-sys-plist cl) prop val))
    (xwem-cl-rem-sys-prop cl val)))
(put 'xwem-cl-put-sys-prop 'lisp-indent-function 2)

(defmacro xwem-cl-manage-type (cl)
  "Return CL's manage type name."
  `(car (xwem-cl-manage-spec ,cl)))
(defsetf xwem-cl-manage-type (cl) (new-type)
  `(setf (xwem-cl-manage-spec ,cl) (list ,new-type)))
  
(defmacro xwem-cl-selected ()
  "Return currently selected Client.
May be nil if no current client."
  'xwem-current-cl)
(defsetf xwem-cl-selected () (cl)
  `(setq xwem-current-cl ,cl))

(defmacro xwem-last-client ()
  "Return last selected client."
  'xwem-last-cl)
(defsetf xwem-last-client () (cl)
  `(setq xwem-last-cl ,cl))

(defsubst xwem-cl-selected-p (cl)
  "Return non-nil if CL is selected client.
If CL is not valid `xwem-cl' structure, nill will be returned."
  (and (xwem-cl-p cl) (eq cl (xwem-cl-selected))))

(defsubst xwem-cl-frame (cl)
  "Return frame where CL."
  (let ((win (xwem-cl-win cl)))
    (and (xwem-win-p win) (xwem-win-frame win))))

(defsubst xwem-cl-alive-p (cl)
  "Return non-nil if CL is alive i.e. not in 'destroyed state."
  (and (xwem-cl-p cl) (not (eq (xwem-cl-state cl) 'destroyed))))

(defsubst xwem-cl-managed-p (cl &optional states)
  "Return non-nil if CL ins't in withdrawn state."
  (and (xwem-cl-p cl)
       (memq (xwem-cl-state cl) (or states '(active inactive iconified)))))

(defsubst xwem-cl-active-p (cl)
  "Return non-nil if CL is in active state."
  (eq (xwem-cl-state cl) 'active))

;; wm accessors
(defsubst xwem-cl-wm-name (cl)
  "Return cl's WM_NAME."
  (xwem-hints-wm-name (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-name (cl) (name)
  "Set CL's WM_NAME to NAME."
  `(setf (xwem-hints-wm-name (xwem-cl-hints ,cl)) ,name))

(defsubst xwem-cl-wm-icon-name (cl)
  "Return cl's WM_ICON_NAME."
  (xwem-hints-wm-icon-name (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-icon-name (cl) (icon-name)
  "Set CL's WM_ICON_NAME to ICON-NAME."
  `(setf (xwem-hints-wm-icon-name (xwem-cl-hints ,cl)) ,icon-name))

(defsubst xwem-cl-wm-hints (cl)
  "Return cl's WM_HINTS."
  (xwem-hints-wm-hints (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-hints (cl) (hints)
  "Set CL's WM_HINTS to HINTS."
  `(setf (xwem-hints-wm-hints (xwem-cl-hints ,cl)) ,hints))

(defsubst xwem-cl-wm-normal-hints (cl)
  "Return cl's WM_NORMAL_HINTS."
  (xwem-hints-wm-normal-hints (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-normal-hints (cl) (wnh)
  "Set CL's WM_NORMAL_HINTS to WNH."
  `(setf (xwem-hints-wm-normal-hints (xwem-cl-hints ,cl)) ,wnh))

(defsubst xwem-cl-wm-class (cl)
  "Return cl's WM_CLASS."
  (xwem-hints-wm-class (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-class (cl) (class)
  "Set CL's WM_CLASS to CLASS."
  `(setf (xwem-hints-wm-class (xwem-cl-hints ,cl)) ,class))

(defsubst xwem-cl-wm-command (cl)
  "Return cl's WM_COMMAND."
  (xwem-hints-wm-command (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-command (cl) (command)
  "Set CL's WM_COMMAND to COMMAND."
  `(setf (xwem-hints-wm-command (xwem-cl-hints ,cl)) ,command))

(defsubst xwem-cl-wm-transient-for (cl)
  "Return cl's WM_TRANSIENT_FOR."
  (xwem-hints-wm-command (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-transient-for (cl) (wtf)
  "Set CL's WM_TRANSIENT_FOR to WTF."
  `(setf (xwem-hints-wm-transient-for (xwem-cl-hints ,cl)) ,wtf))

(defsubst xwem-cl-wm-protocols (cl)
  "Return cl's WM_PROTOCOLS."
  (xwem-hints-wm-command (xwem-cl-hints cl)))
(defsetf xwem-cl-wm-protocols (cl) (protocols)
  "Set CL's WM_PROTOCOLS to PROTOCOLS."
  `(setf (xwem-hints-wm-protocols (xwem-cl-hints ,cl)) ,protocols))


;;;; Minibuffer
(defstruct xwem-minib
  frame                                 ; Emacs frame
  cl                                    ; Corresponding xwem client

  xgeom                                 ; parent geometry
  xwin                                  ; parent xwindow

  plist                                 ; User defined plist
  )

(defmacro xwem-minib-get-prop (m prop)
  `(plist-get (xwem-minib-plist ,m) ,prop))

(defmacro xwem-minib-put-prop (m prop val)
  `(setf (xwem-minib-plist ,m)
         (plist-put (xwem-minib-plist ,m) ,prop ,val)))
(put 'xwem-minib-put-prop 'lisp-indent-function 2)

(defmacro xwem-minib-rem-prop (m prop)
  `(setf (xwem-minib-plist ,m)
         (plist-remprop (xwem-minib-plist ,m) ,prop)))

(defmacro xwem-minib-cl-xgeom (m)
  "Return client's X geometry of minibuffer M."
  `(xwem-cl-xgeom (xwem-minib-cl ,m)))
(defsetf xwem-minib-cl-xgeom (m) (xgeom)
  `(setf (xwem-cl-xgeom (xwem-minib-cl ,m)) ,xgeom))

(defmacro xwem-minib-cl-xwin (m)
  "Return clien's X window of minibuffe M."
  `(xwem-cl-xwin (xwem-minib-cl ,m)))
(defsetf xwem-minib-cl-xwin (m) (xwin)
  `(setf (xwem-cl-xwin (xwem-minib-cl ,m)) ,xwin))


;;; Various macros

;; Defining deffered funcalls
;;; Deffering related stuff
(require 'dll)

(defvar xwem-pre-deffering-hook nil
  "*Hooks to run before deffering.")
(defvar xwem-post-deffering-hook nil
  "*Hooks to run after deffering complete.
`xwem-post-deffering-hook' clears every time it runs.")

(defvar xwem-deffered-dll (dll-create)
  "Double linked list of deffered things.")

(defvar xwem-deffering-p nil
  "Non-nil mean we are running deffered function.")

(defun xwem-deffered-push (fun &rest args)
  (let*  ((dummy (dll-get-dummy-node xwem-deffered-dll))
          (node  (elib-node-right dummy))
          (exists nil))
    (while (and (not (eq node dummy))
                (not (and (funcall
                           #'(lambda (e1 e2)
                               (and (eq (car e1) (car e2))
                                    (if (and (listp (cdr e1)) (listp (cdr e2))
                                             (= (length (cdr e1))
                                                (length (cdr e2))))
                                        (not (memq nil (mapcar*
                                                        'eq (cdr e1) (cdr e2))))
                                      (eq (cdr e1) (cdr e2)))))
                           (cons fun args)
                           (dll-element xwem-deffered-dll node))
                          (setq exists t))))
      (setq node (elib-node-right node)))

    (if exists
        (dll-delete xwem-deffered-dll node)
      (enqueue-eval-event 'xwem-deffered-process nil))

    (xwem-debug 'xwem-deffered "---------> IN %S" 'fun)
    (dll-enter-last xwem-deffered-dll (cons fun args))))

(defun xwem-deffered-process (obj-notused)
  "Process deffering commands."
  (declare (special xwem-deffering-p))

  (unless xwem-deffering-p
    (let ((xwem-deffering-p t))
      (run-hooks 'xwem-pre-deffering-hook)
      (setq xwem-pre-deffering-hook nil)))

  (while (not (dll-empty xwem-deffered-dll))
    (let ((el (dll-first xwem-deffered-dll))
          (xwem-deffering-p t))
      (xwem-debug 'xwem-deffered "<--------- OUT %S" '(car el))
      (dll-delete-first xwem-deffered-dll)
      (apply (car el) (cdr el))))

  (unless xwem-deffering-p
    (let ((xwem-deffering-p t))
      (run-hooks 'xwem-post-deffering-hook)
      (setq xwem-post-deffering-hook nil))))

(defun xwem-add-hook-post-deffering (hook &optional append)
  "Add HOOK to `xwem-post-deffering-hook'."
  (add-hook 'xwem-post-deffering-hook hook append)
  ;; Run it to be sure to enter deffering
  (xwem-deffered-push 'ignore))

;; Dont know where to put this macro, so putten here.
(defmacro define-xwem-deffered
  (deff-name normal-name arglist docstring &rest body)
  "Define new deffered function with function name DEFF-NAME.
Deffered function is function which is called when XEmacs is about to became idle.

Another advantage of deffered function is that only one instance of
function will be called with same arguments.  For example if you have
`my-defffun' deffered function and you call twice `(my-defffun 1)',
`(my-defffun 1)' - then when XEmacs will be about idle only one call
occurs to `my-defffun'.  However if you pass different arguments, all
calls with different arguments are called.  Arguments are equal if
they are either `eq' or both are lists, where each element is `eq'.

NAME, ARGLIST, DOCSTRING and BODY argument have same meaning as for `defun'.
If NORMAL-NAME is specified, also define non-deffered variant of DEFF-NAME function.
If NORMAL-NAME is ommited, then normal-name constructed by
concatination of DEFF-NAME and \"-1\"."
  (unless (and (not (null normal-name))
               (symbolp normal-name))
    ;; If NORMAL-NAME ommited
    (setq body (cons docstring body))
    (setq docstring arglist)
    (setq arglist normal-name)
    (setq normal-name (intern (concat (symbol-name deff-name) "-1"))))

  `(progn
     (defun ,normal-name ,arglist
       ,docstring
       ,@body)

     (defun ,deff-name (&rest args)
       ,(concat "Deffered variant of `" (symbol-name normal-name) "'.")
       (apply (quote xwem-deffered-push) (quote ,normal-name) args))))

(defmacro xwem-deffered-funcall (fun &rest args)
  "Call FUN with ARGS, deffering funcall to FUN."
  `(xwem-deffered-push ,fun ,@args))

(defmacro xwem-unwind-protect (body-form &rest unwind-forms)
  "Execute BODY-FORM protecting it in safe more with UNWIND-FORMS.
`xwem-unwind-protect' differs from `unwind-protect' that
`xwem-unwind-protect' executes UNWIND-FORMS even when debugging."
  `(prog1
    (condition-case xwem-unwind-error
        ,body-form
      (t ,@unwind-forms
         (apply 'error (car xwem-unwind-error) (cdr xwem-unwind-error))))
    ,@unwind-forms))
(put 'xwem-unwind-protect 'lisp-indent-function 1)

(defmacro xwem-overriding-local-map (nlm &rest forms)
  "Execute FORMS installing `xwem-overriding-local-map' to NLM.
Do it in safe manner."
  `(xwem-unwind-protect
       (let ((xwem-override-local-map ,nlm))
         ,@forms)))
(put 'xwem-overriding-local-map 'lisp-indent-function 'defun)

;;; X Properties
(defmacro xwem-XProperty-get (xwin prop-atom-string)
  `(ignore-errors (read (XGetPropertyString
                         (xwem-dpy) ,xwin
                         (XInternAtom (xwem-dpy) ,prop-atom-string)))))
(defmacro xwem-XProperty-set (xwin prop-atom-string prop-val)
  `(if ,prop-val
       (XSetPropertyString (xwem-dpy) ,xwin
                           (XInternAtom (xwem-dpy) ,prop-atom-string)
                           (format "%S" ,prop-val))
     (XDeleteProperty (xwem-dpy) ,xwin
                      (XInternAtom (xwem-dpy) ,prop-atom-string))))


(provide 'xwem-struct)

;;; xwem-struct.el ends here