Source

xwem / lisp / xwem-tray.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
;;; xwem-tray.el --- Tray support for XWEM.

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: 1 Sep 2003
;; Keywords: xlib, 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:
;;
;; We should implement something like dockapp handler(or system tray),
;; that will be placed on free space of xwem-minibuffer or xwem-frame
;; and handle external X applications. It may receive some
;; ClientMessages and process them. Some of this ClientMessage should
;; be used to run elisp code.
;;
;; See how mbdock from matchbox made.
;;
;; xwem tray creates fake window which is only used to hold selection
;; needed for communicatio, xwem minibuffer window will be used for
;; holding apps.
;;
;;; TODO:
;;    - Proper possition in `xwem-minibuffer' calculation.
;;    - Run elisp support(almost already done).
;;
;;; Code:

;;; xwem tray constants
(defconst xwem-tc-dock-req 0 "Dock place request.")
(defconst xwem-tc-message 1 "Message from dock app.")
(defconst xwem-tc-cancel-message 2 "Cancels message.")
(defconst xwem-tc-run-lisp 3 "Evaluate emacs lisp string")

(defvar xwem-tray-message-hook 'xwem-tray-message-defhook
  "*Hook to be called whin new message from dock app.
Function will be called with arg - dockapp.")

(defcustom xwem-tray-id 0 "System tray identificator.")

(defcustom xwem-tray-name "xwem-tray"
  "X Name for xwem tray.")

(defcustom xwem-tray-class '("xwem-tray" "xwem-tray")
  "X Class for xwem tray")

(defconst xwem-tray-evmask (Xmask-or XM-SubstructureNotify
				     XM-Exposure
				     XM-StructureNotify
				     XM-SubstructureRedirect
				     XM-PropertyChange
				     XM-ButtonPress
				     XM-ButtonRelease))

;;; Configuration for xwem system tray
(defgroup xwem-tray nil
  "Group to customize XWEM system tray."
  :prefix "xwem-tray-"
  :group 'xwem)

;;;###autoload
(defcustom xwem-tray-enabled t
  "*Non-nil mean that xwem's system tray will be used."
  :type 'boolean
  :group 'xwem-tray)

(defcustom xwem-tray-max-docks 6
  "*Maximum number of docks."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-minib-position 'right
  "*Position where dockapps will be placed in `xwem-minib-xwin'."
  :type '(choice (const :tag "At Right" right)
		 (const :tag "At Left" left))
  :group 'xwem-tray)

(defcustom xwem-tray-minib-posoffset 4
  "*Offset in pixels from `xwem-tray-minib-position'."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-minib-docoffset 5
  "*Offset in pixels between dockapps."
  :type 'number
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-shape 'X-XC-right_ptr
  "*Cursor shape which will be used when pointer is over dock app."
  :type (xwem-cursor-shape-choice)
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-foreground-color "#000075"
  "*Cursor's foreground color used when poniter is on dock app."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-tray)

(defcustom xwem-tray-cursor-background-color "#000039"
  "*Cursor's background color used when poniter is on dock app."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-tray)

;;; Internal variables
(defvar xwem-tray nil
  "XWEM system tray holder.")

(defvar xwem-tray-cursor nil "Cursor used when pointer is over dock app.")
(defvar xwem-tray-curroffset 0 "Current offset in pixels.")
(defvar xwem-tray-dockapps 0 "Dockapps counter.")

;;; Dock applications
;;
;; Dock is array in form:
;;  [x-window geom-after-reparent]
(defvar xwem-tray-dapp-list nil "List of dockapp X windows.")

;; System tray
(defstruct xwem-tray
  xwin
  props
  atoms

  curr-offset
  dockapps)

;; Dockapp structure
(defstruct xwem-dapp
  xwin
  geom
  mess-type
  mess-waitlen
  mess-currlen
  mess)

;; Message is vector in form:
;;  [message-type message-waitlen message-currlen message-string]

