Article View: gnu.epoch.misc
Article #2194Window Packing
From: Alan M. Carroll
Date: Mon, 18 Feb 1991 00:08
Date: Mon, 18 Feb 1991 00:08
140 lines
5124 bytes
5124 bytes
I use gwm and mwm, and something I really missed in mwm was the
ability to pack particular classes of X windows in places other than
with the icons. I solved this by writing some Epoch code to do it for
me. The following code, if loaded and (xwin:pack-stuff) executed, will
pack all xload and xclock windows into the upper right of the display.
xwin:packing-names has the list of WM_CLASS names that are packed.
This works under gwm and mwm.
This code should be considered experimental.
;;; Copyright (C) 1990 Alan M. Carroll
;;;
;;; This file is for use with Epoch, a modified version of GNU Emacs.
;;; Requires Epoch 3.2 or later.
;;;
;;; This code is distributed in the hope that it will be useful,
;;; bute WITHOUT ANY WARRANTY. No author or distributor accepts
;;; responsibility to anyone for the consequences of using this code
;;; or for whether it serves any particular purpose or works at all,
;;; unless explicitly stated in a written agreement.
;;;
;;; Everyone is granted permission to copy, modify and redistribute
;;; this code, but only under the conditions described in the
;;; GNU Emacs General Public License, except the original author nor his
;;; agents are bound by the License in their use of this code.
;;; (These special rights for the author in no way restrict the rights of
;;; others given in the License or this prologue)
;;; A copy of this license is supposed to have been given to you along
;;; with Epoch so you can know your rights and responsibilities.
;;; It should be in a file named COPYING. Among other things, the
;;; copyright notice and this notice must be preserved on all copies.
;;;
(defvar xwin::root-window (car (query-tree))
"X root window"
)
(defvar xa-wm-class (intern-atom "WM_CLASS") "WM_CLASS atom")
(defvar xwin:packing-names (list "xload" "xclock")
"*List of X window names that should be packed"
)
(defun xwin:find-all-windows (prop &optional value)
"Return a list of all X windows on the display that have PROPERTY set
to [optional] VALUE. If VALUE is omitted, the window is returned if
the PROPERTY is set at all."
(atomize prop)
(xwin::find-all-windows prop value xwin::root-window)
)
(defun xwin::find-all-windows (prop value xwin)
"Internal version of xwin:find-all-windows. You shouldn't use this
function. The arguments are PROPERTY, VALUE, and X-WINDOW. PROPERTY
must be a X-atom resource, and X-WINDOW an X-window resource."
(let*
(
(pvalue (get-property prop xwin))
(result
(if
(or
(and value (equal value pvalue))
(and pvalue (not value))
)
(list xwin) nil
))
(wlist (cddr (query-tree xwin)))
)
(dolist (xw wlist)
(let ((r (xwin::find-all-windows prop value xw)))
(if r (setq result (append result r)))
))
result
))
(defun xwin:find-backing-window (xwin)
"Given an X window, return the X window that is its backing window"
(let ( parent )
(while
(progn
(setq parent (nth 1 (query-tree xwin)))
(and parent (not (equal parent xwin::root-window)))
)
(setq xwin parent)
)
xwin
))
(defun xwin:member (item list)
"Return non nil if ITEM is in LIST, using equal as the test"
(catch 'found
(while list
(if (equal (car list) item) (throw 'found list))
(setq list (cdr list))
)
nil
))
(defun xwin:pack-stuff ()
"Pack all top level windows with the names in xwin:packing-names into
the upper right corner of the display"
(message "Searching for X windows...")
(let*
(
(xlist (xwin:find-all-windows "WM_STATE"))
(y 0)
(x (car (plane-size)))
)
(dolist (xwin xlist)
(message "Moving...")
(let ((name (car (get-property xa-wm-class xwin))))
(when (xwin:member name xwin:packing-names)
(message (format "Moving...%s" name))
(let*
(
(backing-win (xwin:find-backing-window xwin))
(binfo (screen-information backing-win))
(info (screen-information xwin))
(dx (- (nth 0 info) (nth 0 binfo)))
(dy (- (nth 1 info) (nth 1 binfo)))
)
(setq x (- x (nth 2 binfo)))
(move-screen (+ x dx) (+ y dy) xwin)
))))
(message "Moving...done")
))
--
Alan M. Carroll "I hate shopping with the reality-impaired"
Epoch Development Team - Susan
CS Grad / U of Ill @ Urbana ...{ucbvax,pur-ee,convex}!cs.uiuc.edu!carroll
Technical Details
Message-ID:
<1991Feb18.000834.23845@ux1.cso.uiuc.edu>Path:
arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!cs.utexas.edu!wuarchive!sdd.hp.com!news.cs.indiana.edu!ux1.cso.uiuc.edu!uiucdcs!carrollShow Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: fc7ee,75a03c84a9c6861f,start X-Google-Attributes: gidfc7ee,public X-Google-ArrivalTime: 1991-02-17 16:09:31 PST Path: arc1-ca.pugleaf.net!gmdzi!unido!mcsun!uunet!cs.utexas.edu!wuarchive!sdd.hp.com!news.cs.indiana.edu!ux1.cso.uiuc.edu!uiucdcs!carroll From: carroll@cs.uiuc.edu (Alan M. Carroll) Newsgroups: gnu.epoch.misc Subject: Window Packing Message-ID: <1991Feb18.000834.23845@ux1.cso.uiuc.edu> Date: 18 Feb 91 00:08:34 GMT Sender: news@ux1.cso.uiuc.edu (News) Reply-To: carroll@cs.uiuc.edu (Alan M. Carroll) Organization: Organic Software and Vegetables Lines: 140