Location: lg@xxxxxxxxxxxxxx http://arch.xwem.org/2005/
Revision: xwem--main--2.2--patch-43
Archive: lg@xxxxxxxxxxxxxx
Creator: Zajcev Evgeny <lg@xxxxxxxx>
Date: Sat Dec 31 22:53:45 MSK 2005
Standard-date: 2005-12-31 19:53:45 GMT
Modified-files: dockapp/xwem-mpd.el dockapp/xwem-pager.el
dockapp/xwem-weather.el lisp/xwem-clients.el
lisp/xwem-frame.el lisp/xwem-interactive.el
lisp/xwem-keyboard.el lisp/xwem-launcher.el
lisp/xwem-minibuffer.el lisp/xwem-misc.el
lisp/xwem-selections.el lisp/xwem-struct.el
lisp/xwem-tray.el utils/xwem-osd.el
utils/xwem-worklog.el
New-patches: lg@xxxxxxxxxxxxxx/xwem--main--2.2--patch-43
Summary: major 2.2 release
Keywords: release
This is pretty major change. It might not work for you, however i'm
releasing it due to NEW YEAR!!! And drink accessibility .. cold vodka in
the refrigerator, appetizing olivie salad, sexy wife in transparent
clothes ... umm nyam nyam .. BE HAPPY, GIVE BIRTH TO KIDS AND HAPPY NEW
YEAR GUYS!
* lisp/xwem-keyboard.el (xwem-read-key): [fix] H-g exits key reading.
* lisp/xwem-minibuffer.el (xwem-minib-frame-autoraise): [new] Raise Emacs
frame of xwem minibuffer when xwem minibuffer is selected.
* lisp/xwem-minibuffer.el (xwem-last-nonminibuffer-client): [new] Return
last non-minibuffer client.
* lisp/xwem-minibuffer.el (xwem-modeline-regenerate): [fix] Display only
non-minibuffer clients in minibuffer.
* lisp/xwem-selections.el (xwem-selection): [new] Return either active
region or PRIMARY X selection.
* lisp/xwem-tray.el: Support for resizing dockapps added.
* utils/xwem-osd.el: Very major changes to instances, support for dynamic
changes to osd instances added. WARNING: This change can cause
problems to variaous code that uses osd instances.
* utils/xwem-worklog.el: Some tasks added by default.
* lisp/xwem-pager.el (xwme-pager-face): Default color for selected frame
changed to cyan4
* lisp/xwem-weather.el (xwem-weather-data-file): [rem] No longer used
* lisp/xwem-weather.el (xwem-weather-url-fqdn): [rem] No longer used
* lisp/xwem-weather.el (xwem-weather-fetch-function): [new] Function used
to fetch weather info.
* lisp/xwem-weather.el (xwem-weather-fetch-with-url): [new] Function to
fetch weather using url library. Use it if you are using proxy server
to access web
* lisp/xwem-weather.el (xwem-weather-fetch-direct): [new] Function to
fetch weather directly from the internet. Use this if you are having
direct access to the internet.
* dockapp/xwem-mpd.el: Optimized, uses new nature of osd instances .. it
could not work for you, so be careful.
* added files
{arch}/xwem/xwem--main/xwem--main--2.2/lg@xxxxxxxxxxxxxx/patch-log/patch-43
* modified files
--- orig/dockapp/xwem-mpd.el
+++ mod/dockapp/xwem-mpd.el
@@ -357,15 +357,23 @@
(add-hook 'mpd-after-variables-update-hook 'xwem-mpd-osd-update t)
(mpd-update-variables))
-(define-xwem-deffered xwem-mpd-osd-update xwem-mpd-osd-update-1 ()
+(defmacro xwem-mpd-unless-in-cache (osin prop valu &rest forms)
+ "Do FORMS."
+ `(unless (equal (xwem-osd-instance-get-prop ,osin ',prop)
+ ,valu)
+ (xwem-osd-instance-put-prop osin ',prop ,valu)
+ ,@forms))
+(put 'xwem-mpd-unless-in-cache 'lisp-indent-function 3)
+
+(define-xwem-deffered xwem-mpd-osd-update ()
"Update mpd dockapp if any."
(when xwem-mpd-osd
(unless mpd-zero-vars-p
- (xwem-osd-offscreen xwem-mpd-osd)
+; (xwem-osd-offscreen xwem-mpd-osd)
;; Killall displayed instances
- (xwem-osd-destroy-instances xwem-mpd-osd)
- (xwem-osd-clear-mask xwem-mpd-osd)
+; (xwem-osd-destroy-instances xwem-mpd-osd)
+; (xwem-osd-clear-mask xwem-mpd-osd)
(let* ((art-plist (cdr (assq 'artist xwem-mpd-osd-setup)))
(art-str (eval (plist-get art-plist :format)))
@@ -375,80 +383,121 @@
(bar-plist (cdr (assq 'bar xwem-mpd-osd-setup)))
(lyr-plist (cdr (assq 'lyrics xwem-mpd-osd-setup)))
(st-plist (cdr (assq 'state xwem-mpd-osd-setup)))
- (y-off 0))
+ (y-off 0) osin)
;; Artist, Album
- (xwem-osd-set-font xwem-mpd-osd (plist-get art-plist :font))
- (xwem-osd-text-add xwem-mpd-osd 0 0 art-str
- (plist-get art-plist :depth) (plist-get art-plist
:color))
-
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'artist-instance))
+ (if (xwem-osd-instance-p osin)
+ (xwem-mpd-unless-in-cache osin 'saved-artist art-str
+ (xwem-osd-instance-change osin :text art-str))
+ (setq osin (xwem-osd-text-add xwem-mpd-osd 0 0 art-str
+ :depth (plist-get art-plist :depth)
+ :color (plist-get art-plist :color)
+ :font (plist-get art-plist :font)))
+ (xwem-osd-put-prop xwem-mpd-osd 'artist-instance osin))
(setq y-off (X-Text-height (xwem-osd-xdpy xwem-mpd-osd)
(X-Font-get (xwem-osd-xdpy xwem-mpd-osd)
(plist-get art-plist :font))
art-str))
;; Progress bar
- (let ((bw (plist-get bar-plist :width)))
- (xwem-osd-set-line-width xwem-mpd-osd bw)
- (xwem-osd-line-add xwem-mpd-osd 0 (+ y-off (/ bw 2))
- (destructuring-bind (a . b)
- (mpd-songpos)
- (truncate (* (xwem-osd-width xwem-mpd-osd) (/
(float a) b))))
- (+ y-off (/ bw 2)) (plist-get bar-plist :depth)
(plist-get bar-plist :color))
+ (let* ((bw (plist-get bar-plist :width))
+ (x0 0) (y0 (+ y-off (/ bw 2)))
+ (x1 (destructuring-bind (a . b)
+ (mpd-songpos)
+ (truncate (* (xwem-osd-width xwem-mpd-osd) (/ (float a)
b)))))
+ (y1 (+ y-off (/ bw 2))))
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'bar-instance))
+ (if (xwem-osd-instance-p osin)
+ (xwem-mpd-unless-in-cache osin 'bar-geom (vector x0 y0 x1 y1)
+ (xwem-osd-instance-change osin :x0 x0 :y0 y0 :x1 x1 :y1 y1))
+ (setq osin (xwem-osd-line-add xwem-mpd-osd x0 y0 x1 y1 :line-width
bw
+ :depth (plist-get bar-plist :depth)
+ :color (plist-get bar-plist :color)))
+ (xwem-osd-put-prop xwem-mpd-osd 'bar-instance osin))
(setq y-off (+ y-off bw)))
;; Track
- (xwem-osd-set-font xwem-mpd-osd (plist-get track-plist :font))
- (xwem-osd-text-add xwem-mpd-osd 0 y-off track-str (plist-get
track-plist :depth)
- (plist-get track-plist :color))
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'track-instance))
+ (if (xwem-osd-instance-p osin)
+ (xwem-mpd-unless-in-cache osin 'track track-str
+ (xwem-osd-instance-change osin :text track-str :y y-off))
+ (setq osin (xwem-osd-text-add xwem-mpd-osd 0 y-off track-str
+ :depth (plist-get track-plist :depth)
+ :color (plist-get track-plist :color)
+ :font (plist-get track-plist :font)))
+ (xwem-osd-put-prop xwem-mpd-osd 'track-instance osin))
;; Volume
- (xwem-osd-set-font xwem-mpd-osd (plist-get vol-plist :font))
(let* ((vol-y (if (> (length art-str) (length track-str)) y-off 0))
(vtext (concat **mpd-var-volume* "%"))
(vtwid (X-Text-width (xwem-osd-xdpy xwem-mpd-osd)
(X-Font-get (xwem-osd-xdpy xwem-mpd-osd)
(plist-get vol-plist :font))
vtext)))
- (xwem-osd-text-add xwem-mpd-osd (- (xwem-osd-width xwem-mpd-osd)
vtwid) vol-y vtext
- (plist-get vol-plist :depth) (plist-get vol-plist
:color)))
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'volume-instance))
+ (if (xwem-osd-instance-p osin)
+ (xwem-mpd-unless-in-cache osin 'volume vtext
+ (xwem-osd-instance-change
+ osin :text vtext :x (- (xwem-osd-width xwem-mpd-osd) vtwid)
:y vol-y))
+ (setq osin (xwem-osd-text-add xwem-mpd-osd (- (xwem-osd-width
xwem-mpd-osd) vtwid) vol-y vtext
+ :depth (plist-get vol-plist :depth)
+ :color (plist-get vol-plist :color)
+ :font (plist-get vol-plist :font)))
+ (xwem-osd-put-prop xwem-mpd-osd 'volume-instance osin)))
;; Lyrics
- (when (mpd-lyric-check)
- (unless (xwem-osd-get-prop xwem-mpd-osd 'lyric-pixmap)
- (xwem-osd-put-prop xwem-mpd-osd 'lyric-pixmap
- (X:xpm-pixmap-from-file
- (xwem-osd-xdpy xwem-mpd-osd) (xwem-osd-xwin xwem-mpd-osd)
- (xwem-icon-find-file (plist-get lyr-plist :icon)))))
- (unless (xwem-osd-get-prop xwem-mpd-osd 'lyric-mask)
- (xwem-osd-put-prop xwem-mpd-osd 'lyric-mask
- (X:xpm-pixmap-from-file
- (xwem-osd-xdpy xwem-mpd-osd) (xwem-osd-xwin xwem-mpd-osd)
- (xwem-icon-find-file (plist-get lyr-plist :icon)) t)))
-
- (let* ((pw (X-Pixmap-width (xwem-osd-get-prop xwem-mpd-osd
'lyric-pixmap)))
- (li-y (if (> (length art-str) (length track-str)) 0 y-off)))
- (xwem-osd-icon-pixmap-add
- xwem-mpd-osd (xwem-osd-get-prop xwem-mpd-osd 'lyric-pixmap)
- (xwem-osd-get-prop xwem-mpd-osd 'lyric-mask)
- (- (xwem-osd-width xwem-mpd-osd) pw) li-y
- (plist-get lyr-plist :depth))))
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'lyric-instance))
+ (if (mpd-lyric-check)
+ (progn
+ (unless (xwem-osd-instance-p osin)
+ (setq osin (xwem-osd-icon-file-add
+ xwem-mpd-osd (xwem-icon-find-file (plist-get
lyr-plist :icon))
+ :depth (plist-get lyr-plist :depth)
+ :keymap (let ((map (make-sparse-keymap
'mpd-lyric-map)))
+ (define-key map [button1]
'mpd-lyric-show)
+ map)))
+ (xwem-osd-put-prop xwem-mpd-osd 'lyric-instance osin))
+ (let* ((pw (X-Pixmap-width (xwem-osd-instance-get-prop osin
:pixmap)))
+ (li-y (if (> (length art-str) (length track-str)) 0
y-off)))
+ (xwem-osd-instance-change osin :x (- (xwem-osd-width
xwem-mpd-osd) pw) :y li-y))
+ ;; Show instance in case it is hidden
+ (when (xwem-osd-instance-get-prop osin 'lyric-hidden)
+ (xwem-osd-instance-show osin)
+ (xwem-osd-instance-put-prop osin 'lyric-hidden nil)))
+ ;; Hide instance in case it is show and no lyrics available
+ (when (and (xwem-osd-instance-p osin)
+ (not (xwem-osd-instance-get-prop osin 'lyric-hidden)))
+ (xwem-osd-instance-hide osin)
+ (xwem-osd-instance-put-prop osin 'lyric-hidden t)))
;; State
- (when (or (mpd-stopped-p) (mpd-paused-p))
- (xwem-osd-set-font xwem-mpd-osd (plist-get st-plist :font))
+ (if (or (mpd-stopped-p) (mpd-paused-p))
(let* ((txt (eval (plist-get st-plist :format)))
(fnt (X-Font-get (xwem-osd-xdpy xwem-mpd-osd)
(plist-get st-plist :font)))
(w (X-Text-width (xwem-osd-xdpy xwem-mpd-osd) fnt txt))
- (h (X-Text-height (xwem-osd-xdpy xwem-mpd-osd) fnt txt)))
- (xwem-osd-text-add xwem-mpd-osd
- (/ (- (xwem-osd-width xwem-mpd-osd) w) 2)
- (/ (- (xwem-osd-height xwem-mpd-osd) h) 2)
- txt (plist-get st-plist :depth)
- (plist-get st-plist :color)))))
+ (h (X-Text-height (xwem-osd-xdpy xwem-mpd-osd) fnt txt))
+ (x (/ (- (xwem-osd-width xwem-mpd-osd) w) 2))
+ (y (/ (- (xwem-osd-height xwem-mpd-osd) h) 2)))
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'state-instance))
+ (if (xwem-osd-instance-p osin)
+ (progn
+ (xwem-mpd-unless-in-cache osin 'state (vector txt x y)
+ (xwem-osd-instance-change osin :text txt :x x :y y))
+ (xwem-osd-instance-show osin))
+ (setq osin (xwem-osd-text-add xwem-mpd-osd x y txt
+ :depth (plist-get st-plist :depth)
+ :color (plist-get st-plist :color)
+ :font (plist-get st-plist :font)))
+ (xwem-osd-put-prop xwem-mpd-osd 'state-instance osin)))
+ ;; Hide state instance
+ (setq osin (xwem-osd-get-prop xwem-mpd-osd 'state-instance))
+ (when (xwem-osd-instance-p osin)
+ (xwem-osd-instance-hide osin))))
- (xwem-osd-commit xwem-mpd-osd))))
+; (xwem-osd-commit xwem-mpd-osd)
+ )))
(provide 'xwem-mpd)
--- orig/dockapp/xwem-pager.el
+++ mod/dockapp/xwem-pager.el
@@ -31,43 +31,16 @@
;; Simple dockapp to show xwem frames. Somekind of extension of
;; xwem-framei.el
+;;
+;; To start using it add:
+;;
+;; (add-hook 'xwem-after-init-hook 'xwem-pager)
;;; Code:
(require 'xwem-load)
(require 'xlib-xshape)
-
-;; veryvery simple pager / 2d viewport support
-;; the code works, do the following:
-;;
-;; add to XWEM-after-init-hook:
-;;
-;; (setq *pager-dockapp* (xwem-2dframes-start-dockapp))
-;;
-;; ugly i know, that starts the dockapp
-;;
-;; (xwem-2dframes-make-frames)
-;;
-;; that will create the frames
-;;
-;; load this code, restart your XWEM and be happy. If you want to try it
-;; out without restarting then MAKE SURE you have only 1 frame, load the
-;; code then:
-;; M-x xwem-2dframes-make-frames
-;;
-;; eval (setq *pager-dockapp* (xwem-2dframes-start-dockapp))
-;;
-;; change viewports / frames somehow so the dockapp gets updated
-;;
-;; i know this code is hackis, but if you rename the variables / sturcture
-;; the code like you want it to be i'll work on it to make it full featured
-;; + add more comments / docstrings.
-
-;;; //////////////////////////////////////////////////////////////////////
-
-
-;;;; Pager
(defgroup xwem-pager nil
"Group to customize xwem pager."
:prefix "xwem-pager-"
@@ -120,7 +93,7 @@
:group 'xwem-pager)
(define-xwem-face xwem-pager-face
- `(((selected) (:foreground "grey30"))
+ `(((selected) (:foreground "cyan4"))
((border selected) (:foreground "grey10"))
((deselected) (:foreground "grey55"))
((border deselected) (:foreground "grey35"))
@@ -318,7 +291,7 @@
X-ButtonPress X-ButtonRelease))
;; Initialize wd in sys tray
- (xwem-XTrayInit (xwem-dpy) pwin dockid dockgroup dockalign)
+ (xwem-XTrayInit (xwem-dpy) pwin dockid (or dockgroup "desktop") dockalign)
(add-hook 'xwem-frame-select-hook 'xwem-pager-frame-redraw)
(add-hook 'xwem-frame-deselect-hook 'xwem-pager-frame-redraw)
@@ -362,7 +335,6 @@
`(xwem-pager-remove ,(X-Event-win xwem-last-xevent) t)))))
-;;;; 2D Frames
;;;###autoload
(defun xwem-pager-make-frames ()
"Make the frames, call from XWEM-AFTER-INIT-HOOK!"
@@ -410,7 +382,7 @@
;;;###autoload
(defun xwem-pager-install-bindings ()
- "Install default bindings for 2D frames commands."
+ "Install default bindings for pager commands."
(xwem-global-set-key [(super h)] 'xwem-pager-move-left)
(xwem-global-set-key [(super t)] 'xwem-pager-move-down)
(xwem-global-set-key [(super n)] 'xwem-pager-move-up)
--- orig/dockapp/xwem-weather.el
+++ mod/dockapp/xwem-weather.el
@@ -33,12 +33,19 @@
;; Set this up by adding the following code to your ~/.xwem/xwemrc.el
-;; (require 'xwem-weather)
-;; (customize-set-variable 'xwem-weather-update-frequency 3600)
-;; (add-hook 'xwem-after-init-hook 'xwem-weather-init)
+;; (require 'xwem-weather)
+;; (customize-set-variable 'xwem-weather-update-frequency 3600)
+;; (add-hook 'xwem-after-init-hook 'xwem-weather-init)
+
+;; You might also consider seting `xwem-weather-fetch-function'. Set
+;; it to `xwem-weather-fetch-direct' if you have direct connection to
+;; the internet, or set it to `xwem-weather-fetch-with-url' to use url
+;; package in case you connect through proxy
;;; Code:
+(eval-when-compile
+ (autoload 'url-retrieve "url"))
(require 'itimer)
@@ -70,12 +77,6 @@
:type '(directory :must-match t)
:group 'xwem-weather)
-(defcustom xwem-weather-data-file
- (expand-file-name xwem-weather-station-id xwem-weather-data-directory)
- "*File to hold the weather data."
- :type 'file
- :group 'xwem-weather)
-
(defcustom xwem-weather-temperature-format 'celsius
"*Display temperature in Celsius or Fahrenheit."
:type '(choice
@@ -176,19 +177,34 @@
:initialize 'custom-initialize-default
:group 'xwem-weather)
-(defconst xwem-weather-url-fqdn "weather.noaa.gov"
- "FQDN part of the weather URL.")
+(defcustom xwem-weather-fetch-function 'xwem-weather-fetch-default
+ "Function used to fetch weather file.
+Use `xwem-weather-fetch-with-url' to use `url' package, or
+`xwem-weather-fetch-direct' if you have direct connect to internet."
+ :type 'function
+ :group 'xwem-weather)
-(defconst xwem-weather-url-dir "pub/data/observations/metar/decoded"
- "Directory part of the weather URL.")
+(defconst xwem-weather-url
"http://weather.noaa.gov/pub/data/observations/metar/decoded";
+ "URL used to fetch decoded weather files.")
-(defun xwem-weather-retrieve-update ()
- "Retrieve weather info."
- (let* ((host xwem-weather-url-fqdn)
- (dir xwem-weather-url-dir)
- (file (upcase (concat xwem-weather-station-id ".txt")))
- (path (concat dir "/" file))
- (user-agent (concat "XEmacs " emacs-program-version))
+(defun xwem-weather-data-file ()
+ "Return filename where to store/read weather info."
+ (expand-file-name (concat "weather-" xwem-weather-station-id)
+ xwem-weather-data-directory))
+
+(defun xwem-weather-fetch-with-url (url)
+ "Fetch URL using `url' package."
+ (require 'url)
+ (let ((url-inhibit-mime-parsing t))
+ (setq url-inhibit-mime-parsing url-inhibit-mime-parsing) ; shutup compiler
+ (get-buffer (cdr (url-retrieve url)))))
+
+(defun xwem-weather-fetch-direct (url)
+ "Fetch URL making direct connect to site."
+ (let* ((mp (string-match "http://\\([^/:]*\\)\\(.*$\\)" url))
+ (host (and mp (match-string 1 url)))
+ (path (and mp (match-string 2 url)))
+ (user-agent (concat emacs-program-name "-" emacs-program-version))
(http (open-network-stream "xwem-weather-update"
" *xwem-weather-update-buf*"
host 80))
@@ -204,9 +220,26 @@
"User-Agent: " user-agent "\r\n\r\n"))
(while (eq (process-status http) 'open)
(dispatch-event (next-event)))
- (with-temp-buffer
- (erase-buffer)
- (insert-buffer pbuf)
+ pbuf))
+
+(defun xwem-weather-fetch-default (url)
+ "Default autoconfiguring fetcher.
+It tries `xwem-weather-fetch-direct' first, and then switches to
+`xwem-weather-fetch-with-url' if direct connect is not possible."
+ (condition-case nil
+ (prog1
+ (xwem-weather-fetch-direct url)
+ (setq xwem-weather-fetch-function 'xwem-weather-fetch-direct))
+ (t (prog1
+ (xwem-weather-fetch-with-url url)
+ (setq xwem-weather-fetch-function 'xwem-weather-fetch-with-url)))))
+
+(defun xwem-weather-retrieve-update ()
+ "Retrieve weather info."
+ (let ((pbuf (funcall xwem-weather-fetch-function
+ (concat xwem-weather-url "/"
+ (upcase (concat xwem-weather-station-id
".txt"))))))
+ (with-current-buffer pbuf
(goto-char (point-min))
(re-search-forward "^Content-Length: \\([0-9]+.*$\\)" nil t)
(let* ((file-length (string-to-int (match-string 1)))
@@ -217,15 +250,14 @@
(point-at-bol))))
(goto-char file-begin)
(forward-char file-length)
- (narrow-to-region file-begin (point))
- (write-region (point-min) (point-max) xwem-weather-data-file)))
+ (write-region file-begin (point) (xwem-weather-data-file))))
(kill-buffer pbuf)))
(defun xwem-weather-get-temp ()
"Return the temperature as a string from the weather data file."
(with-temp-buffer
(erase-buffer)
- (insert-file-contents-literally xwem-weather-data-file)
+ (insert-file-contents-literally (xwem-weather-data-file))
(goto-char (point-min))
(when (re-search-forward
"^Temperature: \\(-?[0-9]+ F\\) (\\(-?[0-9]+ C\\))" nil t)
@@ -283,7 +315,7 @@
"*Show the details of the current weather information."
(xwem-interactive)
(xwem-help-display "weather"
- (insert-file-contents xwem-weather-data-file)))
+ (insert-file-contents (xwem-weather-data-file))))
;;;###autoload(autoload 'xwem-weather-popup-remove "xwem-weather" nil t)
(define-xwem-command xwem-weather-remove ()
@@ -341,8 +373,10 @@
(xwem-weather-display-text text))))
;;;###autoload
-(defun xwem-weather-init (&optional dockid dockgroup dockalign)
+(defun xwem-weather (&optional dockid dockgroup dockalign)
"Initialise the weather dock."
+ (interactive)
+
(when (xwem-osd-p xwem-weather-osd)
(xwem-osd-destroy xwem-weather-osd))
(when (itimerp (get-itimer "xwem-weather-itimer"))
@@ -354,6 +388,8 @@
xwem-weather-frequency
xwem-weather-frequency)))
+(defalias 'xwem-weather-init 'xwem-weather)
+
(provide 'xwem-weather)
--- orig/lisp/xwem-clients.el
+++ mod/lisp/xwem-clients.el
@@ -2298,10 +2298,12 @@
(xwem-execute-method 'other-client (xwem-cl-manage-type cl) cl))
(define-xwem-method other-client default (cl)
- "Default other-client method."
- (xwem-cl-other cl))
+ "Default other-client method.
+By default no other client available."
+ nil)
(define-xwem-method on-kill default (cl)
+ "Default on-kill method."
(xwem-select-last-or-other-client cl))
@@ -2475,6 +2477,7 @@
(xwem-clded-disassociate-frame cl))
(define-xwem-method on-kill dedicated (cl)
+ (xwem-select-last-or-other-client cl)
(xwem-clded-disassociate-frame cl))
(define-xwem-manage-model dedicated
--- orig/lisp/xwem-frame.el
+++ mod/lisp/xwem-frame.el
@@ -886,32 +886,17 @@
(and (xwem-frame-p frame)
(xwem-frame-draw frame nil))))
-(defun xwem-frame-remove (frame &optional select-other)
- "Remove FRAME from frames list, switch to other frame if SELECT-OTHER is
non-nil."
- (let ((oframe (xwem-frame-other frame 'any))) ; other frame
-
- ;; Remove FRAME from linkage if any
- (xwem-frame-link-remove frame)
-
- ;; Now Remove FRAME from frame list
- (unless xwem-frame-keep-number
- (setq xwem-frames-list (delq frame xwem-frames-list)))
-
- ;; If frame is not selected it mean that it was embedded
- (if (and select-other (xwem-frame-p oframe) (not (eq oframe frame)))
- (xwem-select-frame oframe)
- (setq xwem-current-frame nil))))
-
(defun xwem-frame-total-remove (frame)
"Totally remove FRAME."
;; Firstly we need to remove FRAME from frames list.
(let ((embed-cl (xwem-frame-get-prop frame 'xwem-embedded-cl))
- (oframe (xwem-frame-other frame)))
+ (oframe (xwem-frame-other frame 'any)))
;; If FRAME is selected, select some other frame
- (setq xwem-current-frame nil)
- (when (xwem-frame-p oframe)
- (xwem-select-frame oframe))
+ (when (xwem-frame-selected-p frame)
+ (setq xwem-current-frame nil)
+ (when (xwem-frame-p oframe)
+ (xwem-select-frame oframe)))
;; Block events handling
(XSelectInput (xwem-dpy) (xwem-frame-xwin frame) 0)
@@ -936,8 +921,10 @@
(when (xwem-cl-p embed-cl)
(xwem-cl-destroy embed-cl))
- ;; Remove frame from frames list and select another frame
- (xwem-frame-remove frame t)
+ ;; Remove FRAME from various lists
+ (xwem-frame-link-remove frame)
+ (unless xwem-frame-keep-number
+ (setq xwem-frames-list (delq frame xwem-frames-list)))
(xwem-unwind-protect
;; Now run on-destroy hooks
--- orig/lisp/xwem-interactive.el
+++ mod/lisp/xwem-interactive.el
@@ -116,7 +116,14 @@
(xwem-minib-cl xwem-minibuffer) 'skip-deselect t)
(xwem-select-client (xwem-minib-cl xwem-minibuffer))
(xwem-unwind-protect
- (progn ,@forms)
+ ;; XXX We *MUST NOT* enter debugger here --lg
+ (let ((debug-on-error nil)
+ (debug-on-signal nil)
+ (debug-on-quit nil)
+ (debug-on-next-call nil)
+ (debug-function-list nil))
+ (setq debug-function-list debug-function-list) ; shutup compiler
+ (progn ,@forms))
(xwem-client-set-property
(xwem-minib-cl xwem-minibuffer) 'skip-deselect nil)
(xwem-select-last-or-other-client
--- orig/lisp/xwem-keyboard.el
+++ mod/lisp/xwem-keyboard.el
@@ -318,10 +318,14 @@
If NO-MINIB-FOCUS-P is non-nil, focus `xwem-minibuffer' while reading."
(xwem-kbd-stop-command-keys-echoing)
(xwem-kbd-start-grabbing)
- (car (if no-minib-focus-p
- (xwem-next-command-event prompt)
- (xwem-under-minibuffer
- (xwem-next-command-event prompt)))))
+ (let ((event (car (if no-minib-focus-p
+ (xwem-next-command-event prompt)
+ (xwem-under-minibuffer
+ (xwem-next-command-event prompt))))))
+ (unless inhibit-quit
+ (when (equal (events-to-keys (vector event)) xwem-quit-key)
+ (signal 'quit '(xwem))))
+ event))
(defun xwem-read-key-sequence-1 (&optional continue-echo)
(xwem-kbd-stop-command-keys-echoing)
--- orig/lisp/xwem-launcher.el
+++ mod/lisp/xwem-launcher.el
@@ -820,7 +820,7 @@
(list X-Expose X-MapNotify X-ButtonPress
X-ButtonRelease X-DestroyNotify))
- (xwem-XTrayInit (xwem-dpy) xwin dockid dockgroup dockalign)
+ (xwem-XTrayInit (xwem-dpy) xwin dockid (or dockgroup "launch") dockalign)
xwin))
--- orig/lisp/xwem-minibuffer.el
+++ mod/lisp/xwem-minibuffer.el
@@ -209,6 +209,13 @@
"*Non-nil mean xwem minibuffer is raised when activated."
:type 'boolean
:group 'xwem-minibuffer)
+
+(defcustom xwem-minib-frame-autoraise t
+ "*Non-nil minibuffer's frame is raised when minibuffer is selected.
+It is pretty wise to keep it non-nil, because dockapps may lie above
+the frame and you wont see what you are typing."
+ :type 'boolean
+ :group 'xwem-minibuffer)
(defcustom xwem-minibuffer-emacs-frames-has-minibuffer t
"*Non-nil mean Emacs frames will have their own minibuffers."
@@ -582,12 +589,14 @@
;; Events handler
(define-xwem-deffered xwem-minib-focusin-autoraise (minib)
- "Mainly for use in `xwem-minibuffer-focusout-hook'."
- (xwem-misc-raise-xwin (xwem-minib-xwin minib)))
+ "Mainly for use in `xwem-minibuffer-focusin-hook'."
+ (when xwem-minib-frame-autoraise
+ (XRaiseWindow (xwem-dpy) (xwem-minib-cl-xwin minib))))
(define-xwem-deffered xwem-minib-focusout-autolower (minib)
"Mainly for use in `xwem-minibuffer-focusout-hook'."
- (xwem-misc-lower-xwin (xwem-minib-xwin minib)))
+ (when xwem-minib-frame-autoraise
+ (XLowerWindow (xwem-dpy) (xwem-minib-cl-xwin minib))))
;;;###autoload(autoload 'xwem-minibuffer-activate "xwem-minibuffer" "" t)
(define-xwem-command xwem-minibuffer-activate ()
@@ -631,6 +640,10 @@
(setq xwem-minibuffer (make-xwem-minib))
(setf (xwem-minib-frame xwem-minibuffer)
(make-initial-minibuffer-frame nil))
+
+ (add-hook 'xwem-minibuffer-focusin-hook 'xwem-minib-focusin-autoraise)
+ (add-hook 'xwem-minibuffer-focusout-hook 'xwem-minib-focusout-autolower)
+
(xwem-message 'init "Initializing minibuffer ... done"))
;;; Resize-minibuffer mode
@@ -747,38 +760,46 @@
(let ((usz (xwem-cl-get-usize cl)))
(format "%dx%d" (car usz) (cdr usz)))
"--")
- "Modeline format.")
+ "Modeline format.
+Number of triangular brackets shows current minibuffer depth.")
(xwem-make-variable-client-local 'xwem-modeline-format)
-(defun xwem-modeline-regenerate ()
+(defun xwem-last-nonminibuffer-client ()
+ "Return last non-minibuffer client.
+If selected client is non minibuffer - return selected client."
+ (let ((lcs (cons (xwem-cl-selected) xwem-last-clients)))
+ (while (and lcs (xwem-minibuffer-client-p (car lcs)))
+ (setq lcs (cdr lcs)))
+ (car lcs)))
+
+(defun xwem-modeline-regenerate (cl)
"Regenerate modeline string."
(mapconcat #'(lambda (me)
- (let ((cl (xwem-cl-selected)))
- (setq cl cl) ; shutup compiler
- (condition-case nil
- (let ((str "") (faces nil))
- (setq me (eval me))
- (if (listp me)
- (setq str (copy-sequence (car me))
- faces (cdr me))
- (setq str (copy-sequence me)
- faces nil))
- (xwem-str-with-faces str (append '(modeline) faces)))
- (t "<error>"))))
+ ;; NOTE: CL symbol is bound here
+ (condition-case nil
+ (let ((str "") (faces nil))
+ (setq me (eval me))
+ (if (listp me)
+ (setq str (copy-sequence (car me))
+ faces (cdr me))
+ (setq str (copy-sequence me)
+ faces nil))
+ (xwem-str-with-faces str (append '(modeline) faces)))
+ (t "<error>")))
xwem-modeline-format ""))
(define-xwem-deffered xwem-modeline-redraw (&optional cl)
"Redraw xwem modeline."
- (if (xwem-cl-alive-p cl)
- (when (xwem-cl-selected-p cl)
- (xwem-modeline-redraw))
-
- ;; XXX this assumes 'modeline face has fixed width font
- (let* ((str (xwem-modeline-regenerate))
- (mw (/ (gutter-pixel-width 'top (xwem-minib-frame xwem-minibuffer))
- (face-width 'modeline (xwem-minib-frame xwem-minibuffer)))))
- (set-specifier top-gutter (substring str 0 (and (> (length str) mw) mw))
- (xwem-minib-frame xwem-minibuffer)))))
+ ;; XXX this assumes 'modeline face has fixed width font
+ (let* ((lnmc (xwem-last-nonminibuffer-client))
+ (cl (or cl lnmc)))
+ (when (and (eq cl lnmc)
+ (xwem-cl-alive-p cl))
+ (let* ((str (xwem-modeline-regenerate cl))
+ (mw (/ (gutter-pixel-width 'top (xwem-minib-frame
xwem-minibuffer))
+ (face-width 'modeline (xwem-minib-frame
xwem-minibuffer)))))
+ (set-specifier top-gutter (substring str 0 (and (> (length str) mw)
mw))
+ (xwem-minib-frame xwem-minibuffer))))))
;;;###autoload(autoload 'xwem-modeline-enable "xwem-minibuffer" nil t)
(define-xwem-command xwem-modeline-enable ()
--- orig/lisp/xwem-misc.el
+++ mod/lisp/xwem-misc.el
@@ -1025,13 +1025,19 @@
;;;###autoload(autoload 'xwem-mini-calc "xwem-misc" nil t)
(define-xwem-command xwem-mini-calc (expr &optional arg)
"Calculate expression EXPR.
-If prefix ARG is given, insert the result to current client."
+If some region is active or cutbuffer is selected - calculate selected
+region.
+If prefix ARG is given, insert the result to current client.
+
+BUGS: prefix ARG might not work if region is active or some cutbuffer
+is selected."
(xwem-interactive
- (list (xwem-read-from-minibuffer (if xwem-prefix-arg
- "XWEM (insert) Calc: "
- "XWEM Calc: "))
+ (list (or (xwem-selection)
+ (xwem-read-from-minibuffer (if xwem-prefix-arg
+ "XWEM (insert) Calc: "
+ "XWEM Calc: ")))
xwem-prefix-arg))
-
+ (zmacs-deactivate-region)
(let ((result (calc-eval expr)))
(if arg
(xwem-kbd-add-pending-keys result)
--- orig/lisp/xwem-selections.el
+++ mod/lisp/xwem-selections.el
@@ -107,6 +107,13 @@
'(X-Atom-id target)))
)))
+;;;###xwem-autoload
+(defun xwem-selection ()
+ "Return either active region or active PRIMARY selection."
+ (or (and (region-active-p)
+ (buffer-substring (region-beginning) (region-end)))
+ (ignore-errors (get-selection))))
+
;;;###autoload(autoload 'xwem-help-cutbuffers "xwem-selections" "Display help
about cutbuffers." t)
(define-xwem-command xwem-help-cutbuffers ()
"Show help buffer about cutbuffers."
@@ -116,7 +123,7 @@
(insert "X cutbuffers:\n\n")
(insert "NUMBER VALUE\n")
(insert "------ -----\n")
- (insert (format "%-9s%S\n" 'PRIMARY (get-selection)))
+ (insert (format "%-9s%S\n" 'PRIMARY (ignore-errors (get-selection))))
(mapc #'(lambda (n)
(let ((cbval (x-get-cutbuffer n)))
(when cbval
@@ -141,17 +148,12 @@
cutbuffer."
(xwem-interactive "p")
- (if (region-active-p)
- (xwem-copy-region-as-cutbuffer)
-
- (decf which-one)
- (let ((cb0 (condition-case nil
- (get-selection)
- (t (x-get-cutbuffer which-one)))))
- (if (not cb0)
- (xwem-message 'note "No active selection")
- (push cb0 xwem-selections)
- (xwem-message 'info "Copying %S" cb0)))))
+ (let ((sel (or (xwem-selection)
+ (x-get-cutbuffer which-one))))
+ (if (not sel)
+ (xwem-message 'note "No active selection")
+ (push sel xwem-selections)
+ (xwem-message 'info "Copying %S" sel))))
;;;###autoload(autoload 'xwem-paste-cutbuffer "xwem-selections" "Paste
CUTBUFFER0 to `xwem-selections'." t)
(define-xwem-command xwem-paste-cutbuffer (&optional no-remove)
@@ -180,18 +182,6 @@
no-remove))
(setq xwem-selections (delq sel xwem-selections)))))
-;;;###autoload(autoload 'xwem-copy-region-as-cutbuffer "xwem-selections" "Copy
region to `xwem-selections'." t)
-(define-xwem-command xwem-copy-region-as-cutbuffer ()
- "Copy selected region to `xwem-selections' as ordinary cutbuffer."
- (xwem-interactive)
-
- (unless (region-active-p)
- (error 'xwem-error "No active region"))
-
- (let ((rr (buffer-substring (region-beginning) (region-end))))
- (push rr xwem-selections)
- (xwem-message 'info "Copying: %S" rr)))
-
(provide 'xwem-selections)
--- orig/lisp/xwem-struct.el
+++ mod/lisp/xwem-struct.el
@@ -400,7 +400,7 @@
(defmacro xwem-last-client (&optional num)
"Return NUMs last selected client."
- '(nth (or num 0) xwem-last-clients))
+ `(nth (or ,num 0) xwem-last-clients))
(defsetf xwem-last-client () (cl)
`(progn
(push ,cl xwem-last-clients)
--- orig/lisp/xwem-tray.el
+++ mod/lisp/xwem-tray.el
@@ -37,13 +37,13 @@
;; See how mbdock from matchbox made.
;;
;; xwem tray creates fake window which is only used to hold selection
-;; needed for communicatio, xwem minibuffer window will be used for
+;; needed for communication, xwem minibuffer window will be used for
;; holding apps.
;;
;;; TODO:
;; - Proper possition in `xwem-minibuffer' calculation.
;; - Run elisp support(almost already done).
-;;
+;; - Grouping (yet EXPERIMENTAL)
;;; Code:
@@ -62,13 +62,7 @@
"*Hook to be called whin new message from dock app.
Function will be called with arg - dockapp.")
-(defcustom xwem-tray-id 0 "System tray identificator.")
-
-(defcustom xwem-tray-name "xwem-tray"
- "X Name for xwem tray.")
-
-(defcustom xwem-tray-class '("xwem-tray" "xwem-tray")
- "X Class for xwem tray")
+(defvar xwem-tray-id 0 "System tray identificator.")
(defconst xwem-tray-evmask (Xmask-or XM-SubstructureNotify
XM-Exposure
@@ -86,7 +80,8 @@
(defcustom xwem-tray-use-groups nil
"*Non-nil mean systray with use EXPERIMENTAL dockapp grouping.
-Set it to non-nil on your own risk."
+Set it to non-nil on your own risk.
+DOES NOT WORK."
:type 'boolean
:group 'xwem-tray)
@@ -97,7 +92,7 @@
:group 'xwem-tray)
(defcustom xwem-tray-minib-start-offset 4
- "*Start offset in pixels."
+ "*Offset in pixels from the minibuffer edge where first dockapp is placed."
:type 'number
:group 'xwem-tray)
@@ -107,7 +102,8 @@
:group 'xwem-tray)
(defcustom xwem-tray-groups-distance 5
- "*Minimum distance between systray groups."
+ "*Minimum distance between systray groups.
+Only when `xwem-tray-use-groups' is non-nil."
:type 'number
:group 'xwem-tray)
@@ -170,12 +166,11 @@
;;; Internal variables
(defvar xwem-tray-groups '("desktop" "launch" "misc" "default")
- "List of valid dockapp groups.")
+ "List of predefined dockapp groups.")
(defconst xwem-tray-align-left 1)
(defconst xwem-tray-align-right 2)
-
;;; Internal variables
(defvar xwem-tray nil
"Default xwem system tray.")
@@ -316,13 +311,14 @@
(defun xwem-tray-group-create (name &rest params)
"Create and return new systray group, giving it NAME.
Additional PARAMS can be specified."
- (let ((xtg (apply 'make-xwem-tray-group :name name params)))
+ (let ((xtg (apply #'make-xwem-tray-group :name name params)))
(unless (xwem-tray-group-align xtg)
(setf (xwem-tray-group-align xtg)
xwem-tray-default-align))
(unless (xwem-tray-group-xgeom xtg)
(setf (xwem-tray-group-xgeom xtg)
- (make-X-Geom :x 0 :y 0 :width 16 :height 16)))
+ (make-X-Geom :x 0 :y 0 :width 16
+ :height 32 :border-width 1)))
(setf (X-Geom-x (xwem-tray-group-xgeom xtg))
(xwem-tray-group-get-position xtg))
@@ -345,6 +341,9 @@
;; Add to tray's groups
(setf (xwem-tray-groups xwem-tray)
(cons xtg (xwem-tray-groups xwem-tray)))
+
+ ;; And show the window
+ (XMapWindow (xwem-dpy) (xwem-tray-group-xwin xtg))
xtg))
(defun xwem-tray-group-same-align-sorted (group)
@@ -364,8 +363,8 @@
(X-Geom-width (xwem-tray-group-xgeom group)))))
(if (eq (xwem-tray-group-align group) 'left)
(setq glist (cdr (memq group glist)))
- (setq glist (cdr (memq group (nreverse glist)))
- off (- new-width)))
+ (setq glist (memq group (nreverse glist))
+ off (- off)))
(mapc #'(lambda (g)
(incf (X-Geom-x (xwem-tray-group-xgeom g)) off)
@@ -373,7 +372,7 @@
(X-Geom-x (xwem-tray-group-xgeom g))
(X-Geom-y (xwem-tray-group-xgeom g))))
glist)
- (incf (X-Geom-width (xwem-tray-group-xgeom group)) off)
+ (setf (X-Geom-width (xwem-tray-group-xgeom group)) new-width)
(XResizeWindow (xwem-dpy) (xwem-tray-group-xwin group)
(X-Geom-width (xwem-tray-group-xgeom group))
(X-Geom-height (xwem-tray-group-xgeom group)))
@@ -402,8 +401,8 @@
(defun xwem-tray-group-attach-dapp (group dapp)
"To tray GROUP attach dock application DAPP."
(let ((gdapps (xwem-tray-group-dockapps group)))
- (XReparentWindow (xwem-dpy) (xwem-tray-group-xwin group)
- (xwem-dapp-xwin dapp) 0 0)
+ (XReparentWindow (xwem-dpy) (xwem-dapp-xwin dapp)
+ (xwem-tray-group-xwin group) 0 0)
(while (and gdapps
(> (xwem-dapp-id (car gdapps))
(xwem-dapp-id dapp)))
@@ -431,16 +430,17 @@
because in time you doing it xwem-tray may be uninitialised."
(xwem-tray-startit xdpy) ; make sure systray initialized
- (when dockid
- (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ID")
- XA-integer X-format-16 X-PropModeReplace dockid))
- (when dockgroup
- (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_GROUP")
- XA-string X-format-8 X-PropModeReplace dockgroup))
- (when dockalign
- (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ALIGN")
- XA-integer X-format-16 X-PropModeReplace dockalign))
-
+ ;; Import dapp properties
+ (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ID")
+ XA-integer X-format-16 X-PropModeReplace
+ (list (or dockid 0)))
+ (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_GROUP")
+ XA-string X-format-8 X-PropModeReplace
+ (or dockgroup "default"))
+ (XChangeProperty xdpy xwin (XInternAtom xdpy "XWEM_DOCK_ALIGN")
+ XA-integer X-format-16 X-PropModeReplace
+ (list (or dockalign xwem-tray-align-right)))
+
(XTrayInit xdpy xwin))
;;;###xwem-autoload
@@ -465,6 +465,21 @@
;;
;; Has many of common code, get rid of it --lg
+(defun xwem-tray-move-many-dapps (dapp-list x-offset x-lim)
+ "Move dockapps in DAPP-LIST."
+ (mapc #'(lambda (dapp)
+ (ecase xwem-tray-default-align
+ (right
+ (when (< (X-Geom-x (xwem-dapp-geom dapp)) x-lim)
+ (xwem-tray-move-dapp
+ dapp (+ (X-Geom-x (xwem-dapp-geom dapp)) x-offset) nil)))
+
+ (left
+ (when (> (X-Geom-x (xwem-dapp-geom dapp)) x-lim)
+ (xwem-tray-move-dapp
+ dapp (- (X-Geom-x (xwem-dapp-geom dapp)) x-offset) nil)))))
+ dapp-list))
+
(defun xwem-tray-remove-dapp (dapp)
"Remove dock application DAPP from xwem tray dockapps list."
(let ((dgeom (xwem-dapp-geom dapp))
@@ -476,26 +491,9 @@
;; Move other dapps to fill free space
(unless (eq state 'hidden)
- (mapc #'(lambda (dapp)
- (ecase xwem-tray-default-align
- (right
- (when (< (X-Geom-x (xwem-dapp-geom dapp))
- (X-Geom-x dgeom))
- (xwem-tray-move-dapp dapp
- (+ (X-Geom-x (xwem-dapp-geom dapp))
- (X-Geom-width dgeom)
- xwem-tray-minib-dock-offset)
- (X-Geom-y (xwem-dapp-geom dapp)))))
-
- (left
- (when (> (X-Geom-x (xwem-dapp-geom dapp))
- (X-Geom-x dgeom))
- (xwem-tray-move-dapp dapp
- (- (X-Geom-x (xwem-dapp-geom dapp))
- (X-Geom-width dgeom)
- xwem-tray-minib-dock-offset)
- (X-Geom-y (xwem-dapp-geom dapp)))))))
- xwem-tray-dapp-list))))
+ (xwem-tray-move-many-dapps
+ xwem-tray-dapp-list (+ (X-Geom-width dgeom) xwem-tray-minib-dock-offset)
+ (X-Geom-x dgeom)))))
(defun xwem-tray-hide-dapp (hide-dapp &optional unmap-p)
"Hide dockapp DAPP temporary.
@@ -516,7 +514,7 @@
(+ (X-Geom-x (xwem-dapp-geom dapp))
(X-Geom-width dgeom)
xwem-tray-minib-dock-offset)
- (X-Geom-y (xwem-dapp-geom dapp)))))
+ nil)))
(left
(when (> (X-Geom-x (xwem-dapp-geom dapp))
@@ -525,7 +523,7 @@
(- (X-Geom-x (xwem-dapp-geom dapp))
(X-Geom-width dgeom)
xwem-tray-minib-dock-offset)
- (X-Geom-y (xwem-dapp-geom
dapp))))))))
+ nil))))))
xwem-tray-dapp-list))))
(defun xwem-tray-show-dapp (show-dapp &optional map-p)
@@ -547,7 +545,7 @@
(- (X-Geom-x (xwem-dapp-geom dapp))
(X-Geom-width dgeom)
xwem-tray-minib-dock-offset)
- (X-Geom-y (xwem-dapp-geom dapp)))))
+ nil)))
(left
(when (> (X-Geom-x (xwem-dapp-geom dapp))
@@ -556,7 +554,7 @@
(+ (X-Geom-x (xwem-dapp-geom dapp))
(X-Geom-width dgeom)
xwem-tray-minib-dock-offset)
- (X-Geom-y (xwem-dapp-geom
dapp))))))))
+ nil))))))
xwem-tray-dapp-list))))
(defun xwem-tray-get-proper-position (width)
@@ -577,21 +575,27 @@
(+ (X-Geom-width (xwem-minib-cl-xgeom xwem-minibuffer))
dtlen)))))
-(define-xwem-deffered xwem-tray-apply-dapp-position (dapp)
- "Apply DAPP's position to life."
+(define-xwem-deffered xwem-tray-apply-dapp-x-position (dapp)
+ "Apply DAPP's X position to life."
+ (when (xwem-dapp-alive-p dapp)
+ (XConfigureWindow (xwem-dpy) (xwem-dapp-xwin dapp)
+ :x (X-Geom-x (xwem-dapp-geom dapp)))))
+
+(define-xwem-deffered xwem-tray-apply-dapp-y-position (dapp)
+ "Apply DAPP's Y position."
(when (xwem-dapp-alive-p dapp)
- (XMoveWindow (xwem-dpy) (xwem-dapp-xwin dapp)
- (X-Geom-x (xwem-dapp-geom dapp))
- (X-Geom-y (xwem-dapp-geom dapp)))))
+ (XConfigureWindow (xwem-dpy) (xwem-dapp-xwin dapp)
+ :y (X-Geom-y (xwem-dapp-geom dapp)))))
(defun xwem-tray-move-dapp (dapp new-x new-y)
"Move DAPP to NEW-X, NEW-Y position.
If NEW-X or NEW-Y is nil - corresponding value is retained."
(when new-x
- (setf (X-Geom-x (xwem-dapp-geom dapp)) new-x))
+ (setf (X-Geom-x (xwem-dapp-geom dapp)) new-x)
+ (xwem-tray-apply-dapp-x-position dapp))
(when new-y
- (setf (X-Geom-y (xwem-dapp-geom dapp)) new-y))
- (xwem-tray-apply-dapp-position dapp))
+ (setf (X-Geom-y (xwem-dapp-geom dapp)) new-y)
+ (xwem-tray-apply-dapp-y-position dapp)))
(defun xwem-tray-new-dapp (xwin)
"New dock application XWIN wants to be managed."
@@ -626,7 +630,7 @@
(add-to-list 'xwem-tray-dapp-list dapp)
(X-Win-EventHandler-add-new xwin 'xwem-dapp-handle-xevent
- 100 (list X-ClientMessage))
+ 100 (list X-ClientMessage X-ConfigureNotify))
(if xwem-tray-use-groups
(xwem-tray-group-attach-dapp
@@ -699,7 +703,22 @@
(X-Event-CASE xev
(:X-ClientMessage
(xwem-dapp-handle-client-message xev))
- ))
+
+ (:X-ConfigureNotify
+ (let* ((dapp (xwem-tray-find-dapp (X-Event-xconfigure-window xev)))
+ (dgeom (xwem-dapp-geom dapp))
+ (nw (X-Event-xconfigure-width xev))
+ (nh (X-Event-xconfigure-height xev)))
+ (when (and (xwem-dapp-alive-p dapp)
+ (not (= nw (X-Geom-width dgeom))))
+ ;; Dockapp has been resized, move other dockapps if necessary
+ (xwem-tray-move-many-dapps xwem-tray-dapp-list (- (X-Geom-width
dgeom) nw)
+ (+ (X-Geom-x dgeom) (X-Geom-width dgeom)))
+ (setf (X-Geom-width (xwem-dapp-geom dapp)) nw))
+ (when (and (xwem-dapp-alive-p dapp)
+ (not (= nh (X-Geom-height dgeom))))
+ (xwem-tray-move-dapp
+ dapp nil (/ (- (X-Geom-height (xwem-minib-xgeom xwem-minibuffer))
nh) 2)))))))
(defun xwem-tray-create (dpy)
"Creates new XWEM system tray on DPY.
@@ -716,8 +735,8 @@
100 (list X-ClientMessage))
;; Setup various hints
- (XSetWMClass dpy win xwem-tray-class)
- (XSetWMName dpy win xwem-tray-name)
+ (XSetWMClass dpy win '("xwem-tray" "xwem-tray"))
+ (XSetWMName dpy win "xwem-tray")
(setf (xwem-tray-xwin xwem-tray) win)
(setf (xwem-tray-plist xwem-tray) nil)
@@ -822,7 +841,7 @@
(mapc #'(lambda (dapp)
(setf (X-Geom-y (xwem-dapp-geom dapp))
(/ (- height (X-Geom-height (xwem-dapp-geom dapp)))
2))
- (xwem-tray-apply-dapp-position dapp))
+ (xwem-tray-apply-dapp-y-position dapp))
xwem-tray-dapp-list)))))))
(defun xwem-tray-startit (&optional dpy)
@@ -846,8 +865,7 @@
xwem-tray-dapp-list)
(setq xwem-tray-dapp-list nil)
- (setq xwem-tray-cursor nil)
- )
+ (setq xwem-tray-cursor nil))
;;;###autoload
(defun xwem-tray-delimeter (&optional w h bgcol)
@@ -886,7 +904,7 @@
;;;###autoload
(defun xwem-manage-systray (cl)
"Manage method for systray dockaps."
- (xwem-XTrayInit (xwem-dpy) (xwem-cl-xwin cl)))
+ (xwem-XTrayInit (xwem-dpy) (xwem-cl-xwin cl) nil "misc" nil))
(provide 'xwem-tray)
--- orig/utils/xwem-osd.el
+++ mod/utils/xwem-osd.el
@@ -117,10 +117,9 @@
(defstruct xwem-osd-instance
type ; instance type, see
`xwem-osd-instance-types'
osd ; back reference to osd
- (depth 0) ; depth
xwin xmask
- color ; instance background color
+ xgc ; instance local GC
plist) ; User defined plist
@@ -195,94 +194,236 @@
(xwem-dispatch-command-xevent xev)))))
)))
+(defmacro xwem-osd-get-instance (xwin)
+ `(X-Win-get-prop ,xwin 'xwem-osd-instance))
+
+(defmacro xwem-osd-set-instance (xwin osin)
+ `(X-Win-put-prop ,xwin 'xwem-osd-instance ,osin))
+
;;; Instances operations
-(defun xwem-osd-instance-destroy (osin)
+(defun xwem-osd-instance-event-handler (xdpy xwin xev)
+ "On X display XDPY and window XWIN handle X Event XEV."
+ (let* ((osin (xwem-osd-get-instance xwin))
+ (keymap (xwem-osd-instance-get-prop osin 'keymap)))
+ (when (xwem-osd-instance-p osin)
+ (X-Event-CASE xev
+ (:X-DestroyNotify
+ (xwem-osd-instance-destroy osin t))
+
+ ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
+ (when (keymapp keymap)
+ (xwem-overriding-local-map keymap
+ (xwem-dispatch-command-xevent xev)))))
+ )))
+
+(defun xwem-osd-instance-destroy (osin &optional ddw)
"Destroy osd instance OSIN."
- (let ((xdpy (xwem-osd-instance-xdpy osin)))
- (XDestroyWindow xdpy (xwem-osd-instance-xwin osin))
- ;; Do not free colour to avoid X Access errors
-; (XFreeColors xdpy (XDefaultColormap xdpy)
-; (list (xwem-osd-instance-color osin)) nil)
- (XFreePixmap xdpy (xwem-osd-instance-xmask osin))
+ (let ((xdpy (xwem-osd-instance-xdpy osin))
+ (osd (xwem-osd-instance-osd osin)))
+ ;; Remove from instances list
+ (setf (xwem-osd-instances osd)
+ (delq osin (xwem-osd-instances osd)))
- (X-invalidate-cl-struct osin)))
+ ;; Release X resources
+ (XFreeGC xdpy (xwem-osd-instance-xgc osin))
+ (unless ddw
+ (XDestroyWindow xdpy (xwem-osd-instance-xwin osin)))
+ (XFreePixmap xdpy (xwem-osd-instance-xmask osin))
-(defun xwem-osd-add-instance (osd depth &optional color)
- "In OSD add osd instance with background COLOR.
-Return newly created osd instance."
- (unless depth
- (setq depth 0))
- (unless color
- (setq color
- (or (X-Color-name (X-Gc-foreground (xwem-osd-gc osd)))
- xwem-osd-default-color)))
+ (X-invalidate-cl-struct osin)
+ (xwem-osd-redraw osd)))
- (let* ((xdpy (xwem-osd-xdpy osd))
- (osin (make-xwem-osd-instance
- :osd osd :depth depth
- :color (XAllocNamedColor xdpy (XDefaultColormap xdpy)
- color))))
+(defun xwem-osd-instance-clear-xmask (osin)
+ "Clear mask area of OSD instance."
+ (let ((osd (xwem-osd-instance-osd osin)))
+ (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-instance-xmask osin)
+ xwem-misc-mask-bgc
+ 0 0 (xwem-osd-width osd) (xwem-osd-height osd))))
+
+(defun xwem-osd-instance-add (osd type &rest plist)
+ "In OSD add osd instance of TYPE and properties PLIST."
+ (let* ((depth (or (plist-get plist :depth) 0))
+ (color (or (plist-get plist :color)
+ xwem-osd-default-color))
+ (xdpy (xwem-osd-xdpy osd))
+ (osin (make-xwem-osd-instance :type type :osd osd :plist plist)))
(setf (xwem-osd-instance-xwin osin)
(XCreateWindow xdpy (xwem-osd-xwin osd)
0 0 (xwem-osd-width osd) (xwem-osd-height osd)
0 nil nil nil
:override-redirect t
- :background-pixel (xwem-osd-instance-color osin)))
- (setf (xwem-osd-instance-xmask osin)
+ :background-pixel
+ (XAllocColor xdpy (XDefaultColormap xdpy)
+ (xwem-make-color color))
+ :event-mask (when (plist-get plist :keymap)
+ (Xmask-or XM-ButtonPress
XM-ButtonRelease)))
+ (xwem-osd-instance-xmask osin)
(XCreatePixmap xdpy (xwem-osd-instance-xwin osin) 1
- (xwem-osd-width osd) (xwem-osd-height osd)))
- (xwem-osd-instance-clear osin)
+ (xwem-osd-width osd) (xwem-osd-height osd))
+ (xwem-osd-instance-xgc osin)
+ (XCreateGC xdpy (xwem-osd-instance-xmask osin)
+ :foreground 1.0 :background 0.0
+ :line-width (plist-get plist :line-width)
+ :font (if (plist-get plist :font)
+ (X-Font-get xdpy (plist-get plist :font))
+ (X-Gc-font (xwem-osd-gc osd)))))
+ (xwem-osd-set-instance (xwem-osd-instance-xwin osin) osin)
+ (xwem-osd-instance-clear-xmask osin)
(push osin (xwem-osd-instances osd))
+ (xwem-osd-instance-set-depth osin depth)
- ;; - Sort instances according to depth
- ;; - Install below sibling
- (setf (xwem-osd-instances osd)
- (sort (xwem-osd-instances osd)
- (lambda (s1 s2)
- (< (xwem-osd-instance-depth s1) (xwem-osd-instance-depth
s2)))))
-
- (let ((siblings (xwem-osd-instances osd))
- below-sibl)
- (while siblings
- (if (>= (xwem-osd-instance-depth (car siblings)) depth)
- (setq siblings nil)
- (setq below-sibl (car siblings)))
- (setq siblings (cdr siblings)))
-
- (when below-sibl
- (XConfigureWindow xdpy (xwem-osd-instance-xwin osin)
- :sibling (xwem-osd-instance-xwin below-sibl)
- :stackmode X-Below)))
+ (when (plist-get plist :keymap)
+ (xwem-osd-instance-put-prop osin 'keymap (plist-get plist :keymap))
+ (X-Win-put-prop (xwem-osd-instance-xwin osin) 'osd-instance osin)
+ (X-Win-EventHandler-add-new (xwem-osd-instance-xwin osin)
+ 'xwem-osd-instance-event-handler))
osin))
-(defun xwem-osd-instance-clear (osin)
- "Clear mask area of OSD instance."
- (let ((osd (xwem-osd-instance-osd osin)))
- (xwem-osd-mask-fgbg osd)
- (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-instance-xmask osin)
(xwem-osd-mask-gc osd)
- 0 0 (xwem-osd-width osd) (xwem-osd-height osd))
- (xwem-osd-mask-fgbg osd)))
+(put 'xwem-osd-instance-add 'lisp-indent-function 2)
(defun xwem-osd-instance-show (osin)
"Show osd instance OSIN."
- (XMapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin)))
+ (XMapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin))
+ (pushnew osin (xwem-osd-instances (xwem-osd-instance-osd osin)))
+ (xwem-osd-instance-set-depth osin (xwem-osd-instance-get-prop osin :depth))
+ (xwem-osd-instance-draw osin))
+
+(defun xwem-osd-instance-hide (osin)
+ "Hide osd instance OSIN"
+ (XUnmapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin))
+ (let ((osd (xwem-osd-instance-osd osin)))
+ (setf (xwem-osd-instances osd)
+ (delq osin (xwem-osd-instances osd)))
+ (xwem-osd-redraw osd)))
+
+(define-xwem-deffered xwem-osd-instance-apply-xmask (osin)
+ "Apply instances OSIN mask to life."
+ (let ((xdpy (xwem-osd-instance-xdpy osin)))
+ (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
+ X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))))
+
+(define-xwem-deffered xwem-osd-instance-draw (osin)
+ "Draw OSD instance OSIN."
+ (let ((xdpy (xwem-osd-instance-xdpy osin))
+ (osd (xwem-osd-instance-osd osin)))
+ (xwem-osd-instance-clear-xmask osin)
+
+ (ecase (xwem-osd-instance-type osin)
+ (text
+ (let* ((x (xwem-osd-instance-get-prop osin :x))
+ (y (xwem-osd-instance-get-prop osin :y))
+ (string (xwem-osd-instance-get-prop osin :text))
+ (fnt (X-Gc-font (xwem-osd-instance-xgc osin)))
+ (yoff (- (X-Text-height xdpy fnt string)
+ (X-Text-descent xdpy fnt string))))
+ (XDrawString xdpy (xwem-osd-instance-xmask osin)
(xwem-osd-instance-xgc osin)
+ x (+ y yoff) string)
+ (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-instance-xgc osin)
+ x (+ y yoff) string)))
+
+ (line
+ (let ((x0 (xwem-osd-instance-get-prop osin :x0))
+ (y0 (xwem-osd-instance-get-prop osin :y0))
+ (x1 (xwem-osd-instance-get-prop osin :x1))
+ (y1 (xwem-osd-instance-get-prop osin :y1)))
+ (XDrawLine xdpy (xwem-osd-instance-xmask osin) (xwem-osd-instance-xgc
osin)
+ x0 y0 x1 y1)
+ (XDrawLine xdpy (xwem-osd-xmask osd) (xwem-osd-instance-xgc osin)
+ x0 y0 x1 y1)))
+
+ (dots
+ (let ((type (xwem-osd-instance-get-prop osin :dots-type))
+ (dots (xwem-osd-instance-get-prop osin :dots)))
+ (xwem-diag-plot-dots type (xwem-osd-instance-xmask osin)
+ (xwem-osd-instance-xgc osin)
+ 0 (xwem-osd-height osd) dots)
+ (xwem-diag-plot-dots type (xwem-osd-xmask osd)
+ (xwem-osd-instance-xgc osin)
+ 0 (xwem-osd-height osd) dots)))
+
+ (arc
+ (let ((xarc (xwem-osd-instance-get-prop osin :xarc)))
+ (XDrawArcs xdpy (xwem-osd-instance-xmask osin)
+ (xwem-osd-instance-xgc osin) (list xarc))
+ (XDrawArcs xdpy (xwem-osd-xmask osd) (xwem-osd-instance-xgc osin)
+ (list xarc))))
+
+ (rect
+ (let ((x (xwem-osd-instance-get-prop osin :x))
+ (y (xwem-osd-instance-get-prop osin :y))
+ (width (xwem-osd-instance-get-prop osin :width))
+ (height (xwem-osd-instance-get-prop osin :height))
+ (fill-p (xwem-osd-instance-get-prop osin :fill)))
+ (XDrawRectangles xdpy (xwem-osd-instance-xmask osin)
+ (xwem-osd-instance-xgc osin)
+ (list (make-X-Rect :x x :y y :width width :height
height))
+ fill-p)
+ (XDrawRectangles xdpy (xwem-osd-xmask osd) (xwem-osd-instance-xgc
osin)
+ (list (make-X-Rect :x x :y y :width width :height
height))
+ fill-p)))
+
+ (pixmap
+ (let ((pix (xwem-osd-instance-get-prop osin :pixmap))
+ (mask (xwem-osd-instance-get-prop osin :mask))
+ (x (xwem-osd-instance-get-prop osin :x))
+ (y (xwem-osd-instance-get-prop osin :y)))
+ (XCopyArea xdpy mask (xwem-osd-instance-xmask osin)
+ xwem-misc-mask-bgc 0 0
+ (X-Pixmap-width mask) (X-Pixmap-height mask)
+ 0 0)
+ (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
+ X-XShape-Bounding X-XShapeSet 0 0
(xwem-osd-instance-xmask osin))
+ (XCopyArea xdpy mask (xwem-osd-xmask osd)
+ xwem-misc-mask-bgc 0
+ (X-Pixmap-width mask) (X-Pixmap-height mask)
+ x y)
+ (XMoveResizeWindow (xwem-dpy) (xwem-osd-instance-xwin osin) x y
+ (X-Pixmap-width mask) (X-Pixmap-height mask))
+ (XSetWindowBackgroundPixmap (xwem-dpy) (xwem-osd-instance-xwin osin)
pix)))
+ )
+
+ (XMapWindow xdpy (xwem-osd-instance-xwin osin))
+ (xwem-osd-instance-apply-xmask osin)
+ (xwem-osd-apply-xmask osd)))
(defun xwem-osd-instance-set-color (osin new-color)
"Set new color."
(let ((xdpy (xwem-osd-instance-xdpy osin)))
- ;; Do not free colour to avoid X Access errors
-; (XFreeColors xdpy (XDefaultColormap xdpy)
-; (list (xwem-osd-instance-color osin)) nil)
- (setf (xwem-osd-instance-color osin)
- (XAllocNamedColor xdpy (XDefaultColormap xdpy)
- new-color))
+ (xwem-osd-instance-put-prop osin :color new-color)
(XSetWindowBackground xdpy (xwem-osd-instance-xwin osin)
- (xwem-osd-instance-color osin))
+ (XAllocColor xdpy (XDefaultColormap xdpy)
+ (xwem-make-color new-color)))
(XClearArea xdpy (xwem-osd-instance-xwin osin)
0 0 (xwem-osd-width (xwem-osd-instance-osd osin))
(xwem-osd-height (xwem-osd-instance-osd osin)) nil)))
+(defun xwem-osd-instance-set-depth (osin new-depth)
+ "For OSD instance OSIN to depth to NEW-DEPTH."
+ (xwem-osd-instance-put-prop osin :depth new-depth)
+
+ ;; - Sort instances according to depth
+ ;; - Install below sibling
+ (setf (xwem-osd-instances (xwem-osd-instance-osd osin))
+ (sort (xwem-osd-instances (xwem-osd-instance-osd osin))
+ #'(lambda (s1 s2)
+ (< (xwem-osd-instance-get-prop s1 :depth)
+ (xwem-osd-instance-get-prop s2 :depth)))))
+
+ (let ((siblings (xwem-osd-instances (xwem-osd-instance-osd osin)))
+ below-sibl)
+ (while siblings
+ (if (>= (xwem-osd-instance-get-prop (car siblings) :depth) new-depth)
+ (setq siblings nil)
+ (setq below-sibl (car siblings)))
+ (setq siblings (cdr siblings)))
+
+ (when below-sibl
+ (XConfigureWindow (xwem-osd-instance-xdpy osin)
+ (xwem-osd-instance-xwin osin)
+ :sibling (xwem-osd-instance-xwin below-sibl)
+ :stackmode X-Below))))
+
;;; OSD functions
;;;###autoload
(defun xwem-osd-create (xdpy x y width height &optional x-parent properties)
@@ -297,9 +438,9 @@
(keymap (plist-get properties 'keymap))
(stack-rank (plist-get properties 'stack-rank)))
(setf (xwem-osd-xwin osd)
- (XCreateWindow xdpy (or x-parent (XDefaultRootWindow xdpy))
- x y width height 0 nil nil nil
- :override-redirect t
+ (XCreateWindow xdpy (or x-parent (XDefaultRootWindow xdpy))
+ x y width height 0 nil nil nil
+ :override-redirect t
:background-pixel (XBlackPixel xdpy)
:event-mask (Xmask-or XM-StructureNotify
(if keymap
@@ -325,32 +466,25 @@
osd))
;;;###autoload
-(defun xwem-osd-create-dock (xdpy width height &optional properties)
+(defun xwem-osd-create-dock (xdpy width height &optional osd-props dockid
dockgroup dockalign)
"Create docked osd instance.
XDPY - Display.
-X, Y, WIDTH, HEIGHT - OSD Geometry."
- (let ((osd (xwem-osd-create xdpy 0 0 width height nil properties)))
+WIDTH, HEIGHT - OSD Geometry.
+DOCKID, DOCKGROUP and DOCKALIGN specifies how dock is placed in tray."
+ (let ((osd (xwem-osd-create xdpy 0 0 width height nil osd-props)))
(xwem-osd-clear osd)
- (xwem-XTrayInit xdpy (xwem-osd-xwin osd))
+ (xwem-XTrayInit xdpy (xwem-osd-xwin osd) dockid (or dockgroup "desktop")
dockalign)
osd))
(defun xwem-osd-get-osd (xwin)
"Get osd context associated with XWIN."
(and (X-Win-p xwin) (X-Win-get-prop xwin 'osd-ctx)))
-(defun xwem-osd-mask-fgbg (osd)
- "Exchange foreground and background colors in OSD's mask gc."
- (let* ((mgc (xwem-osd-mask-gc osd))
- (fg (X-Gc-foreground mgc))
- (bg (X-Gc-background mgc)))
- (XChangeGC (xwem-osd-xdpy osd) mgc :foreground bg :background fg)))
-
(defun xwem-osd-clear-mask (osd)
"Clear mask area of OSD context."
- (xwem-osd-mask-fgbg osd)
- (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-xmask osd) (xwem-osd-mask-gc
osd)
- 0 0 (xwem-osd-width osd) (xwem-osd-height osd))
- (xwem-osd-mask-fgbg osd))
+ (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-xmask osd)
+ xwem-misc-mask-bgc
+ 0 0 (xwem-osd-width osd) (xwem-osd-height osd)))
(defun xwem-osd-create-mask (osd)
"For xwem osd context OSD create mask pixmap."
@@ -420,18 +554,21 @@
(xwem-osd-apply-xmask-1 osd)
(XMapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))
(xwem-misc-raise-xwin (xwem-osd-xwin osd))
-
(setf (xwem-osd-state osd) 'shown))
(defun xwem-osd-hide (osd)
"Hide OSD's window."
(XUnmapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))
-
(setf (xwem-osd-state osd) 'hidden))
+(define-xwem-deffered xwem-osd-redraw (osd)
+ "Redraw all OSD's instances."
+ (xwem-osd-clear-mask osd)
+ (mapc #'xwem-osd-instance-draw (xwem-osd-instances osd)))
+
(defun xwem-osd-destroy-instances (osd)
"Destroy all instances in OSD."
- (mapc 'xwem-osd-instance-destroy (xwem-osd-instances osd))
+ (mapc #'xwem-osd-instance-destroy (xwem-osd-instances osd))
(setf (xwem-osd-instances osd) nil))
(defun xwem-osd-destroy (osd &optional already-destroyed)
@@ -460,10 +597,15 @@
(defun xwem-osd-char-width (osd)
"Return width of OSD's window in characters."
- ;; XXX assumes that font is width fixed
+ ;; XXX assumes font is width fixed
(/ (xwem-osd-width osd)
(X-Text-width (xwem-osd-xdpy osd) (X-Gc-font (xwem-osd-mask-gc osd))
"_")))
+(define-xwem-deffered xwem-osd-apply-xmask (osd)
+ "Apply OSD's mask to life."
+ (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
+ X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)))
+
(defun xwem-osd-clear-xwin (osd)
"Clear contents of OSD's window."
(XClearArea (xwem-osd-xdpy osd) (xwem-osd-xwin osd) 0 0
@@ -475,11 +617,6 @@
(xwem-osd-clear-mask osd)
(xwem-osd-apply-xmask osd))
-(define-xwem-deffered xwem-osd-apply-xmask (osd)
- "Apply OSD's mask to life."
- (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)))
-
(defun xwem-osd-text (osd string)
"In OSD's context show STRING.
If OSD has any instances, they will be destroyed."
@@ -495,179 +632,117 @@
(xwem-osd-apply-xmask osd)))
(defun xwem-osd-color-text (osd strspec-list)
- "In OSD's win draw colored text specified by STRSPEC-LIST."
+ "In OSD's win draw colored text specified by STRSPEC-LIST.
+STRSPEC is list of cons cell where car is string and cdr is color."
(xwem-osd-clear osd)
(let ((curstr ""))
- (mapcar (lambda (strspec)
- (let* ((xdpy (xwem-osd-xdpy osd))
- (str (concat curstr (car strspec)))
- (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc
osd)) str)
- (X-Text-descent xdpy (X-Gc-font
(xwem-osd-mask-gc osd)) str))))
- (xwem-osd-set-xwin-color osd (cdr strspec))
- (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
- 0 yoff str)
- (xwem-osd-apply-xmask osd)
-
- (setq curstr (concat curstr (car strspec)))))
+ (mapcar #'(lambda (strspec)
+ (let* ((xdpy (xwem-osd-xdpy osd))
+ (str (concat curstr (car strspec)))
+ (yoff (- (X-Text-height xdpy (X-Gc-font
(xwem-osd-mask-gc osd)) str)
+ (X-Text-descent xdpy (X-Gc-font
(xwem-osd-mask-gc osd)) str))))
+ (xwem-osd-set-xwin-color osd (cdr strspec))
+ (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
+ 0 yoff str)
+ (xwem-osd-apply-xmask osd)
+ (setq curstr (concat curstr (car strspec)))))
strspec-list)))
-
-(defun xwem-osd-text-add (osd x y string &optional depth color)
- "In OSD's context at X Y coordinates add STRING colored with COLOR."
- (let* ((xdpy (xwem-osd-xdpy osd))
- (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)
- (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd))
string)))
- osin)
-
- ;; Setup OSD instance
- (setq osin (xwem-osd-add-instance osd depth color))
- (setf (xwem-osd-instance-type osin) 'text)
- (XDrawString xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
- x (+ y yoff) string)
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
- (xwem-osd-instance-show osin)
- ;; Update window shape
- (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
- x (+ y yoff) string)
- (xwem-osd-apply-xmask osd)
+(defun xwem-osd-instance-change (osin &rest props)
+ "For OSD instance OSIN change properties specified by PROPS.
+And redraw whole OSD."
+ ;; Change depth and color in case they are given
+ (let ((depth (plist-get props :depth))
+ (color (plist-get props :color)))
+ (when depth
+ (xwem-osd-instance-set-depth osin depth))
+ (when color
+ (xwem-osd-instance-set-color osin color)))
+
+ ;; Merge in new properties
+ (while props
+ (xwem-osd-instance-put-prop osin (first props) (second props))
+ (setq props (cddr props)))
+
+ ;; Change instance GC
+ (let ((xdpy (xwem-osd-instance-xdpy osin))
+ (xgc (xwem-osd-instance-xgc osin))
+ (font (xwem-osd-instance-get-prop osin :font)))
+ (setf (X-Gc-line-width xgc) (xwem-osd-instance-get-prop osin :line-width))
+ (when font
+ (setf (X-Gc-font xgc) (X-Font-get xdpy font)))
+ (XChangeGC xdpy xgc))
+
+ ;; And redraw whole OSD
+ (xwem-osd-redraw (xwem-osd-instance-osd osin)))
+
+(defun xwem-osd-text-add (osd x y text &rest props)
+ "In OSD's context at X Y coordinates add TEXT.
+Supported PROPS are :depth, :color"
+ (let ((osin (apply #'xwem-osd-instance-add osd 'text
+ :x x :y y :text text props)))
+ (xwem-osd-instance-draw osin)
osin))
-(defun xwem-osd-set-line-width (osd new-line-width)
- "Set OSD's gc line width to NEW-LINE-WIDTH."
- (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-gc osd) :line-width new-line-width)
- (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd) :line-width
new-line-width))
-
-(defun xwem-osd-line-add (osd x0 y0 x1 y1 &optional depth color)
- "In OSD's window add line."
- (let ((xdpy (xwem-osd-xdpy osd))
- osin)
-
- ;; Create OSD line instance
- (setq osin (xwem-osd-add-instance osd depth color))
- (setf (xwem-osd-instance-type osin) 'line)
- (XDrawLine xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
- x0 y0 x1 y1)
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
- (xwem-osd-instance-show osin)
-
- ;; Update OSD window shape
- (XDrawLine xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
- x0 y0 x1 y1)
- (xwem-osd-apply-xmask osd)
+(defun xwem-osd-line-add (osd x0 y0 x1 y1 &rest props)
+ "In OSD's window add line.
+Supported PROPS are :depth, :color, :line-width"
+ (let ((osin (apply #'xwem-osd-instance-add osd 'line
+ :x0 x0 :y0 y0 :x1 x1 :y1 y1 props)))
+ (xwem-osd-instance-draw osin)
osin))
-(defun xwem-osd-dots-add (osd dots type &optional depth color)
- "In OSD's window add DOTS of TYPE."
- (let ((xdpy (xwem-osd-xdpy osd))
- osin)
-
- ;; Create OSD dots instancne
- (setq osin (xwem-osd-add-instance osd depth color))
- (setf (xwem-osd-instance-type osin) 'dots)
- (xwem-diag-plot-dots type (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc
osd)
- 0 (xwem-osd-height osd) dots)
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
- (xwem-osd-instance-show osin)
-
- ;; Update OSD window shape
- (xwem-diag-plot-dots type (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
- 0 (xwem-osd-height osd) dots)
- (xwem-osd-apply-xmask osd)
+(defun xwem-osd-dots-add (osd dots-type dots &rest props)
+ "In OSD's window add DOTS-TYPE DOTS.
+Supported PROPS are :depth, :color"
+ (let ((osin (apply #'xwem-osd-instance-add osd 'dots
+ :dots-type dots-type :dots dots props)))
+ (xwem-osd-instance-draw osin)
osin))
-(defun xwem-osd-arc-add (osd xarc &optional depth color)
- "In OSD's window draw arc specified by XARC."
- (let ((xdpy (xwem-osd-xdpy osd))
- osin)
-
- ;; Create OSD arc instance
- (setq osin (xwem-osd-add-instance osd depth color))
- (setf (xwem-osd-instance-type osin) 'arc)
- (XDrawArcs xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
- (list xarc))
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
- (xwem-osd-instance-show osin)
-
- ;; Update OSD shape
- (XDrawArcs xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
- (list xarc))
- (xwem-osd-apply-xmask osd)
+(defun xwem-osd-arc-add (osd xarc &rest props)
+ "In OSD's window draw arc specified by XARC.
+Supported PROPS are :depth, :color"
+ (let ((osin (apply #'xwem-osd-instance-add osd 'arc
+ :xarc xarc props)))
+ (xwem-osd-instance-draw osin)
osin))
-(defun xwem-osd-rect-add (osd x y width height &optional depth color fill-p)
+(defun xwem-osd-rect-add (osd x y width height &rest props)
"In OSD's window add rectangle specified by X Y WIDTH and HEIGHT.
-If FILL-P is non-nil, rectangle will be filled instead of outdrawing."
- (let ((xdpy (xwem-osd-xdpy osd))
- osin)
-
- ;; Created OSD rect instance
- (setq osin (xwem-osd-add-instance osd depth color))
- (setf (xwem-osd-instance-type osin) 'rect)
- (XDrawRectangles xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
- (list (make-X-Rect :x x :y y :width width :height height))
- fill-p)
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
- (xwem-osd-instance-show osin)
-
- ;; Update OSD shape
- (XDrawRectangles xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd)
- (list (make-X-Rect :x x :y y :width width :height height))
- fill-p)
- (xwem-osd-apply-xmask osd)
+Supported PROPS are :depth, :color, :fill"
+ (let ((osin (apply #'xwem-osd-instance-add osd 'rect
+ :x x :y y :width width :height height props)))
+ (xwem-osd-instance-draw osin)
osin))
-(defun xwem-osd-icon-pixmap-add (osd pixmap mask &optional x y depth)
- "In OSD's window add pixmap icon."
- (unless depth (setq depth 0))
- (unless x (setq x 0))
- (unless y (setq y 0))
-
- (let ((xdpy (xwem-osd-xdpy osd))
- (osin (xwem-osd-add-instance osd depth)))
- (setf (xwem-osd-instance-type osin) 'icon)
-
- (XCopyArea xdpy mask (xwem-osd-instance-xmask osin)
- xwem-misc-mask-bgc 0 0
- (X-Pixmap-width mask) (X-Pixmap-height mask)
- 0 0)
- (X-XShapeMask xdpy (xwem-osd-instance-xwin osin)
- X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask
osin))
- (XCopyArea xdpy mask (xwem-osd-xmask osd)
- xwem-misc-mask-bgc 0 0
- (X-Pixmap-width mask) (X-Pixmap-height mask)
- x y)
- (xwem-osd-apply-xmask osd)
- (XMoveResizeWindow (xwem-dpy) (xwem-osd-instance-xwin osin) x y
- (X-Pixmap-width mask) (X-Pixmap-height mask))
- (XSetWindowBackgroundPixmap (xwem-dpy) (xwem-osd-instance-xwin osin)
pixmap)
- (xwem-osd-instance-show osin)
+(defun xwem-osd-pixmap-add (osd pixmap mask &rest props)
+ "In OSD's window add pixmap icon.
+Supported PROPS are :depth, :x, :y"
+ (let ((osin (apply #'xwem-osd-instance-add osd 'pixmap
+ :pixmap pixmap :mask mask props)))
+ (xwem-osd-instance-draw osin)
osin))
-(defun xwem-osd-icon-data-add (osd xpm-data &optional x y depth)
+(defun xwem-osd-icon-data-add (osd xpm-data &rest props)
"In OSD's window add icon.
X and Y specifies osd instance location inside OSD(default is 0 0).
DEPTH specifies osd instance depth(default is 0).
XPM-DATA string of xpm image."
- (xwem-osd-icon-pixmap-add
- osd
- (X:xpm-pixmap-from-data
- (xwem-osd-xdpy osd) (xwem-osd-xwin osd) xpm-data)
- (X:xpm-pixmap-from-data
- (xwem-osd-xdpy osd) (xwem-osd-xwin osd) xpm-data t)
- x y depth))
+ (apply #'xwem-osd-pixmap-add osd
+ (X:xpm-pixmap-from-data
+ (xwem-osd-xdpy osd) (xwem-osd-xwin osd) xpm-data)
+ (X:xpm-pixmap-from-data
+ (xwem-osd-xdpy osd) (xwem-osd-xwin osd) xpm-data t)
+ props))
-(defun xwem-osd-icon-file-add (osd xpm-file &optional x y depth)
+(defun xwem-osd-icon-file-add (osd xpm-file &rest props)
"Same as `xwem-osd-icon-data-add', but takes xpm image from FILE."
(let (xpm-data)
(with-temp-buffer
(insert-file-contents-literally xpm-file)
(setq xpm-data (buffer-substring)))
- (xwem-osd-icon-data-add osd xpm-data x y depth)))
+ (apply #'xwem-osd-icon-data-add osd xpm-data props)))
(defun xwem-osd-offscreen (osd)
"Put OSD off the screen, displaying OSD copy.
--- orig/utils/xwem-worklog.el
+++ mod/utils/xwem-worklog.el
@@ -318,27 +318,42 @@
(buffer-major-mode lisp-interaction-mode)
(and (application "xemacs")
(name "\\(\\*scratch\\*\\|\\.el\\)"))))
- ("C for fun" (:key [(hyper ?f)] :color "tomato" :cost 0))
("C for profit" (:key [(hyper ?p)] :color "magenta" :cost 100)
- (or (buffer-major-mode cvs-mode)
- (buffer-major-mode c-mode)
+ (or (buffer-major-mode c-mode)
(buffer-major-mode gdb-mode)
(application "ddd")
(and (or (application "xemacs")
(and (class-inst "^.term$")
(class-name "^.Term$")))
- (name "\\(gdb\\|\\*cvs\\*\\|\\.[ch]\\)"))))
- ("WorkProject" (:key [(hyper ?c)] :color "green2" :cost 200))
+ (name "\\(gdb\\|\\.[ch]\\)"))))
+ ("Docs reading" (:key [(hyper ?d) ?r] :color "forestgreen" :cost 50)
+ (or (application "acroread")
+ (application "xpdf")
+ (application "djview")
+ (application "gv")
+ (application "xchm")))
+ ("Docs writing" (:key [(hyper ?d) ?w] :color "olivedrab" :cost 300)
+ (or (buffer-major-mode plain-tex-mode)
+ (buffer-major-mode bibtex-mode)
+ (buffer-major-mode latex-mode)
+ (buffer-major-mode texinfo-mode)
+ (and (application "xemacs")
+ (name "\\.texi?"))))
("Administrativa" (:key [(hyper ?a)] :color "lightblue" :cost 150)
(or (application "ethereal")
(and (application "xterm")
(name "\\(tcpdump\\|ssh\\)"))))
("Windows remote" (:color "lightcyan")
(application "rdesktop"))
+ ("Minibuffer Usage" (:color "tan")
+ (function xwem-minibuffer-client-p))
+ ;; Without matchers (can be triggered only with key)
("Smoke" (:key [(hyper ?s)] :color "red3" :cost -50))
("Nothing" (:key [(hyper ?n)] :color "gray80" :cost 50))
-
+ ("WorkProject" (:key [(hyper ?c)] :color "green2" :cost 200))
+ ("C for fun" (:key [(hyper ?f)] :color "tomato" :cost 0))
+
("Unknown" (:color "gray50" :cost 0)
(eval t)))
"List of task descriptions in `xwem-manage-list' format.
@@ -1541,7 +1556,7 @@
;; Initialize wd in sys tray
(xwem-XTrayInit (xwem-dpy) (xwem-worklog-dockapp-win wd)
- dockid dockgroup dockalign)
+ dockid (or dockgroup "desktop") dockalign)
;; Start updater
(setf (xwem-worklog-dockapp-update-itimer wd)
|