;; message-type is one of `xwem-tc-message', `xwem-tc-cancel-message'
;; or `xwem-tc-run-lisp'.

;;; Functions
(defun xwem-tray-find-dapp (xwin)
  "Finds dock application by X window XWIN."
  (let ((dal xwem-tray-dapp-list)
	(rdapp nil))
    (while dal
      (if (eq (xwem-dapp-xwin (car dal)) xwin)
	  (progn
	    (setq rdapp (car dal))
	    (setq dal nil))
	(setq dal (cdr dal))))
    rdapp))

(defun xwem-tray-message-defhook (dapp)
  "Default function for message from dock apps handling."
  (if xwem-special-enabled
      ;; XXX
      (xwem-help-display
       (insert (xwem-dapp-mess dapp)))
    (xwem-message 'err "message arrived from dock app, but special frames not enabled.")
  ))

(defun xwem-tray-remove-dapp (dapp)
  "Remove dock application DAPP from xwem tray dockapps list."
  (setq xwem-tray-dapp-list (delete dapp xwem-tray-dapp-list)))

(defun xwem-tray-new-dapp (xwin)
  "New dock application XWIN wants to be managed."
  (let* (;(minb-wid (X-Geom-width (xwem-minib-xgeom xwem-minibuffer)))
	 (minb-hei (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)))
	 (wgeom (XGetGeometry (xwem-dpy) xwin))
	 (w-wid (X-Geom-width wgeom))
	 (w-hei (X-Geom-height wgeom))
	 (dapp-geom (make-X-Geom :x 0 :y 0 :width w-wid :height w-hei)))

    (setf (X-Geom-x dapp-geom)
	  (- xwem-tray-curroffset w-wid xwem-tray-minib-docoffset))
    (setf (X-Geom-y dapp-geom) (/ (- minb-hei w-hei) 2))
    (add-to-list 'xwem-tray-dapp-list (make-xwem-dapp :xwin xwin :geom dapp-geom))

    (setq xwem-tray-curroffset (X-Geom-x dapp-geom)) ;update curroffset

    (X-Win-EventHandler-add-new xwin 'xwem-dapp-evhandler 100)

    (XReparentWindow (xwem-dpy) xwin (xwem-minib-xwin xwem-minibuffer)
		     (X-Geom-x dapp-geom)
		     (X-Geom-y dapp-geom))
    (XMapWindow (xwem-dpy) xwin)
    ))

(defun xwem-tray-handle-client-message (win xev)
  "Handles ClientMessage from dock application WIN."
  (X-Dpy-log (xwem-dpy) "TRAY: ClientMessage, evinfo=%S\n" '(X-Event-evinfo xev))

  (let* ((mes-type (X-Atom-id (X-Event-xclient-atom xev)))
	 (mes-data (X-Event-xclient-msg xev))
	 (mes-win (X-Win-find-or-make (xwem-dpy) (car (nth 2 mes-data))))
	 (data-type (truncate (car (nth 1 mes-data)))))
    (cond ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 3)))
	   (cond ((= data-type xwem-tc-dock-req)
		  (xwem-tray-new-dapp mes-win))

		 (t (xwem-message 'warn "Unknown data-type %d in clientmessage." data-type))))

	  (t (xwem-message 'warn "Unknown mes-type %d" mes-type)))
  nil))

(defun xwem-tray-handle-unmap-or-destroy-notify (xdpy win xev)
  "Handles UnmapNotify event."
  (X-Dpy-log (xwem-dpy) "TRAY: UnmapNotify, evwin=%S, win=%S\n"
	     '(X-Win-id (X-Event-win xev)) '(X-Win-id (X-Event-xdestroywindow-window xev)))

  (let ((dapp (xwem-tray-find-dapp (X-Event-xdestroywindow-window xev))))
    (if dapp
	(progn
	  (xwem-message 'note "Removing dockapp from xwem tray.")
	  (xwem-tray-remove-dapp dapp)
	  ;; XXX: what if we removes not last dockapp?
	  (setq xwem-tray-curroffset
		(+ xwem-tray-curroffset
		   xwem-tray-minib-docoffset
		   (X-Geom-width (xwem-dapp-geom dapp))))
	  t)				;stop unmapnotify event processing
      nil)))				;continue processing

(defun xwem-tray-handle-prop-notify (win xev)
  "Handles PropertyNotify event."
  (X-Dpy-log (xwem-dpy) "TRAY: PropertyNotify\n")
  nil)

(defun xwem-tray-handle-expose (win xev)
  "Handles Exposure event."
  (X-Dpy-log (xwem-dpy) "TRAY: Exposure\n")
  nil)

(defun xwem-tray-handle-config-notify (win xev)
  "Handles ConfigureNotify event."
  (X-Dpy-log (xwem-dpy) "TRAY: ConfigureNotify\n")
  nil)

(defun xwem-tray-evhandler (xdpy win xev)
  "X Events handler for xwem system tray."
  (X-Dpy-log (xwem-dpy) "TRAY: event %S, descr: %S\n" '(X-Event-name xev) '(X-Event-evinfo xev))

  (let* ((evtype (X-Event-type xev))
	 (fn (cond ((= evtype X-ClientMessage) 'xwem-tray-handle-client-message)
;		  ((= evtype X-MapRequest) nil)
;		  ((= evtype X-UnmapNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify)
;		  ((= evtype X-Expose) 'xwem-tray-handle-expose)
;		  ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify)
		  (t nil))))
    (when fn
      (funcall fn win xev))
  nil))

(defun xwem-dapp-handle-client-message (win xev)
  "Handle ClientMessage from dock application."
  (X-Dpy-log (xwem-dpy) "DOCK APP: ClientMessage\n")

  (let ((dapp (xwem-tray-find-dapp win))
	(mes-type (X-Atom-id (X-Event-xclient-atom xev))))
    (cond ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 9)))
	   ;; part of some message arrived
	   (let* ((len (- (xwem-dapp-mess-waitlen dapp)
			  (xwem-dapp-mess-currlen dapp)))
		  (ltgo (if (> len 20) 20 len)))	;length to go
	     (setf (xwem-dapp-mess dapp)
		   (concat (xwem-dapp-mess dapp)
			   (xwem-list-to-string
			    (mapcar (lambda (el) (car el)) (X-Event-xclient-msg xev)) ltgo)))
	     (setf (xwem-dapp-mess-currlen dapp) (+ (xwem-dapp-mess-currlen dapp) ltgo)))

	   (when (= (xwem-dapp-mess-currlen dapp) (xwem-dapp-mess-waitlen dapp))
	     ;; message accomplished
	     (let ((dtype (xwem-dapp-mess-type dapp)))
	       (cond ((= dtype xwem-tc-message)
		      ;; TODO: run hook?
		      (when xwem-tray-message-hook
			(funcall xwem-tray-message-hook dapp)))

		     ((= dtype xwem-tc-run-lisp)
		      (X-Dpy-log (xwem-dpy) "DOCK APP: ELISP: %s" (xwem-dapp-mess dapp))
		      (with-temp-buffer
			(insert (xwem-dapp-mess dapp))
			(condition-case nil
			    (progn
			      (xwem-message 'info "evaling: %S" (xwem-dapp-mess dapp))
			      (eval-buffer))
			  (t nil))))
		     )))
	   )

	  ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 3)))
	   ;; opcode arrived
	   (let ((opc (truncate (car (nth 1 (X-Event-xclient-msg xev))))))
	     (cond ((= opc xwem-tc-dock-req) nil)

		   (t
		    (setf (xwem-dapp-mess dapp) "")
		    (setf (xwem-dapp-mess-currlen dapp) 0)
		    (setf (xwem-dapp-mess-waitlen dapp) (truncate (car (nth 3 (X-Event-xclient-msg xev)))))
		    (setf (xwem-dapp-mess-type dapp) opc))
	     )))
		   
	  (t (xwem-message 'warn "Unknown mes-type %d from dock app." mes-type)))
  nil))

(defun xwem-dapp-evhandler (xdpy win xev)
  "X Events handler for xwem dock applications."
  (X-Dpy-log (xwem-dpy) "DOCK APP: event %S,  info: %S\n" '(X-Event-name xev) '(X-Event-evinfo xev))

  (let* ((evtype (X-Event-type xev))
	 (fn (cond ((= evtype X-ClientMessage) 'xwem-dapp-handle-client-message)
;		  ((= evtype X-MapRequest) nil)
;		  ((= evtype X-UnmapNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify)
;		  ((= evtype X-Expose) 'xwem-tray-handle-expose)
;		  ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify)
;		  ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify)
		  (t nil))))
    (when fn
      (funcall fn win xev))
  nil))

(defcustom xwem-tray-config nil
  "*Config file for xwem-tray.
It is list of vectors in form [TYPE VALUE], TYPE is one of XWEM-TRAY-DOCK where VALUE for it is a string, which will be runned with `background' or XWEM-TRAY-DILEM where VALUE is offset in pixels which should delim docks.

