Location: lg@xxxxxxxxxxxxxx http://arch.xwem.org/2005/
Revision: xwem--main--2.1--patch-21
Archive: lg@xxxxxxxxxxxxxx
Creator: Zajcev Evgeny <lg@xxxxxxxx>
Date: Mon Feb 14 02:04:16 MSK 2005
Standard-date: 2005-02-13 23:04:16 GMT
New-files: xwem-agent/.arch-ids/=id
xwem-agent/.arch-ids/Makefile.id
xwem-agent/.arch-ids/xwem-agent.c.id
xwem-agent/Makefile xwem-agent/xwem-agent.c
New-directories: xwem-agent xwem-agent/.arch-ids
Modified-files: dockapp/xwem-battery.el
dockapp/xwem-pager.el dockapp/xwem-time.el
lisp/xwem-clients.el lisp/xwem-frame.el
lisp/xwem-keyboard.el lisp/xwem-launcher.el
lisp/xwem-main.el lisp/xwem-manage.el lisp/xwem-misc.el
lisp/xwem-mouse.el lisp/xwem-root.el lisp/xwem-struct.el
lisp/xwem-tabbing.el lisp/xwem-theme.el lisp/xwem-win.el
utils/xwem-osd.el
New-patches: dev@xxxxxxxxxxxxxxxx/xwem--dev--2.1--patch-14
lg@xxxxxxxxxxxxxx/xwem--main--2.1--patch-21
Summary: EXPERIMENTAL. xwem-agent initial import. dockapps rewritten (esp
xwem-time), xwem-misc-turbo-mode introduced.
Keywords: xwem-agent, dockapps
* xwem-agent/xwem-agent.c (initial): Initial import of xwem-agent.
xwem-agent is intermediate software that holds X server and controls
(S)XEmacs process. See Commentary section for more info.
* xwem-agent/Makefile (initial): Initial import of xwem-agent.
* lisp/xwem-keyboard.el (xwem-local-map): [fix] Do not ungrab keymaps.
* lisp/xwem-launcher.el (ladock): [rewriten] Launcher dock rewritten to
support `xwem-misc-turbo-mode'.
* lisp/xwem-main.el (xwem-initial-manage): [fix] manage clients in
reverse order.
* lisp/xwem-misc.el (xwem-misc-turbo-mode): [new] Non-nil enables turbo
drawing mode. If `xwem-misc-turbo-mode' is non-nil drawings occurs
faster, but no on-fly color changes is possible.
* lisp/xwem-mous.el (xwem-generate-cl-menu): [addon-fix] Attach item
added to attach marked clients. Soft kill changed to Close.
* lisp/xwem-root.el (xwem-fini-root): [fix] Set input focus to
PointerRoot when exiting.
* lisp/xwem-struct.el (xwem-XProperty-set): [new] For exporting data to
X.
* lisp/xwem-struct.el (xwem-XProperty-get): [new] For importing data from
X.
* lisp/xwem-tabbing.el (xwem-tabber-resize): [addon] Support for
`xwem-misc-turbo-mode' added.
* lisp/xwem-theme.el (themes): [fix] `xwem-launch-dock-face' fixes.
* lisp/xwem-win.el (xwem-win-num): [new] Return logical window number.
* lisp/xwem-win.el (xwem-win-find-by-num): [new] Find window by its
logical number.
* lisp/xwem-win.el (xwem-cl-set-win): [addon] Set 'client-window property
when client changes window.
* lisp/xwem-clients.el (xwem-cl-activate-hook): [semchange] Now called
with two arguments - CL and TYPE.
* lisp/xwem-clients.el (xwem-cl-deactivate-hook): [semchange] Now called
with two arguments - CL and TYPE.
* lisp/xwem-clients.el (client-window): [new] New client property -
stores frame number and window number in cons cell.
* lisp/xwem-clients.el (xwem-cl-presetup): [addon] Use XChangeSaveSet -
potential problem with embedded frames, because XChangeSaveSet throws X
error for windows controled by same client.
* lisp/xwem-clients.el (xwem-client-first-manage): [addon] Import
manage-spec and properties from X. Install expectance on
'client-window if needed.
* lisp/xwem-clients.el (xwem-client-change-manage-type): [bug fix] use
`xwem-manage' when manage model has been changed.
* lisp/xwem-clients.el (xwem-client-iconify-others): [bug fix] Do things
otherwise.
* lisp/xwem-clients.el (xwem-manage): [addon] Export manage-spec to X.
* lisp/xwem-clients.el (xwem-client-set-property): [addon] Alos export
properties to X.
* lisp/xwem-frame.el (xwem-frame-configuration-exporting): [new] Non-nil
mean frame configuration is exported to X each time frame command is
executed.
* lisp/xwem-framesel (xwem-frame-create-initial): [addon] Import frame
configuration from X.
* lisp/xwem-time.el (): Totally rewritten. Support for
`xwem-misc-turbo-mode' added.
* added directories
xwem-agent
xwem-agent/.arch-ids
* added files
xwem-agent/.arch-ids/=id
xwem-agent/.arch-ids/Makefile.id
xwem-agent/.arch-ids/xwem-agent.c.id
xwem-agent/Makefile
xwem-agent/xwem-agent.c
{arch}/xwem/xwem--dev/xwem--dev--2.1/dev@xxxxxxxxxxxxxxxx/patch-log/patch-14
{arch}/xwem/xwem--main/xwem--main--2.1/lg@xxxxxxxxxxxxxx/patch-log/patch-21
* modified files
--- orig/dockapp/xwem-battery.el
+++ mod/dockapp/xwem-battery.el
@@ -111,6 +111,28 @@
;;; Internal variables
+(defmacro xwem-batt-itimer (win)
+ `(X-Win-get-prop ,win 'xwem-batt-itimer))
+(defsetf xwem-batt-itimer (win) (itimer)
+ `(X-Win-put-prop ,win 'xwem-batt-itimer ,itimer))
+(defmacro xwem-batt-xmask (win)
+ `(X-Win-get-prop ,win 'xwem-batt-xmask))
+(defsetf xwem-batt-xmask (win) (xmask)
+ `(X-Win-put-prop ,win 'xwem-batt-xmask ,xmask))
+(defmacro xwem-batt-pixmap (win)
+ `(X-Win-get-prop ,win 'xwem-batt-pixmap))
+(defsetf xwem-batt-pixmap (win) (pixmap)
+ `(X-Win-put-prop ,win 'xwem-batt-pixmap ,pixmap))
+
+(defmacro xwem-batt-old-ac-line-p (win)
+ `(X-Win-get-prop ,win 'old-ac-line-p))
+(defsetf xwem-batt-old-ac-line-p (win) (oalp)
+ `(X-Win-put-prop ,win 'old-ac-line-p ,oalp))
+(defmacro xwem-batt-old-dheight (win)
+ `(X-Win-get-prop ,win 'old-dheight))
+(defsetf xwem-batt-old-dheight (win) (dheight)
+ `(X-Win-put-prop ,win 'old-dheight ,dheight))
+
(defun xwem-batt-init (xdpy)
"On display XDPY create and return APM battery monitor window."
(let (mgc tgc xwin xmask)
@@ -150,7 +172,7 @@
;; Set mask
(X-XShapeMask xdpy xwin X-XShape-Bounding X-XShapeSet 0 0 xmask)
- (X-Win-put-prop xwin 'xwem-batt-xmask xmask)
+ (setf (xwem-batt-xmask xwin) xmask)
xwin))
@@ -173,8 +195,8 @@
;; Calculate displayed height
(setq dheight (round (/ (* cperc (- xwem-batt-height 5)) 100.0)))
- (when (or force (not (eq dheight (X-Win-get-prop xwin 'old-dheight)))
- (not (eq ac-line-p (X-Win-get-prop xwin 'old-ac-line-p))))
+ (when (or force (not (eq dheight (xwem-batt-old-dheight xwin)))
+ (not (eq ac-line-p (xwem-batt-old-ac-line-p xwin))))
(XClearArea xdpy xwin 0 0 xwem-batt-width xwem-batt-height nil)
;; Outline battery
(XFillRectangle xdpy xwin (XDefaultGC xdpy)
@@ -186,7 +208,7 @@
(setq force t))
;; Maybe redraw percentage
- (when (or force (not (eq dheight (X-Win-get-prop xwin 'old-dheight))))
+ (when (or force (not (eq dheight (xwem-batt-old-dheight xwin))))
;; Find appopriate color
(while (and perc-cols (> cperc (caar perc-cols)))
(setq perc-cols (cdr perc-cols)))
@@ -202,10 +224,10 @@
(- xwem-batt-width 2) (- xwem-batt-height 2 dheight)))
;; Save DHEIGHT
- (X-Win-put-prop xwin 'old-dheight dheight))
+ (setf (xwem-batt-old-dheight xwin) dheight))
;; Maybe redraw ac-line status
- (when (or force (not (eq ac-line-p (X-Win-get-prop xwin 'old-ac-line-p))))
+ (when (or force (not (eq ac-line-p (xwem-batt-old-ac-line-p xwin))))
(when ac-line-p
(xwem-set-face-foreground 'xwem-batt-tmp-face xwem-batt-ac-line-color)
(let ((acgc (xwem-face-get-gc 'xwem-batt-tmp-face)))
@@ -216,18 +238,19 @@
0 (- xwem-batt-height xwem-batt-ac-line-width))
(setf (X-Gc-line-width acgc) 0)
(XChangeGC xdpy acgc)))
- (X-Win-put-prop xwin 'old-ac-line-p ac-line-p))
+ (setf (xwem-batt-old-ac-line-p xwin) ac-line-p))
))
(defun xwem-batt-win-remove (xwin &optional need-destroy)
"Remove battery dockapp."
- (delete-itimer (X-Win-get-prop xwin 'xwem-batt-timer))
- (XFreePixmap (xwem-dpy) (X-Win-get-prop xwin 'xwem-batt-xmask))
- (X-Win-rem-prop xwin 'xwem-batt-timer)
- (X-Win-rem-prop xwin 'xwem-batt-xmask)
-
- (X-Win-rem-prop xwin 'old-ac-line-p)
- (X-Win-rem-prop xwin 'old-dheight)
+ (when (xwem-batt-itimer xwin)
+ (delete-itimer (xwem-batt-itimer xwin)))
+ (XFreePixmap (xwem-dpy) (xwem-batt-xmask xwin))
+
+ (setf (xwem-batt-itimer xwin) nil
+ (xwem-batt-xmask xwin) nil
+ (xwem-batt-old-dheight xwin) nil
+ (xwem-batt-old-ac-line-p xwin) nil)
;; Remove events handler
(X-Win-EventHandler-rem xwin 'xwem-batt-event-handler)
@@ -252,10 +275,8 @@
(defun xwem-batt-event-handler (xdpy win xev)
"Event handler for xwem battery monitor."
(X-Event-CASE xev
- (:X-Expose
- (xwem-batt-win-update win t))
- (:X-DestroyNotify
- (xwem-batt-win-remove win))
+ ((:X-Expose :X-MapNotify) (xwem-batt-win-update win t))
+ (:X-DestroyNotify (xwem-batt-win-remove win))
(:X-ButtonPress
(let ((xwem-override-local-map xwem-battery-keymap))
(xwem-dispatch-command-xevent xev)))))
@@ -277,11 +298,11 @@
(xwem-XTrayInit (xwem-dpy) bxwin dockip dockgroup dockalign)
- (X-Win-put-prop bxwin 'xwem-batt-timer
- (start-itimer "xwem-batt"
- `(lambda () (xwem-batt-win-update ,bxwin))
- xwem-batt-update-interval
- xwem-batt-update-interval))
+ (setf (xwem-batt-itimer bxwin)
+ (start-itimer "xwem-batt"
+ `(lambda () (xwem-batt-win-update ,bxwin))
+ xwem-batt-update-interval
+ xwem-batt-update-interval))
'started))
;;;###autoload(autoload 'xwem-battery-status "xwem-battery" nil t)
--- orig/dockapp/xwem-pager.el
+++ mod/dockapp/xwem-pager.el
@@ -252,7 +252,10 @@
(make-X-Pixmap :id (X-Dpy-get-id (xwem-dpy)))
(xwem-pager-xwin xwin)
(XDefaultDepth (xwem-dpy))
- w h)))
+ w h))
+ (when xwem-misc-turbo-mode
+ (XSetWindowBackgroundPixmap (xwem-dpy) xwin
+ (xwem-pager-xpix xwin))))
(xwem-pager-redraw (xwem-pager-xwin xwin) t)))
(defun xwem-pager-frame-redraw (&optional frame)
@@ -298,15 +301,13 @@
DOCKID, DOCKGROUP and DOCKALIGN specifies pager placement in xwem
tray."
(interactive)
- (let* ((pwin
- (XCreateWindow
- (xwem-dpy) nil 0 0 1 1 0
- nil nil nil
- (make-X-Attr :background-pixel
- (X-Gc-foreground
- (xwem-face-get-gc 'xwem-pager-face '(deselected)))
- :backing-store X-WhenMapped
- :override-redirect t))))
+ (let* ((pwin (XCreateWindow
+ (xwem-dpy) nil 0 0 1 1 0
+ nil nil nil
+ (make-X-Attr :event-mask
+ (Xmask-or XM-Exposure XM-StructureNotify
+ XM-ButtonPress XM-ButtonRelease)
+ :override-redirect t))))
;; Set default pager window
(unless (X-Win-p (xwem-pager-xwin))
(setf (xwem-pager-xwin) pwin))
@@ -314,9 +315,7 @@
;; Initialize sizes and stuff
(xwem-pager-redimentionize nil pwin)
- (XSelectInput (xwem-dpy) pwin
- (Xmask-or XM-Exposure XM-StructureNotify
- XM-ButtonPress XM-ButtonRelease))
+ ;; Install events handler
(X-Win-EventHandler-add pwin 'xwem-pager-event-handler nil
(list X-Expose X-DestroyNotify
X-ButtonPress X-ButtonRelease))
--- orig/dockapp/xwem-time.el
+++ mod/dockapp/xwem-time.el
@@ -59,26 +59,35 @@
:prefix "xwem-time-"
:group 'xwem)
-(defcustom xwem-time-display-time t
- "*Non-nil mean display current time."
- :type 'boolean
- :group 'xwem-time)
-
-(defcustom xwem-time-display-load t
- "*Non-nil mean display current CPU load."
- :type 'boolean
- :group 'xwem-time)
-
-(defcustom xwem-time-display-mail t
- "*Non-nil mean display current mail box status."
- :type 'boolean
+(defcustom xwem-time-format '(time load mail)
+ "Format to display time/load/mail.
+List of keywords, where each keyword is either:
+
+ time - Display time
+ load - Display load average
+ mail - Display mail status."
+ :type '(list (choice (const :tag "Time" time)
+ (const :tag "Load average" load)
+ (const :tag "Mail status" mail)))
+ :set (lambda (sym val)
+ (set sym val)
+ (when xwem-time-win
+ (xwem-time-reformat xwem-time-win)))
+ :initialize 'custom-initialize-default
:group 'xwem-time)
+;; Time
(defcustom xwem-time-time-color "#CA1E1C"
"Foreground color to display time."
:type 'color
:group 'xwem-time)
+(defcustom xwem-time-update-interval 1
+ "*Seconds between updates of xwem time window."
+ :type 'integer
+ :group 'xwem-time)
+
+;; Load average
(defcustom xwem-time-load-list
(list 0.10 0.20 0.30 0.40 0.50 0.60 0.80 1.0 1.2 1.5 1.8)
"*A list giving six thresholds for the load
@@ -97,22 +106,16 @@
(number :tag "Threshold 11"))
:group 'xwem-time)
-(defcustom xwem-time-time-interval 20
- "*Seconds between updates of xwem time window."
- :type 'integer
- :group 'xwem-time)
-
(defcustom xwem-time-load-interval 5
"*Seconds between load average updates."
:type 'integer
:group 'xwem-time)
-;;; Internal variables
-
-(defvar xwem-time-last-time nil
- "Last saved time value.")
-(defvar xwem-time-last-load nil
- "Last saved load value.")
+;; Mail
+(defcustom xwem-time-get-mail-function 'xwem-time-default-get-mail
+ "Function to call in order to check mail availability."
+ :type 'function
+ :group 'xwem-time)
(defvar xwem-time-map
(let ((map (make-sparse-keymap)))
@@ -123,10 +126,37 @@
;;; Internal variables
-(defconst xwem-time-window-mask
- (list XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease))
+(defvar xwem-time-dockapp-height 13)
+
+(defconst xwem-time-digit-width 9)
+(defconst xwem-time-ampm-width 4)
+(defconst xwem-time-load-width 10)
+(defconst xwem-time-mail-width 18)
;;; Icons
+(defvar xwem-time-xpm-empty-digit (concat "/* XPM */\n"
+ "static char *noname[] = {\n"
+ "/* width height ncolors
chars_per_pixel */\n"
+ "\"9 13 2 1\",\n"
+ "/* colors */\n"
+ "\"` c None s ledbg\",\n"
+ "\"a c black s ledfg\",\n"
+ "/* pixels */\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\",\n"
+ "\"`````````\"\n"
+ "};\n"))
+
(defvar xwem-time-xpm-time0 '(concat "/* XPM */\n"
"static char *noname[] = {\n"
"/* width height ncolors chars_per_pixel
*/\n"
@@ -771,564 +801,376 @@
-;;; Functions
-(defsubst xwem-time-get-image (win img-type img-name)
- "In WIN's list of IMG-TYPE images get image with name IMG-NAME."
- (plist-get (X-Win-get-prop win img-type) img-name))
-
-(defsubst xwem-time-get-mask (win mask-type mask-name)
- "In WIN's list of MASK-TYPE masks get mask with name MASK-NAME."
- (plist-get (X-Win-get-prop win mask-type) mask-name))
-
-(defsubst xwem-time-get-time-image (win name)
- "In WIN's time images list get image with NAME."
- (xwem-time-get-image win 'xwem-time-images name))
-
-(defsubst xwem-time-get-time-mask (win name)
- "In WIN's time masks list get mask with NAME."
- (xwem-time-get-mask win 'xwem-time-masks name))
-
-(defsubst xwem-time-get-load-image (win name)
- "In WIN's load images list get image with NAME."
- (xwem-time-get-image win 'xwem-load-images name))
-
-(defsubst xwem-time-get-load-mask (win name)
- "In WIN's load masks list get mask with NAME."
- (xwem-time-get-mask win 'xwem-load-masks name))
-
-(defsubst xwem-time-get-mail-image (win name)
- "In WIN's mail images list get image with NAME."
- (xwem-time-get-image win 'xwem-mail-images name))
-
-(defsubst xwem-time-get-mail-mask (win name)
- "In WIN's mail masks list get mask with NAME."
- (xwem-time-get-mask win 'xwem-mail-masks name))
-
-(defsubst xwem-time-put-image (win img-type img-name img-data)
- (X-Win-put-prop win img-type
- (plist-put (X-Win-get-prop win img-type) img-name img-data)))
-
-(defsubst xwem-time-put-time-image (win name img)
- "In WIN's images list put parsed image with NAME.
-Parsed image is IMG."
- (xwem-time-put-image win 'xwem-time-images name img))
-
-(defsubst xwem-time-put-load-image (win name img)
- "In WIN's images list put parsed image with NAME.
-Parsed image is IMG."
- (xwem-time-put-image win 'xwem-load-images name img))
-
-(defsubst xwem-time-put-mail-image (win name img)
- "In WIN's images list put parsed image with NAME.
-Parsed image is IMG."
- (xwem-time-put-image win 'xwem-mail-images name img))
-
-(defun xwem-time-clear-mask (win)
- "Get WIN's mask pixmap and clear it's area."
- (let ((xdpy (X-Win-dpy win))
- (mask-pix (X-Win-get-prop win 'mask-pixmap))
- mgc)
- (setq mgc (XCreateGC xdpy mask-pix
- (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
- :graphics-exposures X-False
- :foreground 0.0
- :background 1.0)))
- (XFillRectangle xdpy mask-pix mgc 0 0 88 15)
- (XFreeGC xdpy mgc)))
-
-(defun xwem-time-init (xdpy)
- (let ((gc-cons-threshold most-positive-fixnum) ; inhibit gcing
- win time-images load-images mail-images
- time-masks load-masks mail-masks
- mask-pix)
- (setq win (XCreateWindow xdpy (XDefaultRootWindow xdpy)
- 0 0 88 15 0 nil nil nil
- (make-X-Attr :background-pixel (XWhitePixel xdpy)
- :border-pixel (XBlackPixel xdpy)
- :backing-store X-Always
- :override-redirect t)))
-
- (setq time-images (list 'time0 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time0))
- 'time1 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time1))
- 'time2 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time2))
- 'time3 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time3))
- 'time4 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time4))
- 'time5 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time5))
- 'time6 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time6))
- 'time7 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time7))
- 'time8 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time8))
- 'time9 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time9))
- 'time-am (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-am))
- 'time-pm (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-pm))
- 'time-dp (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-dp))))
- (setq load-images (list 'load00 (X:xpm-img-from-data xdpy
xwem-time-xpm-load00)
- 'load05 (X:xpm-img-from-data xdpy
xwem-time-xpm-load05)
- 'load10 (X:xpm-img-from-data xdpy
xwem-time-xpm-load10)
- 'load15 (X:xpm-img-from-data xdpy
xwem-time-xpm-load15)
- 'load20 (X:xpm-img-from-data xdpy
xwem-time-xpm-load20)
- 'load25 (X:xpm-img-from-data xdpy
xwem-time-xpm-load25)
- 'load30 (X:xpm-img-from-data xdpy
xwem-time-xpm-load30)
- 'load35 (X:xpm-img-from-data xdpy
xwem-time-xpm-load35)
- 'load40 (X:xpm-img-from-data xdpy
xwem-time-xpm-load40)
- 'load45 (X:xpm-img-from-data xdpy
xwem-time-xpm-load45)
- 'load50 (X:xpm-img-from-data xdpy
xwem-time-xpm-load50)
- 'load55 (X:xpm-img-from-data xdpy
xwem-time-xpm-load55)))
- (setq mail-images (list 'letter (X:xpm-img-from-data xdpy
xwem-time-xpm-letter)
- 'no-letter (X:xpm-img-from-data xdpy
xwem-time-xpm-no-letter)))
-
- (X-Win-put-prop win 'xwem-time-images time-images)
- (X-Win-put-prop win 'xwem-load-images load-images)
- (X-Win-put-prop win 'xwem-mail-images mail-images)
-
- ;; Create masks
- (setq time-masks (list 'time0 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time0) t)
- 'time1 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time1) t)
- 'time2 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time2) t)
- 'time3 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time3) t)
- 'time4 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time4) t)
- 'time5 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time5) t)
- 'time6 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time6) t)
- 'time7 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time7) t)
- 'time8 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time8) t)
- 'time9 (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-time9) t)
- 'time-am (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-am) t)
- 'time-pm (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-pm) t)
- 'time-dp (X:xpm-img-from-data xdpy (eval
xwem-time-xpm-dp) t)))
- (setq load-masks (list 'load00 (X:xpm-img-from-data xdpy
xwem-time-xpm-load00 t)
- 'load05 (X:xpm-img-from-data xdpy
xwem-time-xpm-load05 t)
- 'load10 (X:xpm-img-from-data xdpy
xwem-time-xpm-load10 t)
- 'load15 (X:xpm-img-from-data xdpy
xwem-time-xpm-load15 t)
- 'load20 (X:xpm-img-from-data xdpy
xwem-time-xpm-load20 t)
- 'load25 (X:xpm-img-from-data xdpy
xwem-time-xpm-load25 t)
- 'load30 (X:xpm-img-from-data xdpy
xwem-time-xpm-load30 t)
- 'load35 (X:xpm-img-from-data xdpy
xwem-time-xpm-load35 t)
- 'load40 (X:xpm-img-from-data xdpy
xwem-time-xpm-load40 t)
- 'load45 (X:xpm-img-from-data xdpy
xwem-time-xpm-load45 t)
- 'load50 (X:xpm-img-from-data xdpy
xwem-time-xpm-load50 t)
- 'load55 (X:xpm-img-from-data xdpy
xwem-time-xpm-load55 t)))
- (setq mail-masks (list 'letter (X:xpm-img-from-data xdpy
xwem-time-xpm-letter t)
- 'no-letter (X:xpm-img-from-data xdpy
xwem-time-xpm-no-letter t)))
-
- (X-Win-put-prop win 'xwem-time-masks time-masks)
- (X-Win-put-prop win 'xwem-load-masks load-masks)
- (X-Win-put-prop win 'xwem-mail-masks mail-masks)
-
- (setq mask-pix (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win 1 88 15))
- (X-Win-put-prop win 'mask-pixmap mask-pix)
- (xwem-time-clear-mask win)
-
- ;; Now create pixmaps
- (let (depth gc mgc time-pix load-pix mail-pix)
- (setq depth (XDefaultDepth xdpy))
-
- (setq gc (XCreateGC xdpy win
- (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
- :graphics-exposures X-False
- :function X-GXCopy))
- mgc (XCreateGC xdpy mask-pix
- (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
- :function X-GXCopy
- :graphics-exposures X-False
- :foreground 1.0
- :background 0.0)))
- (X-Win-put-prop win 'time-gc gc)
- (X-Win-put-prop win 'time-mask-gc mgc)
-
- ;; Time
- (setq time-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win depth 107 13)
- (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win 1 107 13)))
- (XImagePut xdpy gc (car time-pix) 0 0 (xwem-time-get-time-image
win 'time0))
- (XImagePut xdpy gc (car time-pix) 9 0 (xwem-time-get-time-image
win 'time1))
- (XImagePut xdpy gc (car time-pix) 18 0 (xwem-time-get-time-image
win 'time2))
- (XImagePut xdpy gc (car time-pix) 27 0 (xwem-time-get-time-image
win 'time3))
- (XImagePut xdpy gc (car time-pix) 36 0 (xwem-time-get-time-image
win 'time4))
- (XImagePut xdpy gc (car time-pix) 45 0 (xwem-time-get-time-image
win 'time5))
- (XImagePut xdpy gc (car time-pix) 54 0 (xwem-time-get-time-image
win 'time6))
- (XImagePut xdpy gc (car time-pix) 63 0 (xwem-time-get-time-image
win 'time7))
- (XImagePut xdpy gc (car time-pix) 72 0 (xwem-time-get-time-image
win 'time8))
- (XImagePut xdpy gc (car time-pix) 81 0 (xwem-time-get-time-image
win 'time9))
- (XImagePut xdpy gc (car time-pix) 90 0 (xwem-time-get-time-image
win 'time-dp))
- (XImagePut xdpy gc (car time-pix) 99 0 (xwem-time-get-time-image
win 'time-am)) ; 4 pixels width
- (XImagePut xdpy gc (car time-pix) 103 0 (xwem-time-get-time-image
win 'time-pm)) ; 4 pixels width
-
- (XImagePut xdpy mgc (cdr time-pix) 0 0 (xwem-time-get-time-mask win
'time0))
- (XImagePut xdpy mgc (cdr time-pix) 9 0 (xwem-time-get-time-mask win
'time1))
- (XImagePut xdpy mgc (cdr time-pix) 18 0 (xwem-time-get-time-mask win
'time2))
- (XImagePut xdpy mgc (cdr time-pix) 27 0 (xwem-time-get-time-mask win
'time3))
- (XImagePut xdpy mgc (cdr time-pix) 36 0 (xwem-time-get-time-mask win
'time4))
- (XImagePut xdpy mgc (cdr time-pix) 45 0 (xwem-time-get-time-mask win
'time5))
- (XImagePut xdpy mgc (cdr time-pix) 54 0 (xwem-time-get-time-mask win
'time6))
- (XImagePut xdpy mgc (cdr time-pix) 63 0 (xwem-time-get-time-mask win
'time7))
- (XImagePut xdpy mgc (cdr time-pix) 72 0 (xwem-time-get-time-mask win
'time8))
- (XImagePut xdpy mgc (cdr time-pix) 81 0 (xwem-time-get-time-mask win
'time9))
- (XImagePut xdpy mgc (cdr time-pix) 90 0 (xwem-time-get-time-mask win
'time-dp))
- (XImagePut xdpy mgc (cdr time-pix) 99 0 (xwem-time-get-time-mask win
'time-am)) ; 4 pixels width
- (XImagePut xdpy mgc (cdr time-pix) 103 0 (xwem-time-get-time-mask win
'time-pm)) ; 4 pixels width
- (X-Win-put-prop win 'time-pixmap time-pix)
-
- ;; Load
- (setq load-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win depth 120 13)
- (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win 1 120 13)))
- (XImagePut xdpy gc (car load-pix) 0 0 (xwem-time-get-load-image
win 'load00))
- (XImagePut xdpy gc (car load-pix) 10 0 (xwem-time-get-load-image
win 'load05))
- (XImagePut xdpy gc (car load-pix) 20 0 (xwem-time-get-load-image
win 'load10))
- (XImagePut xdpy gc (car load-pix) 30 0 (xwem-time-get-load-image
win 'load15))
- (XImagePut xdpy gc (car load-pix) 40 0 (xwem-time-get-load-image
win 'load20))
- (XImagePut xdpy gc (car load-pix) 50 0 (xwem-time-get-load-image
win 'load25))
- (XImagePut xdpy gc (car load-pix) 60 0 (xwem-time-get-load-image
win 'load30))
- (XImagePut xdpy gc (car load-pix) 70 0 (xwem-time-get-load-image
win 'load35))
- (XImagePut xdpy gc (car load-pix) 80 0 (xwem-time-get-load-image
win 'load40))
- (XImagePut xdpy gc (car load-pix) 90 0 (xwem-time-get-load-image
win 'load45))
- (XImagePut xdpy gc (car load-pix) 100 0 (xwem-time-get-load-image
win 'load50))
- (XImagePut xdpy gc (car load-pix) 110 0 (xwem-time-get-load-image
win 'load55))
-
- (XImagePut xdpy mgc (cdr load-pix) 0 0 (xwem-time-get-load-mask
win 'load00))
- (XImagePut xdpy mgc (cdr load-pix) 10 0 (xwem-time-get-load-mask
win 'load05))
- (XImagePut xdpy mgc (cdr load-pix) 20 0 (xwem-time-get-load-mask
win 'load10))
- (XImagePut xdpy mgc (cdr load-pix) 30 0 (xwem-time-get-load-mask
win 'load15))
- (XImagePut xdpy mgc (cdr load-pix) 40 0 (xwem-time-get-load-mask
win 'load20))
- (XImagePut xdpy mgc (cdr load-pix) 50 0 (xwem-time-get-load-mask
win 'load25))
- (XImagePut xdpy mgc (cdr load-pix) 60 0 (xwem-time-get-load-mask
win 'load30))
- (XImagePut xdpy mgc (cdr load-pix) 70 0 (xwem-time-get-load-mask
win 'load35))
- (XImagePut xdpy mgc (cdr load-pix) 80 0 (xwem-time-get-load-mask
win 'load40))
- (XImagePut xdpy mgc (cdr load-pix) 90 0 (xwem-time-get-load-mask
win 'load45))
- (XImagePut xdpy mgc (cdr load-pix) 100 0 (xwem-time-get-load-mask
win 'load50))
- (XImagePut xdpy mgc (cdr load-pix) 110 0 (xwem-time-get-load-mask
win 'load55))
- (X-Win-put-prop win 'load-pixmap load-pix)
-
- ;; Mail
- (setq mail-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win depth 36 13)
- (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id
(X-Dpy-get-id xdpy))
- win 1 36 13)))
- (XImagePut xdpy gc (car mail-pix) 0 0 (xwem-time-get-mail-image win
'letter))
- (XImagePut xdpy gc (car mail-pix) 18 0 (xwem-time-get-mail-image win
'no-letter))
-
- (XImagePut xdpy mgc (cdr mail-pix) 0 0 (xwem-time-get-mail-mask win
'letter))
- (XImagePut xdpy mgc (cdr mail-pix) 18 0 (xwem-time-get-mail-mask win
'no-letter))
- (X-Win-put-prop win 'mail-pixmap mail-pix)
+;;; Huge amount of macroses
+(defvar xwem-time-win nil)
- )
-
- win))
+(defmacro xwem-time-win (&optional win)
+ `(or ,win xwem-time-win))
+(defsetf xwem-time-win () (win)
+ `(setq xwem-time-win ,win))
+(defmacro xwem-time-get-prop (win prop)
+ `(X-Win-get-prop (xwem-time-win ,win) ,prop))
+(defmacro xwem-time-set-prop (win prop val)
+ `(X-Win-put-prop (xwem-time-win ,win) ,prop ,val))
+
+(defmacro xwem-time-mask (&optional win)
+ `(xwem-time-get-prop ,win 'time-mask))
+(defsetf xwem-time-mask (&optional win) (mask)
+ `(xwem-time-set-prop ,win 'time-mask ,mask))
+
+(defmacro xwem-time-pixmap (&optional win)
+ `(xwem-time-get-prop ,win 'time-pixmap))
+(defsetf xwem-time-pixmap (&optional win) (pixmap)
+ `(xwem-time-set-prop ,win 'time-pixmap ,pixmap))
+
+;; Digits operations
+(defmacro xwem-time-digits-pixmaps (&optional win)
+ `(xwem-time-get-prop ,win 'time-digits-pixmaps))
+(defsetf xwem-time-digits-pixmaps (&optional win) (pixs)
+ `(xwem-time-set-prop ,win 'time-digits-pixmaps ,pixs))
+(defmacro xwem-time-digit-add (win digit pix pix-mask)
+ `(setf (xwem-time-digits-pixmaps ,win)
+ (cons (cons ,digit (cons ,pix ,pix-mask))
+ (xwem-time-digits-pixmaps ,win))))
+(defmacro xwem-time-digit-get-pix (win digit)
+ `(car (cdr (assq ,digit (xwem-time-digits-pixmaps ,win)))))
+(defmacro xwem-time-digit-get-mask (win digit)
+ `(cdr (cdr (assq ,digit (xwem-time-digits-pixmaps ,win)))))
+
+;; Load operations
+(defmacro xwem-time-load-pixmaps (&optional win)
+ `(xwem-time-get-prop ,win 'time-load-pixmaps))
+(defsetf xwem-time-load-pixmaps (&optional win) (pixs)
+ `(xwem-time-set-prop ,win 'time-load-pixmaps ,pixs))
+(defmacro xwem-time-load-add (win load pix pix-mask)
+ `(setf (xwem-time-load-pixmaps ,win)
+ (cons (cons ,load (cons ,pix ,pix-mask))
+ (xwem-time-load-pixmaps ,win))))
+(defmacro xwem-time-load-get-pix (win load)
+ `(car (cdr (assq ,load (xwem-time-load-pixmaps ,win)))))
+(defmacro xwem-time-load-get-mask (win load)
+ `(cdr (cdr (assq ,load (xwem-time-load-pixmaps ,win)))))
+
+;; Mail operations
+(defmacro xwem-time-mail-pixmaps (&optional win)
+ `(xwem-time-get-prop ,win 'time-mail-pixmaps))
+(defsetf xwem-time-mail-pixmaps (&optional win) (pixs)
+ `(xwem-time-set-prop ,win 'time-mail-pixmaps ,pixs))
+(defmacro xwem-time-mail-add (win mail pix pix-mask)
+ `(setf (xwem-time-mail-pixmaps ,win)
+ (cons (cons ,mail (cons ,pix ,pix-mask))
+ (xwem-time-mail-pixmaps ,win))))
+(defmacro xwem-time-mail-get-pix (win mail)
+ `(car (cdr (assq ,mail (xwem-time-mail-pixmaps ,win)))))
+(defmacro xwem-time-mail-get-mask (win mail)
+ `(cdr (cdr (assq ,mail (xwem-time-mail-pixmaps ,win)))))
+
+;; General macroses
+(defmacro xwem-time-saved-state (&optional win)
+ `(xwem-time-get-prop (xwem-time-win ,win) 'time-saved-state))
+(defsetf xwem-time-saved-state (&optional win) (state)
+ `(xwem-time-set-prop (xwem-time-win ,win) 'time-saved-state ,state))
+(defmacro xwem-time-get-state (win state)
+ `(plist-get (xwem-time-saved-state ,win) ,state))
+(defmacro xwem-time-set-state (win state val)
+ `(setf (xwem-time-saved-state ,win)
+ (plist-put (xwem-time-saved-state ,win) ,state ,val)))
+
+(defmacro xwem-time-itimer (&optional win)
+ `(xwem-time-get-prop ,win 'time-itimer))
+(defsetf xwem-time-itimer (&optional win) (itimer)
+ `(xwem-time-set-prop ,win 'time-itimer ,itimer))
+
+;; Format related stuff
+(defsubst xwem-time-format-tag-width (tag)
+ (ecase tag
+ (time (* 5 xwem-time-digit-width))
+ (load xwem-time-load-width)
+ (mail xwem-time-mail-width)))
+(defmacro xwem-time-format-offset (tag)
+ `(let ((fmt xwem-time-format)
+ (off 0))
+ (while (and fmt (not (eq (car fmt) ,tag)))
+ (incf off (xwem-time-format-tag-width (car fmt)))
+ (setq fmt (cdr fmt)))
+ off))
+(defmacro xwem-time-format-width ()
+ `(apply '+ (mapcar 'xwem-time-format-tag-width xwem-time-format)))
+(defmacro xwem-time-format-height ()
+ 'xwem-time-dockapp-height)
-;; Offsets calculators
-(defsubst xwem-time-time-offset (num)
- (* num 9))
-(defsubst xwem-time-timeam-offset ()
- (* 10 9))
-(defsubst xwem-time-timepm-offset ()
- (+ (* 10 9) 4))
-
-(defsubst xwem-time-load-offset (load)
- (truncate (* load 20)))
-
-(defsubst xwem-time-mail-offset (letter-p)
- (if letter-p 0 18))
-
-;; Showers
-(defun xwem-time-show (win x y type x-off y-off width height)
- (let ((pixmap (X-Win-get-prop win type))
- (mask-pixmap (X-Win-get-prop win 'mask-pixmap)))
-
- (let* ((xdpy (X-Pixmap-dpy mask-pixmap)))
- (XSelectInput xdpy win (apply 'Xmask-or (delete XM-Exposure
xwem-time-window-mask)))
-
- (XCopyArea xdpy (cdr pixmap) mask-pixmap
- (X-Win-get-prop win 'time-mask-gc)
- x-off y-off width height x y)
- (X-XShapeMask xdpy win X-XShape-Bounding X-XShapeSet 0 0 mask-pixmap)
- (XCopyArea (X-Win-dpy win) (car pixmap) win
- (X-Win-get-prop win 'time-gc)
- x-off y-off width height x y)
-
- (XSelectInput xdpy win (apply 'Xmask-or xwem-time-window-mask))
- )))
-
-(defsubst xwem-time-show-time0 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 0 0 9 13))
-
-(defsubst xwem-time-show-time1 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 9 0 9 13))
-
-(defsubst xwem-time-show-time2 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 18 0 9 13))
-
-(defsubst xwem-time-show-time3 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 27 0 9 13))
-
-(defsubst xwem-time-show-time4 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 36 0 9 13))
-
-(defsubst xwem-time-show-time5 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 45 0 9 13))
-
-(defsubst xwem-time-show-time6 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 54 0 9 13))
-
-(defsubst xwem-time-show-time7 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 63 0 9 13))
-
-(defsubst xwem-time-show-time8 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 72 0 9 13))
-
-(defsubst xwem-time-show-time9 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 81 0 9 13))
-
-(defsubst xwem-time-show-time-dp (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 90 0 9 13))
-
-(defsubst xwem-time-show-time-am (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 99 0 4 13))
-
-(defsubst xwem-time-show-time-pm (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'time-pixmap 103 0 4 13))
-
-(defsubst xwem-time-show-load-00 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 0 0 10 13))
-
-(defsubst xwem-time-show-load-05 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 10 0 10 13))
-
-(defsubst xwem-time-show-load-10 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 20 0 10 13))
-
-(defsubst xwem-time-show-load-15 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 30 0 10 13))
-
-(defsubst xwem-time-show-load-20 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 40 0 10 13))
-
-(defsubst xwem-time-show-load-25 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 50 0 10 13))
-
-(defsubst xwem-time-show-load-30 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 60 0 10 13))
-
-(defsubst xwem-time-show-load-35 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 70 0 10 13))
-
-(defsubst xwem-time-show-load-40 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 80 0 10 13))
-
-(defsubst xwem-time-show-load-45 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 90 0 10 13))
-
-(defsubst xwem-time-show-load-50 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 100 0 10 13))
-
-(defsubst xwem-time-show-load-55 (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'load-pixmap 110 0 10 13))
-
-(defsubst xwem-time-show-letter (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'mail-pixmap 00 0 18 13))
-
-(defsubst xwem-time-show-no-letter (win x y)
- "Show 0 at WIN's X Y."
- (xwem-time-show win x y 'mail-pixmap 18 0 18 13))
-
-(defun xwem-time-show-load (win x y load-number)
- "In WIN at X Y show load average represented by LOAD-STRING.
-Return how many pixels used."
- (let ((alist (list (cons "00" 0.0)
- (cons "05" (nth 0 xwem-time-load-list))
- (cons "10" (nth 1 xwem-time-load-list))
- (cons "15" (nth 2 xwem-time-load-list))
- (cons "20" (nth 3 xwem-time-load-list))
- (cons "25" (nth 4 xwem-time-load-list))
- (cons "30" (nth 5 xwem-time-load-list))
- (cons "35" (nth 6 xwem-time-load-list))
- (cons "40" (nth 7 xwem-time-load-list))
- (cons "45" (nth 8 xwem-time-load-list))
- (cons "50" (nth 9 xwem-time-load-list))
- (cons "55" (nth 10 xwem-time-load-list))
- (cons "100000" 100000)))
+;;; Functions
+(defun xwem-time-get-time ()
+ "Return current time in format acceptable by `xwem-time-update-time'."
+ (mapcar 'identity (substring (current-time-string) 11 16)))
+
+(defun xwem-time-get-load ()
+ "Return load average in format acceptable by `xwem-time-update-load'."
+ (let ((alist (list (cons 0 0.0)
+ (cons 5 (nth 0 xwem-time-load-list))
+ (cons 10 (nth 1 xwem-time-load-list))
+ (cons 15 (nth 2 xwem-time-load-list))
+ (cons 20 (nth 3 xwem-time-load-list))
+ (cons 25 (nth 4 xwem-time-load-list))
+ (cons 30 (nth 5 xwem-time-load-list))
+ (cons 35 (nth 6 xwem-time-load-list))
+ (cons 40 (nth 7 xwem-time-load-list))
+ (cons 45 (nth 8 xwem-time-load-list))
+ (cons 50 (nth 9 xwem-time-load-list))
+ (cons 55 (nth 10 xwem-time-load-list))
+ (cons 100000 100000)))
+ (load-number (car (load-average t)))
elem load-elem)
(while (>= load-number (cdr (setq elem (pop alist))))
(setq load-elem elem))
- (funcall (intern-soft (concat "xwem-time-show-load-" (car load-elem))) win
x y))
- 10)
-
-(defun xwem-time-show-time (win x y time-string)
- "In WIN at X Y show time represented by TIME-STRING.
-Return how may pixels used."
- (let ((off 0)
- el)
- (while (> (length time-string) 0)
- (setq el (substring time-string 0 1))
- (cond ((string= el ":")
- (xwem-time-show-time-dp win (+ x off) y)
- (setq off (+ off 9)))
- ((string= el "a")
- (xwem-time-show-time-am win (+ x off) y)
- (setq off (+ off 4)))
- ((string= el "p")
- (xwem-time-show-time-pm win (+ x off) y)
- (setq off (+ off 4)))
- ((string= el " ")
- (setq off (+ off 9)))
- (t (funcall (intern-soft (concat "xwem-time-show-time" el)) win (+
x off) y)
- (setq off (+ off 9))))
- (setq time-string (substring time-string 1)))
- off))
-
-(defun xwem-time-show-mail (win x y mail)
- "In WIN at X Y show current mail status.
-Return how many pixels used."
- (if mail
- (xwem-time-show-letter win x y)
- (xwem-time-show-no-letter win x y))
- 18)
+ (car load-elem)))
-(define-xwem-deffered xwem-time-win-update (win)
- "Show current time at X Y."
+(defun xwem-time-default-get-mail ()
+ "Default function to search for new mail."
(let* ((now (current-time))
- (nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536))
- (time (substring (current-time-string now) 11 16))
- (load (car (load-average t)))
+ (nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536))
(mail-spool-file (or display-time-mail-file
(getenv "MAIL")
(concat rmail-spool-directory
(user-login-name))))
- (mail (and (stringp mail-spool-file)
- (or (null display-time-server-down-time)
- ;; If have been down for 20 min, try again.
- (> (- (+ (nth 1 now) nowhigh)
- display-time-server-down-time)
- 1200))
- (let ((start-time (current-time)))
- (prog1
- (display-time-file-nonempty-p mail-spool-file)
- (setq now (current-time)
- nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10)
10)) 65536))
- (if (> (- (+ (nth 1 now) nowhigh)
- (+ (nth 1 start-time)
- (* (- (nth 0 start-time)
+ (mail (and (stringp mail-spool-file)
+ (or (null display-time-server-down-time)
+ ;; If have been down for 20 min, try again.
+ (> (- (+ (nth 1 now) nowhigh)
+ display-time-server-down-time)
+ 1200))
+ (let ((start-time (current-time)))
+ (prog1
+ (display-time-file-nonempty-p mail-spool-file)
+ (setq now (current-time)
+ nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10)
10)) 65536))
+ (if (> (- (+ (nth 1 now) nowhigh)
+ (+ (nth 1 start-time)
+ (* (- (nth 0 start-time)
(* (/ (nth 0 start-time) 10) 10))
65536)))
- 20)
- ;; Record that mail file is not accessible.
- (setq display-time-server-down-time
- (+ (nth 1 now) nowhigh))
- ;; Record that mail file is accessible.
- (setq display-time-server-down-time nil))))))
- off)
-
- (xwem-time-clear-mask win)
- (setq off (+ 5 (xwem-time-show-time win 0 0 time)))
- (setq off (+ off 5 (xwem-time-show-load win off 0 load)))
- (xwem-time-show-mail win off 0 mail)))
-
-(defun xwem-time-load-update (win)
- "Update load average."
- (let* ((old-avg xwem-time-last-load)
- (load-avg (load-average t)))
- (when (or (null old-avg)
- (> (abs (- old-avg (car load-avg))) 0.1))
- (setq xwem-time-last-load (car load-avg))
- (xwem-time-show-load win 50 0 (car load-avg)))))
+ 20)
+ ;; Record that mail file is not accessible.
+ (setq display-time-server-down-time
+ (+ (nth 1 now) nowhigh))
+ ;; Record that mail file is accessible.
+ (setq display-time-server-down-time nil)))))))
+ (or (and mail 'letter) 'no-letter)))
+
+(defun xwem-time-get-mail ()
+ "Return mail status in format acceptable by `xwem-time-update-mail'."
+ (if xwem-time-get-mail-function
+ (if (funcall xwem-time-get-mail-function)
+ 'letter
+ 'no-letter)
+ (xwem-time-default-get-mail)))
+
+(define-xwem-deffered xwem-time-update (win)
+ "Update time window WIN."
+ (X-XShapeMask (xwem-dpy) win X-XShape-Bounding X-XShapeSet 0 0
+ (xwem-time-mask win))
+ (XCopyArea (xwem-dpy) (xwem-time-pixmap win) win
+ (XDefaultGC (xwem-dpy)) 0 0
+ (xwem-time-format-width) (xwem-time-format-height)
+ 0 0))
+
+(defun xwem-time-update-digit (win digit-position digit)
+ "Update WIN's DIGIT-POSITION to display DIGIT."
+ (let ((off (+ (xwem-time-format-offset 'time)
+ (* digit-position xwem-time-digit-width))))
+ (XCopyArea (xwem-dpy) (xwem-time-digit-get-mask win digit)
+ (xwem-time-mask win) xwem-misc-mask-fgc 0
+ xwem-time-digit-width xwem-time-dockapp-height
+ off 0)
+ (XCopyArea (xwem-dpy) (xwem-time-digit-get-pix win digit)
+ (xwem-time-pixmap win) (XDefaultGC (xwem-dpy)) 0 0
+ xwem-time-digit-width xwem-time-dockapp-height
+ off 0)
+ (xwem-time-update win)))
+
+(defun xwem-time-update-time (win new-time)
+ "Update WIN to display NEW-TIME."
+ (let ((st (or (xwem-time-get-state win 'time) '(-1 -1 -1 -1 -1)))
+ (dpos 0))
+ (mapc (lambda (t1 t2)
+ (unless (= t1 t2)
+ (xwem-time-update-digit win dpos t2))
+ (incf dpos))
+ st new-time)
+ (xwem-time-set-state win 'time new-time)))
+
+(defun xwem-time-update-load (win new-load)
+ "Update WIN to display NEW-LOAD."
+ (let ((sl (or (xwem-time-get-state win 'load) -1)))
+ (unless (= sl new-load)
+ (let ((off (xwem-time-format-offset 'load)))
+ (XCopyArea (xwem-dpy) (xwem-time-load-get-mask win new-load)
+ (xwem-time-mask win) xwem-misc-mask-fgc 0 0
+ xwem-time-load-width xwem-time-dockapp-height
+ off 0)
+ (XCopyArea (xwem-dpy) (xwem-time-load-get-pix win new-load)
+ (xwem-time-pixmap win) (XDefaultGC (xwem-dpy)) 0 0
+ xwem-time-load-width xwem-time-dockapp-height
+ off 0)
+ (xwem-time-update win)))
+ (xwem-time-set-state win 'load new-load)))
+
+(defun xwem-time-update-mail (win new-mail)
+ "Update WIN to display NEW-MAIL."
+ (let ((sl (xwem-time-get-state win 'mail)))
+ (unless (eq sl new-mail)
+ (let ((off (xwem-time-format-offset 'mail)))
+ (XCopyArea (xwem-dpy) (xwem-time-mail-get-mask win new-mail)
+ (xwem-time-mask win) xwem-misc-mask-fgc 0 0
+ xwem-time-mail-width xwem-time-dockapp-height
+ off 0)
+ (XCopyArea (xwem-dpy) (xwem-time-mail-get-pix win new-mail)
+ (xwem-time-pixmap win) (XDefaultGC (xwem-dpy)) 0 0
+ xwem-time-mail-width xwem-time-dockapp-height
+ off 0)
+ (xwem-time-update win)))
+ (xwem-time-set-state win 'mail new-mail)))
+
+(defun xwem-time-create-win (xdpy)
+ "On display XDPY create time dockapp window."
+ (let ((gc-cons-threshold most-positive-fixnum) ; inhibit gc
+ (win (XCreateWindow xdpy (XDefaultRootWindow xdpy)
+ 0 0 (xwem-time-format-width)
+ (xwem-time-format-height) 0
+ nil nil nil
+ (make-X-Attr :event-mask (Xmask-or XM-Exposure
XM-StructureNotify
+ XM-ButtonPress
XM-ButtonRelease)
+ :override-redirect t))))
+ ;; Create mask pixmap and bs pixmap
+ (setf (xwem-time-mask win)
+ (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy) :id
(X-Dpy-get-id (xwem-dpy)))
+ win 1 (xwem-time-format-width)
(xwem-time-format-height)))
+ (XFillRectangle (xwem-dpy) (xwem-time-mask win)
+ xwem-misc-mask-bgc 0 0 (xwem-time-format-width)
(xwem-time-format-height))
+
+ (setf (xwem-time-pixmap win)
+ (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy)
+ :id (X-Dpy-get-id
(xwem-dpy)))
+ win (XDefaultDepth (xwem-dpy))
+ (xwem-time-format-width) (xwem-time-format-height)))
+ (when xwem-misc-turbo-mode
+ (XSetWindowBackgroundPixmap (xwem-dpy) win (xwem-time-pixmap win)))
+
+; (XFillRectangle (xwem-dpy) (xwem-time-pixmap win)
+; (XDefaultGC (xwem-dpy)) 0 0
+; (xwem-time-format-width) (xwem-time-format-height))
+
+ ;; Load digits pixmaps
+ (mapc (lambda (digit)
+ (let* ((sym (intern (format "xwem-time-xpm-time%c" digit)))
+ (sval (symbol-value sym)))
+ (xwem-time-digit-add
+ win digit (X:xpm-pixmap-from-data xdpy win (eval sval))
+ (X:xpm-pixmap-from-data xdpy win (eval sval) t))))
+ "0123456789")
+ ;; Empty digit and Colon
+ (xwem-time-digit-add win ?\x20 (X:xpm-pixmap-from-data xdpy win
xwem-time-xpm-empty-digit)
+ (X:xpm-pixmap-from-data xdpy win
xwem-time-xpm-empty-digit t))
+ (xwem-time-digit-add win ?: (X:xpm-pixmap-from-data xdpy win (eval
xwem-time-xpm-dp))
+ (X:xpm-pixmap-from-data xdpy win (eval
xwem-time-xpm-dp) t))
+
+ ;; Load load pixmaps
+ (mapc (lambda (load)
+ (let* ((sym (intern (format "xwem-time-xpm-load%.2d" load)))
+ (sval (symbol-value sym)))
+ (xwem-time-load-add
+ win load (X:xpm-pixmap-from-data xdpy win sval)
+ (X:xpm-pixmap-from-data xdpy win sval t))))
+ (loop for i from 0 to 55 by 5 collect i))
+
+ ;; Load mail pixmaps
+ (xwem-time-mail-add win 'letter (X:xpm-pixmap-from-data xdpy win
xwem-time-xpm-letter)
+ (X:xpm-pixmap-from-data xdpy win xwem-time-xpm-letter
t))
+ (xwem-time-mail-add win 'no-letter (X:xpm-pixmap-from-data xdpy win
xwem-time-xpm-no-letter)
+ (X:xpm-pixmap-from-data xdpy win
xwem-time-xpm-no-letter t))
-(defun xwem-time-event-handler (xdpy win xev)
- "On display XDPY and window WIN handle event XEV."
- (X-Event-CASE xev
- ((:X-Expose :X-MapNotify)
- (xwem-time-win-update win))
+ ;; Install event handler
+ (X-Win-EventHandler-add win 'xwem-time-event-handler nil
+ (list X-Expose X-MapNotify X-DestroyNotify
+ X-ButtonPress X-ButtonRelease))
+
+ ;; Set default time window
+ (unless xwem-time-win
+ (setq xwem-time-win win))
+
+ ;; Initial mask
+ (XFillRectangle xdpy (xwem-time-mask win) xwem-misc-mask-bgc 0 0
+ (xwem-time-format-width) (xwem-time-format-height))
+ (X-XShapeMask (xwem-dpy) win X-XShape-Bounding X-XShapeSet 0 0
+ (xwem-time-mask win))
- (:X-DestroyNotify
- ;; Release used resources
- (delete-itimer (X-Win-get-prop win 'xwem-time-timer))
- (delete-itimer (X-Win-get-prop win 'xwem-time-load))
+ win))
+
+(defun xwem-time-maybe-update (win)
+ "Update WIN."
+ (when (memq 'time xwem-time-format)
+ (xwem-time-update-time win (xwem-time-get-time)))
+ (when (memq 'load xwem-time-format)
+ (xwem-time-update-load win (xwem-time-get-load)))
+ (when (memq 'mail xwem-time-format)
+ (xwem-time-update-mail win (xwem-time-get-mail)))
+
+ (unless (xwem-time-itimer win)
+ (setf (xwem-time-itimer win)
+ (start-itimer "xwem-time-update" 'xwem-time-maybe-update
+ xwem-time-update-interval xwem-time-update-interval
+ nil t win))))
+
+(defun xwem-time-remove (win &optional no-destroy)
+ "Destroy win."
+ (when (xwem-time-itimer win)
+ (delete-itimer (xwem-time-itimer win))
+ (setf (xwem-time-itimer win) nil))
- (let (cp)
- (setq cp (X-Win-get-prop win 'mail-pixmap))
- (XFreePixmap (xwem-dpy) (car cp))
- (XFreePixmap (xwem-dpy) (cdr cp))
- (setq cp (X-Win-get-prop win 'load-pixmap))
- (XFreePixmap (xwem-dpy) (car cp))
- (XFreePixmap (xwem-dpy) (cdr cp))
- (setq cp (X-Win-get-prop win 'time-pixmap))
- (XFreePixmap (xwem-dpy) (car cp))
- (XFreePixmap (xwem-dpy) (cdr cp)))
-
- (XFreePixmap (xwem-dpy) (X-Win-get-prop win 'mask-pixmap))
- (XFreeGC (xwem-dpy) (X-Win-get-prop win 'time-gc))
- (XFreeGC (xwem-dpy) (X-Win-get-prop win 'time-mask-gc))
-
- ;; Remove properties
- (X-Win-rem-prop win 'xwem-time-timer)
- (X-Win-rem-prop win 'xwem-time-load)
- (X-Win-rem-prop win 'xwem-time-images)
- (X-Win-rem-prop win 'xwem-load-images)
- (X-Win-rem-prop win 'xwem-mail-images)
- (X-Win-rem-prop win 'xwem-time-masks)
- (X-Win-rem-prop win 'xwem-load-masks)
- (X-Win-rem-prop win 'xwem-mail-masks)
- (X-Win-rem-prop win 'mail-pixmap)
- (X-Win-rem-prop win 'load-pixmap)
- (X-Win-rem-prop win 'time-pixmap)
- (X-Win-rem-prop win 'mask-pixmap)
- (X-Win-rem-prop win 'time-gc)
- (X-Win-rem-prop win 'time-mask-gc))
+ (mapc (lambda (pp)
+ (XFreePixmap (xwem-dpy) (car (cdr pp)))
+ (XFreePixmap (xwem-dpy) (cdr (cdr pp))))
+ (append (xwem-time-digits-pixmaps win)
+ (xwem-time-load-pixmaps win)
+ (xwem-time-mail-pixmaps win)))
+
+ (XFreePixmap (xwem-dpy) (xwem-time-mask win))
+ (XFreePixmap (xwem-dpy) (xwem-time-pixmap win))
+
+ (setf (xwem-time-digits-pixmaps win) nil
+ (xwem-time-load-pixmaps win) nil
+ (xwem-time-mail-pixmaps win) nil
+ (xwem-time-mask win) nil
+ (xwem-time-pixmap win) nil
+ (xwem-time-saved-state win) nil)
+
+ ;; Remove event handler
+ (X-Win-EventHandler-rem win 'xwem-time-event-handler)
+
+ ;; Unset default xwem-time-win
+ (when (eq xwem-time-win win)
+ (setq xwem-time-win nil))
+
+ (unless no-destroy
+ (XDestroyWindow (xwem-dpy) win)))
+(defun xwem-time-event-handler (xdpy win xev)
+ "On display XDPY and window WIN handle event XEV."
+ (X-Event-CASE xev
+ (:X-MapNotify (xwem-time-maybe-update win))
+ (:X-Expose (xwem-time-update win))
+ (:X-DestroyNotify (xwem-time-remove win t))
((:X-ButtonPress :X-ButtonRelease)
(let ((xwem-override-local-map xwem-time-map))
- (xwem-dispatch-command-xevent xev)))
- ))
+ (xwem-dispatch-command-xevent xev)))))
;;;###autoload
(defun xwem-time (&optional dockid dockgroup dockalign)
"Start xwem time window in system tray."
- (let ((xtw (xwem-time-init (xwem-dpy))))
- (unless (X-Win-p xtw)
- (error 'xwem-error "Can't create xwem time window"))
-
- (XSelectInput (xwem-dpy) xtw (apply 'Xmask-or xwem-time-window-mask))
- (X-Win-EventHandler-add xtw 'xwem-time-event-handler nil
- (list X-Expose X-MapNotify X-DestroyNotify
- X-ButtonPress X-ButtonRelease))
-
- (xwem-XTrayInit (xwem-dpy) xtw dockid dockgroup dockalign)
-
- (X-Win-put-prop xtw 'xwem-time-timer
- (start-itimer "xwem-time-time"
- `(lambda () (xwem-time-win-update ,xtw))
- xwem-time-time-interval
xwem-time-time-interval))
- (X-Win-put-prop xtw 'xwem-time-load
- (start-itimer "xwem-time-load"
- `(lambda () (xwem-time-load-update ,xtw))
- xwem-time-load-interval
xwem-time-load-interval))
- 'started))
+ (interactive)
+ (xwem-XTrayInit (xwem-dpy) (xwem-time-create-win (xwem-dpy))
+ dockid dockgroup dockalign)
+ 'started)
(define-xwem-command xwem-time-show-current-time-and-date ()
"Display current time and date in the minibuffer."
@@ -1343,12 +1185,12 @@
(unless (button-event-p xwem-last-event)
(error 'xwem-error "`xwem-time-popup-menu' must be bound to mouse event"))
- (let ((twin (X-Event-win xwem-last-xevent)))
- (xwem-popup-menu
- (list "Time"
- (vector "Show Time" 'xwem-time-show-current-time-and-date)
- "---"
- (vector "Destroy" `(XDestroyWindow (xwem-dpy) ,twin))))))
+ ;; XXX
+ (xwem-popup-menu
+ (list "Time"
+ (vector "Show Time" 'xwem-time-show-current-time-and-date)
+ "---"
+ (vector "Destroy" `(xwem-time-remove , (X-Event-win
xwem-last-xevent))))))
(provide 'xwem-time)
--- orig/lisp/xwem-clients.el
+++ mod/lisp/xwem-clients.el
@@ -237,13 +237,19 @@
;;;###autoload
(defcustom xwem-cl-activate-hook nil
- "*Hooks to be called with just setuped CL as argument."
+ "*Hooks to call when client activates.
+Called with two arguments:
+ CL - Activated client
+ TYPE - Activation type - either 'activate or 'select"
:type 'hook
:group 'xwem-hooks)
;;;###autoload
(defcustom xwem-cl-deactivate-hook nil
- "*Hooks to be called with just desetuped CL as argument."
+ "*Hooks to call when client deactivates.
+Called with two arguments:
+ CL - Deactivated client
+ TYPE - Deactivation type - either 'deactivate or 'deselect"
:type 'hook
:group 'xwem-hooks)
@@ -390,7 +396,16 @@
(defun xwem-client-set-property (cl prop val)
"Set client property."
(funcall (xwem-clprop-get-keyword cl prop :set 'xwem-cl-put-prop)
- cl prop val))
+ cl prop val)
+ ;; Save new properties in CL's plist XProperty
+ (xwem-cl-XProperty-plist-export cl))
+
+;;;###xwem-autoload
+(defun xwem-client-set-properties (cl props)
+ "To CL's properties import PROPS."
+ (while props
+ (xwem-client-set-property cl (car props) (cadr props))
+ (setq props (cddr props))))
;;;###xwem-autoload
(defun xwem-client-property (cl prop)
@@ -434,6 +449,32 @@
"Non-nil mean skip CL's initial state hint."
:type 'boolean)
+(define-xwem-client-property client-window nil
+ "Cons cell in form (FRAME-NUM . WINDOW-NUM) is where client is managed.
+If using windowing managing model."
+ :type 'cons)
+
+
+;; X Properties stuff
+(defmacro xwem-cl-XProperty-get (cl prop-atom-string)
+ `(xwem-XProperty-get (xwem-cl-xwin ,cl) ,prop-atom-string))
+(defmacro xwem-cl-XProperty-set (cl prop-atom-string prop-val)
+ `(xwem-XProperty-set (xwem-cl-xwin ,cl) ,prop-atom-string ,prop-val))
+(defmacro xwem-cl-XProperty-manage-spec (cl)
+ `(xwem-cl-XProperty-get ,cl "XWEM_CLIENT_MANAGE_SPEC"))
+(define-xwem-deffered xwem-cl-XProperty-manage-spec-export (cl)
+ "Export CL's manage spec into XWEM_CLIENT_PLIST X property."
+ (xwem-cl-XProperty-set cl "XWEM_CLIENT_MANAGE_SPEC"
+ (xwem-cl-manage-spec cl)))
+(defmacro xwem-cl-XProperty-plist (cl)
+ `(xwem-cl-XProperty-get ,cl "XWEM_CLIENT_PLIST"))
+(define-xwem-deffered xwem-cl-XProperty-plist-export (cl)
+ "Export CL's plist into XWEM_CLIENT_PLIST X property."
+ (xwem-cl-XProperty-set
+ cl "XWEM_CLIENT_PLIST"
+ ;; XXX remove 'expect-win
+ (plist-put (xwem-client-properties cl) 'expect-win nil)))
+
;;; Functions
(defun xwem-client-set-x-border-width (cl bprop width)
@@ -1097,6 +1138,8 @@
(setf (xwem-cl-transient-for cl)
(xwem-hints-wm-transient-for (xwem-cl-hints cl)))
+ (XChangeSaveSet (xwem-dpy) (xwem-cl-xwin cl) X-SetModeInsert)
+
;; Install keyboard grabs, (ARGUSED)
(xwem-kbd-install-grab xwem-global-map xwin)))
@@ -1152,7 +1195,8 @@
"Manage client CL for the first time.
Return non-nil if CL successfully managed."
;; Find match spec for CL
- (let ((mspec (xwem-manda-find-match cl)))
+ (let ((mspec (or (xwem-cl-XProperty-manage-spec cl)
+ (xwem-manda-find-match cl))))
(when mspec
;; Add CL to clients list
(pushnew cl xwem-clients :test 'eq)
@@ -1165,9 +1209,22 @@
;; properties may cause seting property to fail, for example
;; 'expect-win property, which only set for 'generic managing
;; model.
+
(setf (xwem-cl-manage-spec cl) mspec)
(xwem-cl-apply-plist cl (cadr mspec))
+ ;; Also import saved(in X property) CL's plist
+ (xwem-cl-apply-plist cl (xwem-cl-XProperty-plist cl))
+
+ ;; Set expectance if 'client-window property is set
+ (let* ((fw (xwem-client-property cl 'client-window))
+ (frame (and fw (nth (car fw) xwem-frames-list)))
+ (win (and (xwem-frame-alive-p frame)
+ (xwem-win-find-by-num frame (cdr fw)))))
+ (when (xwem-win-alive-p win)
+ (xwem-cl-was-expected cl t)
+ (xwem-client-set-property cl 'expect-win win)))
+
(xwem-debug 'xwem-cl "Managing model: %S selected"
'(xwem-cl-manage-type cl))
@@ -1185,6 +1242,10 @@
;; marked it.
(xwem-cl-was-expected cl nil)
+ ;; Honour initial client state
+ (unless (xwem-client-property cl 'skip-initial-state)
+ (xwem-cl-honour-init-state cl))
+
;; Run new client hook
(when (xwem-cl-alive-p cl)
(run-hook-with-args 'xwem-cl-create-hook cl))
@@ -1347,7 +1408,11 @@
(xwem-interactive (list (xwem-win-selected)
(prefix-numeric-value xwem-prefix-arg)))
- (mapc 'xwem-iconify (nthcdr arg (xwem-win-clients window))))
+ (let ((wclients (xwem-win-clients window)))
+ (while (and wclients (> (length (xwem-win-clients window)) arg))
+ (unless (eq (xwem-win-cl window) (car wclients))
+ (xwem-iconify (car wclients)))
+ (setq wclients (cdr wclients)))))
;;;###autoload(autoload 'xwem-client-run-copy "xwem-clients" "" t)
(define-xwem-command xwem-client-run-copy (cl &optional arg)
@@ -1955,8 +2020,9 @@
(setf (xwem-cl-manage-spec cl) manage-spec)
(xwem-cl-apply-plist cl (cadr manage-spec))
- (xwem-method-manage cl)
+ (xwem-manage cl)
+ ;; Keep CL's state
(when (eq state 'active)
(xwem-activate cl))
(when selp
@@ -1979,8 +2045,8 @@
"Manage client CL."
(xwem-method-manage cl)
- (unless (xwem-client-property cl 'skip-initial-state)
- (xwem-cl-honour-init-state cl))
+ ;; Save new manage spec into X property
+ (xwem-cl-XProperty-manage-spec-export cl)
(run-hook-with-args 'xwem-cl-manage-hook cl))
@@ -2000,15 +2066,16 @@
;; CL suddenly died
(xwem-cl-destroy cl)
- (unless type
- (setq type 'activate))
+ (unless type (setq type 'activate))
(unless (eq (xwem-cl-state cl) 'active)
(xwem-client-change-state cl 'active)
(xwem-method-activate cl 'activate))
(unless (eq type 'activate)
- (xwem-method-activate cl type))))
+ (xwem-method-activate cl type))
+
+ (run-hook-with-args 'xwem-cl-activate-hook cl type)))
;;;###xwem-autoload
(defun xwem-deactivate (cl &optional type)
@@ -2021,8 +2088,7 @@
`deselect' - Client is deselecting.
Default TYPE is `deactivate'."
- (unless type
- (setq type 'deactivate))
+ (unless type (setq type 'deactivate))
(cond ((eq type 'deselect)
(xwem-method-deactivate cl type))
@@ -2034,7 +2100,9 @@
((not (eq (xwem-cl-state cl) 'inactive))
(xwem-method-deactivate cl type)
- (xwem-select-some-client))))
+ (xwem-select-some-client)))
+
+ (run-hook-with-args 'xwem-cl-deactivate-hook cl type))
;;;###xwem-autoload
(defun xwem-iconify (cl)
--- orig/lisp/xwem-frame.el
+++ mod/lisp/xwem-frame.el
@@ -236,7 +236,14 @@
"Hooks called with one argument - frame, when frame redrawed."
:type 'hook
:group 'xwem-hooks)
-
+
+(defcustom xwem-frame-configuration-exporting t
+ "*Non-nil mean, frame configuration exports after each frame command.
+Non-nil value is useful when using xwem-agent. It allows you restore
+frames on (S)XEmacs restart."
+ :type 'boolean
+ :group 'xwem-frame)
+
;;; Internal variables
(defconst xwem-frame-ev-mask
@@ -322,6 +329,34 @@
(funcall ,fn fr)
(setq fr (xwem-frame-link-next fr)))))
+;;; X properties
+(defmacro xwem-frame-XProperty-get (frame prop-atom-string)
+ `(xwem-XProperty-get (xwem-frame-xwin ,frame) ,prop-atom-string))
+(defmacro xwem-frame-XProperty-set (frame prop-atom-string prop-val)
+ `(xwem-XProperty-set (xwem-frame-xwin ,frame) ,prop-atom-string ,prop-val))
+
+(define-xwem-deffered xwem-frame-export-frame-configuration ()
+ "Export frame configuration to root window."
+ (xwem-XProperty-set (xwem-rootwin) "XWEM_FRAME_CONFIGURATION"
+ (with-temp-buffer
+ (xwem-frame-config-dump1 (xwem-frame-configuration)
+ (current-buffer))
+ (read (buffer-substring (point-min) (point-max))))))
+
+(defun xwem-frame-frame-command-post-hook ()
+ "Function to use in `xwem-post-command-hook'.
+It exports frame configuration if executed frame command.
+However it will not guarantie full sync of frames configuration.
+Also it makes sense only if `xwem-frame-configuration-exporting' is
+non-nil."
+ (when (and xwem-frame-configuration-exporting
+ (get xwem-last-command 'xwem-frame-command))
+ (xwem-frame-export-frame-configuration)))
+
+(defun xwem-frame-import-frame-configuration ()
+ "Import frame configuration fram root window."
+ (eval (xwem-XProperty-get (xwem-rootwin) "XWEM_FRAME_CONFIGURATION")))
+
;;; Functions
(define-xwem-deffered xwem-frame-apply-state (frame)
"Apply FRAME's state to life."
@@ -614,6 +649,9 @@
(defun xwem-frame-create-initial ()
"Create initial frames."
+ ;; Try to import frame configuration from root window
+ (xwem-frame-import-frame-configuration)
+
(if xwem-frame-dumped-config
;; Create frames from saved configuration
(xwem-frame-config-restore1)
@@ -653,6 +691,9 @@
(add-hook 'xwem-frame-select-hook 'xwem-frame-default-select-hook)
(add-hook 'xwem-frame-deselect-hook 'xwem-frame-default-deselect-hook)
+ ;; Add post command hook to export frames configuration
+ (add-hook 'xwem-post-command-hook 'xwem-frame-frame-command-post-hook)
+
;; Create initial frames
(xwem-frame-create-initial)
@@ -1733,6 +1774,7 @@
(error 'xwem-error "`xwem-frame-imove' on non-frame"))
(xwem-frame-imove-internal frame srx sry)))
+(put 'xwem-frame-imove 'xwem-frame-command t)
;;;###autoload(autoload 'xwem-frame-iresize "xwem-frame" "" t)
(define-xwem-command xwem-frame-iresize ()
@@ -1848,6 +1890,7 @@
(xwem-frame-set-size
frame (X-Rect-width last-xrect) (X-Rect-height last-xrect)))
))
+(put 'xwem-frame-iresize 'xwem-frame-command t)
;;;###xwem-autoload
(defun xwem-frame-clients (frame)
--- orig/lisp/xwem-keyboard.el
+++ mod/lisp/xwem-keyboard.el
@@ -380,7 +380,9 @@
(xwem-focus-mode-invoke ,cl 'before-keymap-change)
;; But avoid ungrabbing keymaps! Because it can use prefix
;; keymap of some other command.
- (xwem-kbd-uninstall-grab okeymap (xwem-cl-xwin ,cl)))
+ (xwem-kbd-uninstall-grab okeymap (xwem-cl-xwin ,cl)
+ (lambda (key def)
+ (not (keymapp (xwem-kbd-fixup-keymap
def))))))
;; Install new keymap
(xwem-client-set-property ,cl 'xwem-local-keymap nkeymap)
--- orig/lisp/xwem-launcher.el
+++ mod/lisp/xwem-launcher.el
@@ -617,13 +617,11 @@
(xwem-launch-generic-program xwem-xlock-program xwem-xlock-arguments))
+;;;; Launcher dockapp
(define-xwem-face xwem-launch-dock-face
- `(((background-light) (:foreground "gray70"))
- ((background-light shadow-light) (:foreground "white"))
- ((background-light shadow-dark) (:foreground "black"))
- ((background-dark) (:foreground "gray50"))
- ((background-dark shadow-light) (:foreground "white"))
- ((background-dark shadow-dark) (:foreground "black"))
+ `(((medium) (:foreground "gray70"))
+ ((light) (:foreground "white"))
+ ((dark) (:foreground "black"))
(t (:foreground "gray70" :background "black")))
"Default background face for launcher docks."
:group 'xwem-launcher
@@ -637,44 +635,63 @@
map)
"Keymap for launch docks.")
+;; Macroses to access ladock internals
+(defmacro xwem-ladock-state (win)
+ `(X-Win-get-prop ,win 'ladock-state))
+(defsetf xwem-ladock-state (win) (state)
+ `(X-Win-put-prop ,win 'ladock-state ,state))
+(defmacro xwem-ladock-action (win)
+ `(X-Win-get-prop ,win 'ladock-action))
+(defsetf xwem-ladock-action (win) (action)
+ `(X-Win-put-prop ,win 'ladock-action ,action))
+(defmacro xwem-ladock-pixmap (win)
+ `(X-Win-get-prop ,win 'ladock-pixmap))
+(defsetf xwem-ladock-pixmap (win) (action)
+ `(X-Win-put-prop ,win 'ladock-pixmap ,action))
+
;;;###autoload(autoload 'xwem-launch-dock-down "xwem-launcher" "" t)
-(define-xwem-command xwem-launch-dock-down ()
+(define-xwem-command xwem-launch-dock-down (ev)
"Default command when button is down."
- (xwem-interactive)
-
- (xwem-ladock-push (X-Event-win xwem-last-xevent))
- )
+ (xwem-interactive (list xwem-last-event))
+ (unless (button-event-p ev)
+ (error 'xwem-error "`xwem-launch-dock-down' must be bound to mouse event"))
+
+ ;; Push the button
+ (setf (xwem-ladock-state (X-Event-win xwem-last-xevent)) 'down)
+ (xwem-ladock-redraw (X-Event-win xwem-last-xevent)))
;;;###autoload(autoload 'xwem-launch-dock-launch "xwem-launcher" "" t)
-(define-xwem-command xwem-launch-dock-launch ()
+(define-xwem-command xwem-launch-dock-launch (ev)
"Launch command for launch dock."
- (xwem-interactive)
-
- (let* ((xwin (X-Event-win xwem-last-xevent))
- (action (X-Win-get-prop xwin 'ladock-action))
- (atype (car action))
- (acmd (cdr action)))
- (xwem-ladock-pop xwin)
- (cond ((eq atype 'elisp)
- (eval (read acmd)))
-
- ((eq atype 'cmd)
- (xwem-execute-program acmd))
-
- (t (xwem-message 'warning "Unknown action type=`%s'" atype)))
- ))
+ (xwem-interactive (list xwem-last-event))
+ (unless (button-event-p ev)
+ (error 'xwem-error "`xwem-launch-dock-up' must be bound to mouse event"))
+
+ ;; Pop the button
+ (setf (xwem-ladock-state (X-Event-win xwem-last-xevent)) 'up)
+ (xwem-ladock-redraw (X-Event-win xwem-last-xevent))
+
+ (when (and (< (X-Event-xbutton-event-x xwem-last-xevent)
+ xwem-launch-dock-width)
+ (< (X-Event-xbutton-event-y xwem-last-xevent)
+ xwem-launch-dock-height))
+ ;; React on ButtonRelease only if it released within ladock
+ ;; window.
+ (let* ((action (xwem-ladock-action (X-Event-win xwem-last-xevent)))
+ (atype (car action))
+ (acmd (cdr action)))
+ (cond ((eq atype 'elisp) (eval (read acmd)))
+ ((eq atype 'cmd) (xwem-execute-program acmd))
+ (t (xwem-message 'warning "Unknown action type=`%s'" atype))))))
;;;###autoload(autoload 'xwem-launch-dock-menu "xwem-launcher" "" t)
(define-xwem-command xwem-launch-dock-menu (action)
"Popup menu."
- (xwem-interactive
- (list (X-Win-get-prop (X-Event-win xwem-last-xevent) 'ladock-action)))
+ (xwem-interactive (list (xwem-ladock-action (X-Event-win xwem-last-xevent))))
(let ((cls (delq nil (mapcar (lambda (cl)
- (and (string-match
- (cdr action)
- (xwem-hints-wm-command
- (xwem-cl-hints cl)))
+ (and (string-match (cdr action)
+ (xwem-cl-wm-command cl))
cl))
xwem-clients)))
menu)
@@ -692,8 +709,7 @@
(nconc
(mapcar (lambda (cl)
(let ((frame (xwem-cl-frame cl))
- (name (xwem-hints-wm-name
- (xwem-cl-hints cl))))
+ (name (xwem-cl-wm-name cl)))
(vector
(if (xwem-frame-p frame)
(format "[%d](%s): %s"
@@ -707,65 +723,24 @@
(list
"---"
(vector "Destroy"
- `(XDestroyWindow
- (xwem-dpy) ,(X-Event-win xwem-last-xevent))))))))
+ `(xwem-launch-button-stop
+ ,(X-Event-win xwem-last-xevent) t)))))))
(xwem-popup-menu menu)))
-(defun xwem-ladock-puticon (xwin)
- "Draw icon on launcher dock XWIN."
- (let* ((xdpy (X-Win-dpy xwin))
- (xpix (X-Win-get-prop xwin 'ladock-xpix))
- (ximg (X-Pixmap-get-prop xpix 'ximg))
- (xgc (X-Win-get-prop xwin 'ladock-xgc)))
- (XCopyArea xdpy xpix xwin xgc 0 0
- (X-Image-width ximg) (X-Image-height ximg)
- (/ (- xwem-launch-dock-width (X-Image-width ximg)) 2)
- (/ (- xwem-launch-dock-height (X-Image-height ximg)) 2))
- ))
-
(define-xwem-deffered xwem-ladock-redraw (xwin)
"Redraw launcher button dock XWIN."
- (let ((state (X-Win-get-prop xwin 'ladock-state))
- (xdpy (X-Win-dpy xwin))
- (bgmode (intern (format "%s-%s" 'background
- (xwem-tray-background-mode)))))
- (case state
- (down
- (xwem-misc-draw-bar
- xdpy xwin
- (xwem-face-get-gc 'xwem-launch-dock-face
- (list bgmode))
- (xwem-face-get-gc 'xwem-launch-dock-face
- (list bgmode 'shadow-dark))
- (xwem-face-get-gc 'xwem-launch-dock-face
- (list bgmode 'shadow-light))
- 0 0 xwem-launch-dock-width
- xwem-launch-dock-height xwem-launch-dock-thick)
- (xwem-ladock-puticon xwin))
-
- (up
- (xwem-misc-draw-bar
- xdpy xwin
- (xwem-face-get-gc 'xwem-launch-dock-face
- (list bgmode))
- (xwem-face-get-gc 'xwem-launch-dock-face
- (list bgmode 'shadow-light))
- (xwem-face-get-gc 'xwem-launch-dock-face
- (list bgmode 'shadow-dark))
- 0 0 xwem-launch-dock-width
- xwem-launch-dock-height xwem-launch-dock-thick)
- (xwem-ladock-puticon xwin)))))
-
-(defun xwem-ladock-push (xwin)
- "Emulate pushing button."
- (X-Win-put-prop xwin 'ladock-state 'down)
- (xwem-ladock-redraw xwin))
-
-(defun xwem-ladock-pop (xwin)
- "Emulate poping button."
- (X-Win-put-prop xwin 'ladock-state 'up)
- (xwem-ladock-redraw xwin))
-
+ (xwem-misc-draw-shadow
+ (X-Win-dpy xwin) (xwem-ladock-pixmap xwin)
+ (xwem-face-get-gc 'xwem-launch-dock-face
+ (if (eq (xwem-ladock-state xwin) 'down) '(dark) '(light)))
+ (xwem-face-get-gc 'xwem-launch-dock-face
+ (if (eq (xwem-ladock-state xwin) 'down) '(light) '(dark)))
+ 0 0 xwem-launch-dock-width xwem-launch-dock-height xwem-launch-dock-thick)
+
+ (XCopyArea (xwem-dpy) (xwem-ladock-pixmap xwin) xwin
+ (XDefaultGC (xwem-dpy)) 0 0
+ xwem-launch-dock-width xwem-launch-dock-height 0 0))
+
(defun xwem-ladock-evhandler (xdpy xwin xev)
"On XDPY and launcher dock XWIN handle event XEV."
(X-Event-CASE xev
@@ -783,22 +758,17 @@
(defun xwem-launch-button-stop (xwin &optional force)
"Destoy launch dockapp button XWIN.
If FORCE is non-nil also destroy XWIN."
- (let ((xdpy (X-Win-dpy xwin))
- (xpix (X-Win-get-prop xwin 'ladock-xpix))
- (xpix-mask (X-Win-get-prop xwin 'ladock-xpix-mask))
- (xgc (X-Win-get-prop xwin 'ladock-xgc)))
- (XFreeGC xdpy xgc)
- (XFreePixmap xdpy xpix)
- (XFreePixmap xdpy xpix-mask)
-
- (X-Win-rem-prop xwin 'ladock-state)
- (X-Win-rem-prop xwin 'ladock-action)
- (X-Win-rem-prop xwin 'ladock-xgc)
- (X-Win-rem-prop xwin 'ladock-xpix)
- (X-Win-rem-prop xwin 'ladock-xpix-mask)
+ (XFreePixmap (X-Win-dpy xwin) (xwem-ladock-pixmap xwin))
+
+ (setf (xwem-ladock-pixmap xwin) nil
+ (xwem-ladock-state xwin)nil
+ (xwem-ladock-action xwin)nil)
+
+ ;; Remove events handler
+ (X-Win-EventHandler-rem xwin 'xwem-ladock-evhandler)
- (when force
- (XDestroyWindow xdpy xwin))))
+ (when force
+ (XDestroyWindow (X-Win-dpy xwin) xwin)))
;;;###autoload
(defun xwem-launch-button-start (xpm-file action &optional dockid
@@ -807,50 +777,56 @@
ACTION is cons cell wher car is one of 'elisp or 'cmd and cdr is string.
For 'elisp car, cdr is real elisp expression, to evaluate on click.
For 'cmd car, cdr is cmd to run on click."
- (let (xwin xpix xpix-mask ximg xgc)
- (setq xwin
- (XCreateWindow
- (xwem-dpy) nil
- 0 0
- xwem-launch-dock-width
- xwem-launch-dock-height
- 0 nil nil nil
- (make-X-Attr
- :override-redirect t
- :backing-store X-Always
- :background-pixel (XAllocNamedColor
- (xwem-dpy) (XDefaultColormap (xwem-dpy))
- "gray50")
- :border-pixel (XAllocNamedColor
- (xwem-dpy) (XDefaultColormap (xwem-dpy))
- "gray80"))))
+ (let ((xwin (XCreateWindow (xwem-dpy) nil 0 0
+ xwem-launch-dock-width
+ xwem-launch-dock-height
+ 0 nil nil nil
+ (make-X-Attr
+ :event-mask (Xmask-or XM-Exposure
XM-StructureNotify
+ XM-ButtonPress
XM-ButtonRelease)
+ :override-redirect t))))
+
;; Create pixmap
- (setq xpix (X:xpm-pixmap-from-file
- (xwem-dpy) xwin (expand-file-name xpm-file xwem-icons-dir))
- ximg (X-Pixmap-get-prop xpix 'ximg)
- xpix-mask (X:xpm-pixmap-from-file
- (xwem-dpy) xwin
- (expand-file-name xpm-file xwem-icons-dir) t))
-
- (setq xgc (XCreateGC
- (xwem-dpy) xpix
- (make-X-Gc :dpy (xwem-dpy)
- :id (X-Dpy-get-id (xwem-dpy))
- :clip-x-origin (/ (- xwem-launch-dock-width
- (X-Image-width ximg)) 2)
- :clip-y-origin (/ (- xwem-launch-dock-height
- (X-Image-height ximg)) 2)
- :clip-mask xpix-mask)))
- ;; Put some properties
- (X-Win-put-prop xwin 'ladock-state 'up)
- (X-Win-put-prop xwin 'ladock-action action)
-
- (X-Win-put-prop xwin 'ladock-xgc xgc)
- (X-Win-put-prop xwin 'ladock-xpix xpix)
- (X-Win-put-prop xwin 'ladock-xpix-mask xpix-mask)
+ (setf (xwem-ladock-pixmap xwin)
+ (XCreatePixmap
+ (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy)
+ :id (X-Dpy-get-id (xwem-dpy)))
+ xwin (XDefaultDepth (xwem-dpy))
+ xwem-launch-dock-width xwem-launch-dock-height)
+ (xwem-ladock-state xwin) 'up
+ (xwem-ladock-action xwin) action)
+
+ ;; Initial pixmaps setup
+ (XFillRectangle (xwem-dpy) (xwem-ladock-pixmap xwin)
+ (xwem-face-get-gc 'xwem-launch-dock-face '(medium)) 0 0
+ (X-Pixmap-width (xwem-ladock-pixmap xwin))
+ (X-Pixmap-height (xwem-ladock-pixmap xwin)))
+ (let* ((ipix (X:xpm-pixmap-from-file
+ (xwem-dpy) xwin (expand-file-name xpm-file xwem-icons-dir)))
+ (imask (X:xpm-pixmap-from-file
+ (xwem-dpy) xwin (expand-file-name xpm-file xwem-icons-dir)
t))
+ (x-orig (/ (- xwem-launch-dock-width (X-Pixmap-width ipix)) 2))
+ (y-orig (/ (- xwem-launch-dock-height (X-Pixmap-height ipix)) 2))
+ (clgc (XCreateGC
+ (xwem-dpy) ipix
+ (make-X-Gc :dpy (xwem-dpy)
+ :id (X-Dpy-get-id (xwem-dpy))
+ :clip-x-origin x-orig
+ :clip-y-origin y-orig
+ :clip-mask imask))))
+ ;; Copy to our pixmap
+ (XCopyArea (xwem-dpy) ipix (xwem-ladock-pixmap xwin) clgc
+ 0 0 (X-Pixmap-width ipix) (X-Pixmap-height ipix)
+ x-orig y-orig)
+ ;; Release resources
+ (XFreeGC (xwem-dpy) clgc)
+ (XFreePixmap (xwem-dpy) imask)
+ (XFreePixmap (xwem-dpy) ipix))
+
+ (when xwem-misc-turbo-mode
+ (XSetWindowBackgroundPixmap (xwem-dpy) xwin (xwem-ladock-pixmap xwin)))
- (XSelectInput (xwem-dpy) xwin (Xmask-or XM-Exposure XM-StructureNotify
- XM-ButtonPress XM-ButtonRelease))
+ ;; Install events handler
(X-Win-EventHandler-add xwin 'xwem-ladock-evhandler nil
(list X-Expose X-MapNotify X-ButtonPress
X-ButtonRelease X-DestroyNotify))
--- orig/lisp/xwem-main.el
+++ mod/lisp/xwem-main.el
@@ -213,7 +213,7 @@
(setq wins (cdr wins)))
;; Manage all visible clients
- (mapc 'xwem-xwin-try-to-manage cln-wins))
+ (mapc 'xwem-xwin-try-to-manage (nreverse cln-wins)))
(run-hooks 'xwem-after-init-wins-hook)
(xwem-message 'init "Initializing X windows ... done"))
--- orig/lisp/xwem-manage.el
+++ mod/lisp/xwem-manage.el
@@ -117,7 +117,8 @@
("acroread" (class-name "^AcroRead$"))
("djview" (and (class-inst "^djview$")
(class-name "^Djview$")))
- ("mozilla" (class-name "^[mM]ozilla"))
+ ("mozilla" (or (class-name "^[mM]ozilla")
+ (class-inst "^[mM]ozilla")))
("firefox" (class-name "^Firefox"))
("opera" (class-name "^Opera$"))
("rdesktop" (and (class-inst "^rdesktop$")
--- orig/lisp/xwem-misc.el
+++ mod/lisp/xwem-misc.el
@@ -228,6 +228,15 @@
:type '(list (symbol :tag "Message label") string (repeat face))
:group 'xwem-misc)
+;;;###xwem-autoload
+(defcustom xwem-misc-turbo-mode nil
+ "*Non-nil mean xwem will work as fast as it can.
+In this case, some color related customizations may not apply on fly.
+So on-fly theming will not work, etc.
+However seting its value to non-nil is most convinient for most users."
+ :type 'boolean
+ :group 'xwem-misc)
+
(defcustom xwem-misc-functions-to-profile nil
"List of functions to profile using xwem profiler."
:type (list
--- orig/lisp/xwem-mouse.el
+++ mod/lisp/xwem-mouse.el
@@ -280,29 +280,60 @@
(unless maxnlen
(setq maxnlen 20))
- (list (let ((name (xwem-client-name cl)))
- (when (> (length name) maxnlen)
- (setq name (concat (substring name 0 (- maxnlen 2)) "..")))
- name)
- "--"
- (vector "Focus client" `(xwem-cl-pop-to-client ,cl))
- (vector "Info" `(xwem-client-info ,cl))
- (vector "Iconify" `(xwem-client-iconify ,cl))
- "--:singleDashedLine"
- (vector "Transpose ==>" `(xwem-cl-transpose ,cl))
- (vector "Transpose <==" `(xwem-cl-transpose ,cl '(4)))
- (vector "Mark client" `(if (xwem-cl-marked-p ,cl)
- (xwem-client-unset-mark ,cl)
- (xwem-client-set-mark ,cl))
- :style 'toggle :selected `(xwem-cl-marked-p ,cl))
- "--:singleDashedLine"
- (vector "Run Copy" `(xwem-client-run-copy nil ,cl))
- (vector "Run Copy other win" `(xwem-client-run-copy-other-win nil ,cl))
- (vector "Run Copy other frame" `(xwem-client-run-copy-other-frame nil
,cl))
- "--:doubleLine"
- (vector "X Soft kill" `(xwem-client-kill ,cl))
- (vector "X Hard kill" `(xwem-client-kill ,cl '(4)))
- ))
+ (delq nil
+ (list (let ((name (xwem-client-name cl)))
+ (when (> (length name) maxnlen)
+ (setq name (concat (substring name 0 (- maxnlen 2)) "..")))
+ name)
+ "--"
+ (vector "Focus client" `(xwem-cl-pop-to-client ,cl))
+ (vector "Info" `(xwem-client-info ,cl))
+ (vector "Iconify" `(xwem-client-iconify ,cl))
+ "--:singleDashedLine"
+ (vector "Transpose ==>" `(xwem-cl-transpose ,cl))
+ (vector "Transpose <==" `(xwem-cl-transpose ,cl '(4)))
+ "--:singleDashedLine"
+ (vector "Mark client" `(if (xwem-cl-marked-p ,cl)
+ (xwem-client-unset-mark ,cl)
+ (xwem-client-set-mark ,cl))
+ :style 'toggle :selected `(xwem-cl-marked-p ,cl))
+ (when (and xwem-cl-mark-ring
+ (not (eq (xwem-cl-frame (car xwem-cl-mark-ring))
+ (if (and (boundp 'xwem-tabber-click-frame)
+ (xwem-frame-p
xwem-tabber-click-frame))
+ xwem-tabber-click-frame
+ (xwem-frame-selected)))))
+ (vector "Attach"
+ `(xwem-win-set-cl ,(xwem-frame-selwin
+ (if (and (boundp
'xwem-tabber-click-frame)
+ (xwem-frame-p
xwem-tabber-click-frame))
+ xwem-tabber-click-frame
+ (xwem-frame-selected)))
+ ,(car xwem-cl-mark-ring))))
+ (when (and xwem-cl-mark-ring
+ (not (eq (xwem-cl-frame (car xwem-cl-mark-ring))
+ (if (and (boundp 'xwem-tabber-click-frame)
+ (xwem-frame-p
xwem-tabber-click-frame))
+ xwem-tabber-click-frame
+ (xwem-frame-selected)))))
+ (vector "Attach (unmark)"
+ `(progn
+ (xwem-win-set-cl ,(xwem-frame-selwin
+ (if (and (boundp
'xwem-tabber-click-frame)
+ (xwem-frame-p
xwem-tabber-click-frame))
+ xwem-tabber-click-frame
+ (xwem-frame-selected)))
+ ,(car xwem-cl-mark-ring))
+ (xwem-client-unset-mark ,(car xwem-cl-mark-ring)))))
+ "--:singleDashedLine"
+ (vector "Run Copy" `(xwem-client-run-copy nil ,cl))
+ (vector "Run Copy other win" `(xwem-client-run-copy-other-win nil
,cl))
+ (vector "Run Copy other frame" `(xwem-client-run-copy-other-frame
nil ,cl))
+ "--:doubleLine"
+ (when (XWMProtocol-set-p
+ (xwem-dpy) (xwem-hints-wm-protocols (xwem-cl-hints cl))
"WM_DELETE_WINDOW")
+ (vector "Close" `(xwem-client-kill ,cl)))
+ (vector "Kill" `(xwem-client-kill ,cl '(4))))))
;;;###autoload(autoload 'xwem-popup-auto-menu "xwem-mouse" nil t)
(define-xwem-command xwem-popup-auto-menu (arg)
--- orig/lisp/xwem-root.el
+++ mod/lisp/xwem-root.el
@@ -133,6 +133,7 @@
;;;###autoload
(defun xwem-fini-root ()
+ (XSetInputFocus (xwem-dpy) X-PointerRoot X-RevertToPointerRoot)
(XCloseDisplay (xwem-dpy)))
;;;###autoload
--- orig/lisp/xwem-struct.el
+++ mod/lisp/xwem-struct.el
@@ -645,9 +645,24 @@
Do it in safe manner."
`(xwem-unwind-protect
(let ((xwem-override-local-map ,nlm))
- ,@forms)))
+ ,@forms)
+ nil))
+
(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)
--- orig/lisp/xwem-tabbing.el
+++ mod/lisp/xwem-tabbing.el
@@ -301,8 +301,11 @@
"Popup clients menu."
(xwem-interactive)
- (when (xwem-cl-alive-p xwem-tabber-click-cl)
- (xwem-popup-menu (xwem-generate-cl-menu xwem-tabber-click-cl))))
+ (if (xwem-cl-alive-p xwem-tabber-click-cl)
+ (xwem-popup-menu (xwem-generate-cl-menu xwem-tabber-click-cl))
+ ;; TODO
+; (xwem-popup-menu nil
+ ))
(defun xwem-tabber-cl-at (tabber x y)
"Return client of TABBER which rectangle covers point at X Y."
@@ -869,8 +872,10 @@
(make-X-Pixmap :dpy (xwem-dpy)
:id (X-Dpy-get-id (xwem-dpy)))
(xwem-tabber-xwin tabber) (XDefaultDepth (xwem-dpy))
- (X-Geom-width xgeom) (X-Geom-height xgeom))))
-
+ (X-Geom-width xgeom) (X-Geom-height xgeom)))
+ (when xwem-misc-turbo-mode
+ (XSetWindowBackgroundPixmap (xwem-dpy) (xwem-tabber-xwin tabber)
+ (xwem-tabber-xpix-copy tabber))))
(xwem-tabber-regeom tabber)))
;;; Frame Hooks
--- orig/lisp/xwem-theme.el
+++ mod/lisp/xwem-theme.el
@@ -90,19 +90,9 @@
(:foreground "blue4" :background "blue4"))))
(face xwem-launch-dock-face
- (((background-light)
- (:foreground "gray70"))
- ((background-light shadow-light)
- (:foreground "white"))
- ((background-light shadow-dark)
- (:foreground "black"))
- ((background-dark)
- (:foreground "gray 50"))
- ((background-dark shadow-light)
- (:foreground "white"))
- ((background-dark shadow-dark)
- (:foreground "black"))
- (t (:foreground "gray70" :background "black"))))
+ (((medium) (:foreground "gray70"))
+ ((light) (:foreground "white"))
+ ((dark) (:foreground "black"))))
(face xwem-strokes-face
(((background light)
@@ -228,19 +218,9 @@
(:foreground "dark"))))
(face xwem-launch-dock-face
- (((background-light)
- (:foreground "gray70"))
- ((background-light shadow-light)
- (:foreground "white"))
- ((background-light shadow-dark)
- (:foreground "black"))
- ((background-dark)
- (:foreground "gray50"))
- ((background-dark shadow-light)
- (:foreground "white"))
- ((background-dark shadow-dark)
- (:foreground "black"))
- (t (:foreground "gray70" :background "black"))))
+ (((medium) (:foreground "gray70"))
+ ((light) (:foreground "white"))
+ ((dark) (:foreground "black"))))
(face xwem-strokes-face
(((background light)
--- orig/lisp/xwem-win.el
+++ mod/lisp/xwem-win.el
@@ -208,6 +208,38 @@
(nreverse rlist)))
;;;###xwem-autoload
+(defun xwem-win-num (win)
+ "Return relative WIN's number in logical window list."
+ (let ((ch (xwem-win-child (xwem-frame-rootwin (xwem-win-frame win))))
+ (idx 0))
+ (when (xwem-win-p ch)
+ (while (not (xwem-win-alive-p ch))
+ (setq ch (xwem-win-child ch)))
+ ;; CH is very first window in frame
+ (while (not (eq ch win))
+ (setq idx (1+ idx)
+ ch (xwem-window-next ch))))
+ idx))
+
+;;;###xwem-autoload
+(defun xwem-win-find-by-num (frame num)
+ "In FRAME find window for which `xwem-win-num' returns NUM."
+ (let* ((fch (xwem-win-child (xwem-frame-rootwin frame)))
+ (ch fch))
+ (if (not (xwem-win-p ch))
+ (and (= num 0) (xwem-frame-rootwin frame))
+
+ (while (not (xwem-win-alive-p ch))
+ (setq ch (xwem-win-child ch)))
+ ;; CH is very first window in frame
+ (while (and (> num 0) ch)
+ (setq ch (xwem-window-next ch))
+ (if (eq ch fch)
+ (setq ch nil)
+ (decf num)))
+ ch)))
+
+;;;###xwem-autoload
(defun xwem-cl-set-win (cl win)
"Associate CL with WIN.
WIN is valid WIN or nil."
@@ -218,6 +250,11 @@
(setf (xwem-cl-win cl) win)
+ ;; Set also client property
+ (xwem-client-set-property cl 'client-window
+ (cons (xwem-frame-num (xwem-win-frame win))
+ (xwem-win-num win)))
+
;; Remove CL from OWIN's clients list
(when (xwem-win-p owin)
(xwem-win-rem-cl owin cl))))
--- orig/utils/xwem-osd.el
+++ mod/utils/xwem-osd.el
@@ -652,40 +652,32 @@
(setq y 0))
(let ((xdpy (xwem-osd-xdpy osd))
- ximg ximg-shape osin gc)
-
- (setq ximg (X:xpm-img-from-data xdpy xpm-data)
- ximg-shape (X:xpm-img-from-data xdpy xpm-data t))
+ osin xpix xpix-mask)
;; Created OSD icon instance
(setq osin (xwem-osd-add-instance osd depth))
(setf (xwem-osd-instance-type osin) 'icon)
- (setq gc (XCreateGC xdpy (xwem-osd-instance-xmask osin)
- (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
- :foreground 1.0
- :background 0.0)))
- (when ximg-shape
- (XImagePut xdpy gc (xwem-osd-instance-xmask osin) x y ximg-shape)
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
-
- ;; Update OSD shape
- (XImagePut xdpy gc (xwem-osd-xmask osd) x y ximg-shape)
- (xwem-osd-apply-xmask osd))
- (XFreeGC xdpy gc)
-
- ;; Draw Image
- (setq gc (XCreateGC xdpy (xwem-osd-instance-xwin osin)
- (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
- :foreground 1.0
- :background 0.0)))
- (xwem-osd-instance-put-prop osin 'icon-gc gc)
- (xwem-osd-instance-put-prop osin 'ximg ximg)
- (xwem-osd-instance-put-prop osin 'ximg-shape ximg-shape)
+ (setq xpix (X:xpm-pixmap-from-data
+ xdpy (xwem-osd-instance-xwin osin) xpm-data)
+ xpix-mask (X:xpm-pixmap-from-data
+ xdpy (xwem-osd-instance-xwin osin) xpm-data t))
+
+ (XCopyArea xdpy xpix-mask (xwem-osd-instance-xmask osin)
+ xwem-misc-mask-bgc 0 0
+ (X-Pixmap-width xpix-mask) (X-Pixmap-height xpix-mask)
+ x y)
+ (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
+ X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
+ (XCopyArea xdpy xpix-mask (xwem-osd-xmask osd)
+ xwem-misc-mask-bgc 0 0
+ (X-Pixmap-width xpix-mask) (X-Pixmap-height xpix-mask)
+ x y)
+ (xwem-osd-apply-xmask osd)
+
+ (XSetWindowBackgroundPixmap (xwem-dpy) (xwem-osd-instance-xwin osin) xpix)
(xwem-osd-instance-show osin)
- (XImagePut xdpy gc (xwem-osd-instance-xwin osin) x y ximg)
osin))
(defun xwem-osd-icon-file-add (osd xpm-file &optional x y depth)
|