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

   1 ;;; xlib-tray.el --- XEMBED support.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Tue Dec  9 14:14:07 MSK 2003
   7 ;; Keywords: xlib, xwem
   8 ;; X-CVS: $Id: xlib-tray.el,v 1.8 2005-04-04 19:55:29 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 ;;; Constants
  38 (defconst X-Tray-dock-req 0 "Dock place request.")
  39 (defconst X-Tray-message 1 "Message from dock app.")
  40 (defconst X-Tray-cancel-message 2 "Cancels message.")
  41 (defconst X-Tray-run-lisp 3 "Evaluate emacs lisp string")
  42
  43 (defconst X-Tray-Atom-System-Tray 0)
  44 (defconst X-Tray-Atom-System-Tray-Opcode 1)
  45 (defconst X-Tray-Atom-Xembed-Info 2)
  46 (defconst X-Tray-Atom-Xembed 3)
  47 (defconst X-Tray-Atom-Manager 4)
  48 (defconst X-Tray-Atom-Net-System-Tray-Message-Data 5)
  49 (defconst X-Tray-Atom-Kde-System-Tray 6)
  50
  51 \f
  52 ;;; Functions
  53 (defun XTrayInit (xdpy win)
  54   "Initialize atoms for interaction with system tray."
  55   (let ((atoms (make-vector 10 nil)))
  56
  57     (aset atoms X-Tray-Atom-System-Tray (XInternAtom xdpy "_NET_SYSTEM_TRAY_S0" nil))
  58     (aset atoms X-Tray-Atom-System-Tray-Opcode (XInternAtom xdpy "_NET_SYSTEM_TRAY_OPCODE" nil))
  59     (aset atoms X-Tray-Atom-Xembed-Info (XInternAtom xdpy "_XEMBED_INFO" nil))
  60     (aset atoms X-Tray-Atom-Xembed (XInternAtom xdpy "_XEMBED" nil))
  61     (aset atoms X-Tray-Atom-Manager (XInternAtom xdpy "MANAGER" nil))
  62     (aset atoms X-Tray-Atom-Net-System-Tray-Message-Data (XInternAtom xdpy "_NET_SYSTEM_TRAY_MESSAGE_DATA" nil))
  63     (aset atoms X-Tray-Atom-Kde-System-Tray (XInternAtom xdpy "_KDE_NET_SYSTEM_TRAY_WINDOWS" nil))
  64
  65     (X-Dpy-put-property xdpy 'tray-atoms atoms)
  66
  67     (XTrayFindDock xdpy win)))
  68
  69 (defun XTrayGetAtom (xdpy atom-code)
  70   (let ((atoms (X-Dpy-get-property xdpy 'tray-atoms)))
  71     (when (vectorp atoms)
  72       (aref atoms atom-code))))
  73
  74 (defun XTrayFindDock (xdpy win)
  75   (let (dock)
  76
  77     (setq dock (XGetSelectionOwner xdpy (XTrayGetAtom xdpy X-Tray-Atom-System-Tray)))
  78     (unless (X-Win-p dock)
  79       (XSelectInput xdpy (XDefaultRootWindow xdpy) XM-StructureNotify))
  80
  81     (when (X-Win-p dock)
  82       (XTraySendOpcode xdpy dock dock X-Tray-dock-req (X-Win-id win)))))
  83
  84 (defun XTraySendOpcode (xdpy dock win message &optional data1 data2 data3)
  85   (let (xev)
  86     ;; TODO:
  87     ;;   * Fill xclient event XEV
  88     (setq xev (X-Create-message
  89                (list [1 X-ClientMessage] ;type
  90                      [1 32]             ;format
  91                      [2 0]              ;seq
  92                      [4 (X-Win-id win)] ;window
  93                      [4 (X-Atom-id (XTrayGetAtom xdpy X-Tray-Atom-System-Tray-Opcode))]
  94
  95                      [4 X-CurrentTime]
  96                      [4 message]
  97                      [4 data1]
  98                      [4 data2]
  99                      [4 data3])))
 100
 101     (XSendEvent xdpy dock nil XM-NoEvent xev)
 102     ))
 103
 104 (defun XTraySendMessageData (xdpy dock win data)
 105   (let (xev)
 106     (setq xev (X-Create-message
 107                (list [1 X-ClientMessage] ;type
 108                      [1 8]              ;format
 109                      [2 0]              ;seq
 110                      [4 (X-Win-id win)] ;window
 111                      [4 (X-Atom-id (XTrayGetAtom xdpy X-Tray-Atom-Net-System-Tray-Message-Data))]
 112
 113                      [20 data])))
 114
 115     (XSendEvent xdpy dock nil XM-NoEvent xev)
 116     (XSync xdpy)
 117     ))
 118
 119 (defun XTraySetXembedInfo (xdpy win flags)
 120   (XChangeProperty xdpy win (XTrayGetAtom xdpy X-Tray-Atom-Xembed-Info)
 121                    XA-cardinal 32 X-PropModeReplace (X-Create-message (list [4 1] ; max supported xembed version
 122                                                                             [4 flags]))))
 123
 124 (defun XTrayMapWindow (xdpy win)
 125   (XTraySetXembedInfo xdpy win 1))
 126
 127 (defun XTrayUnmapWindow (xdpy win)
 128   (XTraySetXembedInfo xdpy win 0))
 129
 130 (defun XTrayHandleEvent (xdpy win xev)
 131   (X-Event-CASE xev
 132     (:X-ClientMessage
 133      (X-Dpy-log xdpy 'x-tray "got client message"))
 134
 135     (:X-PropertyNotify
 136      (X-Dpy-log xdpy 'x-tray "got property notify"))))
 137
 138 (defun XTraySendMessage (xdpy dock win opcode msg)
 139   (let ((id 1234))                      ; TODO: should be unique
 140     (XTraySendOpcode xdpy dock win opcode 0 (length msg) id)
 141
 142     (while (> (length msg) 20)
 143       (XTraySendMessageData xdpy dock win (substring msg 0 20))
 144       (setq msg (substring msg 20)))
 145
 146     (when (> (length msg) 0)
 147       (XTraySendMessageData xdpy dock win msg))))
 148
 149 (defun XTrayInitSessionInfo (xdpy win cmd)
 150   ;; TODO: write me
 151   )
 152
 153 \f
 154 (provide 'xlib-tray)
 155
 156 ;;; xlib-tray.el ends here