For example:
  '([XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minitime -f 004400 -b bbbbbb\"]
    [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-miniapm\"]
    [XWEM-TRAY-DELIM 10]
    [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minilaunch /home/lg/prog/xwem/modules/icons/xterm_big.xpm xterm\"]"
  :type 'list
  :group 'xwem-tray)

(defcustom xwem-tray-sit-for-pause 0.1
  "*Pause in seconds we should sit-for between launching XWEM-TRAY-DOCK.
UNUSED"
  :type 'number
  :group 'xwem-tray)

(defun xwem-tray-run-config (config)
  "Parse and execute xwem tray CONFIG."
  (while config
    (let ((type (aref (car config) 0))
	  (data (aref (car config) 1)))
      (cond ((eq type 'XWEM-TRAY-DOCK)
	     (xwem-execute-program data))

	    ((eq type 'XWEM-TRAY-DELIM)
	     (setq xwem-tray-curroffset (- xwem-tray-curroffset data)))
	    (t nil)))
    (setq config (cdr config))))
	    
(defun xwem-tray-create (dpy)
  "Creates new XWEM system tray on DPY.
Window is InputOnly to be transparent."
  (let ((win nil))
    (setq win (XCreateWindow
	       dpy nil
	       0 0 1 1
	       0 0 X-InputOnly nil
	       (make-X-Attr :override-redirect 1
			    :event-mask xwem-tray-evmask)))

    (X-Win-EventHandler-add-new win 'xwem-tray-evhandler 100)
    
    ;; Setup various hints
    (XSetWMClass dpy win xwem-tray-class)
    (XSetWMName dpy win xwem-tray-name)

    (setf (xwem-tray-xwin xwem-tray) win)
    (setf (xwem-tray-props xwem-tray) nil)

    ;; TODO: install Selections and properties we will need
    
;    (XMapWindow dpy win)
    ))

(defun xwem-tray-init (dpy)
  "Initialize xwem tray."
  (setq xwem-tray
	(make-xwem-tray :atoms (make-vector 40 nil)))

  (let ((xwem-atoms (xwem-tray-atoms xwem-tray)))
    (aset xwem-atoms 0 (XInternAtom dpy "_NET_WM_WINDOW_TYPE" nil))
    (aset xwem-atoms 1 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_DOCK" nil))
    (aset xwem-atoms 3 (XInternAtom dpy "_NET_SYSTEM_TRAY_OPCODE" nil))
    (aset xwem-atoms 4 (XInternAtom dpy "_XEMBED_INFO" nil))
    (aset xwem-atoms 5 (XInternAtom dpy "_XEMBED" nil))
    (aset xwem-atoms 6 (XInternAtom dpy "MANAGER" nil))
    (aset xwem-atoms 7 (XInternAtom dpy "_MB_DOCK_ALIGN" nil))
    (aset xwem-atoms 8 (XInternAtom dpy "_MB_DOCK_ALIGN_EAST" nil))
    (aset xwem-atoms 9 (XInternAtom dpy "_NET_SYSTEM_TRAY_MESSAGE_DATA" nil))
    (aset xwem-atoms 10 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_SPLASH" nil))
    (aset xwem-atoms 11 (XInternAtom dpy "WM_PROTOCOLS" nil))
    (aset xwem-atoms 12 (XInternAtom dpy "WM_DELETE_WINDOW" nil))
    (aset xwem-atoms 13 (XInternAtom dpy "_MB_THEME" nil))
    (aset xwem-atoms 14 (XInternAtom dpy "_MB_PANEL_TIMESTAMP" nil))
    (aset xwem-atoms 15 (XInternAtom dpy "_NET_WM_STRUT" nil))
    (aset xwem-atoms 16 (XInternAtom dpy "_MB_PANEL_BG" nil))
    (aset xwem-atoms 17 (XInternAtom dpy "WM_CLIENT_LEADER" nil))
    (aset xwem-atoms 18 (XInternAtom dpy "_NET_WM_ICON" nil))
    (aset xwem-atoms 19 (XInternAtom dpy "_NET_WM_PID" nil))
    (aset xwem-atoms 20 (XInternAtom dpy "_XROOTPMAP_ID" nil))

    ;; Use emacs pid as tray identificator
    (aset xwem-atoms 2
	  (XInternAtom dpy (format "_NET_SYSTEM_TRAY_S%i" xwem-tray-id) nil)))

  (setenv "SYSTEM_TRAY_ID" (format "%i" xwem-tray-id))

  ;; Must do:
  ;;	- Calculate start possition.
  ;;	- Add handler for UnmapNotify and DestroyNotify events.
  (cond ((eq xwem-tray-minib-position 'right)
	 (setq xwem-tray-curroffset
	       (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))))
	
	(t (xwem-message "Unsupported `xwem-tray-minib-position': %S"
			 xwem-tray-minib-position)))

  ;; Subscribe on substructure change events for xwem minibuffer
  ;; window.
  (setf (xwem-minib-evmask xwem-minibuffer)
	(Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-SubstructureNotify))
  (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
		(xwem-minib-evmask xwem-minibuffer))
  (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer)
			      'xwem-tray-handle-unmap-or-destroy-notify
			      -1 (list X-UnmapNotify X-DestroyNotify))
  
  ;; Configure systray cursor
  (setq xwem-tray-cursor (xwem-make-cursor (eval xwem-tray-cursor-shape)
					   xwem-tray-cursor-foreground-color
					   xwem-tray-cursor-background-color))

  (XChangeWindowAttributes (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
			   (make-X-Attr :cursor xwem-tray-cursor))
  )

;;;###autoload
(defun xwem-tray-startit (dpy)
  "Start xwew tray on display DPY."
  (xwem-tray-init dpy)

  (xwem-tray-create dpy)

  (XSetSelectionOwner dpy (aref (xwem-tray-atoms xwem-tray) 2)
		      (xwem-tray-xwin xwem-tray))
  ;; TODO: err check
  (XMapWindow dpy (xwem-tray-xwin xwem-tray))
  )

;;;###autoload
(defun xwem-tray-fini ()
  "Finialize xwem-tray."
  (mapc (lambda (dapp)
	  (XDestroyWindow (xwem-dpy) (xwem-dapp-xwin dapp)))
	xwem-tray-dapp-list)

  (setq xwem-tray-dapp-list nil)
  (setq xwem-tray-cursor nil)
  (setq xwem-tray-curroffset 0)
  (setq xwem-tray-dockapps 0)
  )

(provide 'xwem-tray)

;;; xwem-tray.el ends here