Location: lg@xxxxxxxxxxxxxx http://arch.xwem.org/2005/
Revision: xwem--main--2.1--patch-25
Archive: lg@xxxxxxxxxxxxxx
Creator: Zajcev Evgeny <lg@xxxxxxxx>
Date: Tue Feb 22 02:26:59 MSK 2005
Standard-date: 2005-02-21 23:26:59 GMT
Modified-files: lisp/xwem-clients.el
lisp/xwem-minibuffer.el
New-patches: lg@xxxxxxxxxxxxxx/xwem--main--2.1--patch-25
Summary: initial support for aspect ratio and modeline
Keywords: modeline, gutter, aspect ratio
* lisp/xwem-clients.el (xwem-cl-correct-size-for-size): [addon] Check
aspect ration. (only min aspect ratio examination is implemented atm)
* lisp/xwem-minibuffer.el (xwem-minib-specifiers): [addon] top-gutter nil
* lisp/xwem-minibuffer.el (xwem-minibuffer-border-width): [change]
Default value is 2 now.
* lisp/xwem-minibuffer.el (xwem-modeline-format): [new] Client local
variable for modeline format.
* lisp/xwem-minibuffer.el (xwem-modeline-regenerate): [new] Generate
modeline string.
* lisp/xwem-minibuffer.el (xwem-modeline-redraw): [new] Redisplay xwem
modeline.
* lisp/xwem-minibuffer.el (xwem-modeline-enable): [new]
* lisp/xwem-minibuffer.el (xwem-modeline-disable): [new]
* added files
{arch}/xwem/xwem--main/xwem--main--2.1/lg@xxxxxxxxxxxxxx/patch-log/patch-25
* modified files
--- orig/lisp/xwem-clients.el
+++ mod/lisp/xwem-clients.el
@@ -130,12 +130,12 @@
:group 'xwem-cl)
(defcustom xwem-cl-other-include-active t
- "*Non-nil mean include active clients in clients list when switching.
+ "*Non-nil mean include active clients in clients list when switching.
If `xwem-clswi-include-active' is function, it must be a function that
accepts one argument - CL and returns non-nil if CL must be included."
:type '(choice (const :tag "No" nil)
- (const :tag "Yes" t)
- (function :tag "Custom function"))
+ (const :tag "Yes" t)
+ (function :tag "Custom function"))
:group 'xwem-cl)
(defcustom xwem-cl-other-include-iconified nil
@@ -143,8 +143,8 @@
If `xwem-clswi-include-iconified' is function, it must be a function that
accepts one argument - CL and returns non-nil if CL must be included."
:type '(choice (const :tag "No" nil)
- (const :tag "Yes" t)
- (function :tag "Custom function"))
+ (const :tag "Yes" t)
+ (function :tag "Custom function"))
:group 'xwem-cl)
(defcustom xwem-client-strict-activation nil
@@ -230,12 +230,6 @@
:group 'xwem-hooks)
;;;###autoload
-(defcustom xwem-cl-manage-hook nil
- "*Hooks to be called with just managed CL as argument."
- :type 'hook
- :group 'xwem-hooks)
-
-;;;###autoload
(defcustom xwem-cl-activate-hook nil
"*Hooks to call when client activates.
Called with two arguments:
@@ -480,7 +474,7 @@
(defun xwem-client-set-x-border-width (cl bprop width)
"Change CL's border with to WIDTH.
Default WIDTH is 0."
- (xwem-cl-put-prop cl bprop width) ; save it in props
+ (xwem-cl-put-prop cl bprop width) ; save it in props
(unless (numberp width)
(setq width 0)) ; XXX
@@ -490,7 +484,7 @@
(defun xwem-client-set-x-border-color (cl bprop col)
"Change CL's border color to COL."
- (xwem-cl-put-prop cl bprop col) ; save it in props
+ (xwem-cl-put-prop cl bprop col) ; save it in props
(unless col
(setq col "black")) ; XXX
@@ -738,18 +732,18 @@
(when (and (xwem-cl-p (car clients)) ; skip non-clients
(not (eq (car clients) cl)) ; skip ourself
;; skip iconified
- (or also-iconified
- (not (eq (xwem-cl-state (car clients)) 'iconified))
- (if (functionp xwem-cl-other-include-iconified)
- (funcall xwem-cl-other-include-iconified
- (car clients))
- xwem-cl-other-include-iconified)))
+ (or also-iconified
+ (not (eq (xwem-cl-state (car clients)) 'iconified))
+ (if (functionp xwem-cl-other-include-iconified)
+ (funcall xwem-cl-other-include-iconified
+ (car clients))
+ xwem-cl-other-include-iconified)))
(if (or also-active
(not (eq (xwem-cl-state (car clients)) 'active))
- (if (functionp xwem-cl-other-include-active)
- (funcall xwem-cl-other-include-active
- (car clients))
- xwem-cl-other-include-active))
+ (if (functionp xwem-cl-other-include-active)
+ (funcall xwem-cl-other-include-active
+ (car clients))
+ xwem-cl-other-include-active))
;; Found pretty good candidate
(setq rcl (car clients)
clients nil)
@@ -795,9 +789,8 @@
(he (X-Geom-height new-geom))
(wi (X-Geom-width new-geom))
(clgmt (xwem-cl-xgeom cl))
- (wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl)))
- (wi-rmd 0)
- (he-rmd 0)
+ (wmnh (xwem-cl-wm-normal-hints cl))
+ (wi-rmd 0) (he-rmd 0)
bw bh wi-st he-st)
(when wmnh
@@ -818,7 +811,27 @@
(when he-st
(setq he-rmd (% (abs (- he bh (* 2 hthi))) he-st))
(when (> bh he)
- (setq he-rmd (- he-st he-rmd)))))
+ (setq he-rmd (- he-st he-rmd))))
+
+ ;; Check aspect ratio
+ (when (X-WMSize-paspect-p wmnh)
+ (let ((mia-x (X-WMSize-min-aspect-x wmnh))
+ (mia-y (X-WMSize-min-aspect-y wmnh))
+ (maa-x (X-WMSize-max-aspect-x wmnh))
+ (maa-y (X-WMSize-max-aspect-y wmnh))
+ (ai 0)
+ tmp-nw tmp-nh nw nh)
+
+ ;; Find appropriate aspect index AI
+ (while (and (incf ai)
+ (< (setq tmp-nw (* mia-x ai)) (- wi bw))
+ (< (setq tmp-nh (* mia-y ai)) (- he bh)))
+ (setq nw tmp-nw nh tmp-nh))
+
+ (when (and nw nh)
+ (setq wi-rmd (- wi nw)
+ he-rmd (- he nh)))))
+ )
(unless (X-Geom-p clgmt)
(setf (xwem-cl-xgeom cl) (make-X-Geom))
@@ -887,12 +900,12 @@
(xwem-interactive "p")
(let* ((cl (xwem-cl-selected))
- (ocl (xwem-method-other-client cl)))
+ (ocl (xwem-method-other-client cl)))
(while (> arg 0)
(setq cl (xwem-cl-other
- cl :clients (xwem-clients-list
- `(lambda (cl)
- (not (eq cl ,ocl))))))
+ cl :clients (xwem-clients-list
+ `(lambda (cl)
+ (not (eq cl ,ocl))))))
(decf arg))
(unless (xwem-cl-p cl)
(setq cl ocl))
@@ -1054,23 +1067,23 @@
(defun xwem-client-sendmsg-atom (cl atom &optional time)
"Send Client message to client CL."
(XSendEvent (xwem-dpy) (xwem-cl-xwin cl) nil 0
- (X-Create-message
- (list [1 X-ClientMessage] ; type
- [1 X-format-32] ; format
- [2 1000] ; XXX seq
- [4 (X-Win-id (xwem-cl-xwin cl))] ; window
- [4 (X-Atom-id (X-Atom-find-by-name (xwem-dpy) "WM_PROTOCOLS"))]
- [4 (X-Atom-id atom)]
- [4 (or time X-CurrentTime)]
- [4 nil]))))
+ (X-Create-message
+ (list [1 X-ClientMessage] ; type
+ [1 X-format-32] ; format
+ [2 1000] ; XXX seq
+ [4 (X-Win-id (xwem-cl-xwin cl))] ; window
+ [4 (X-Atom-id (X-Atom-find-by-name (xwem-dpy)
"WM_PROTOCOLS"))]
+ [4 (X-Atom-id atom)]
+ [4 (or time X-CurrentTime)]
+ [4 nil]))))
(defun xwem-client-delete-window (cl)
"Close xwem client CL in safe manner.
Return non-nil, if CL supports WM_DELETE_WINDOW."
(when (XWMProtocol-set-p (xwem-dpy)
- (xwem-hints-wm-protocols (xwem-cl-hints cl)) "WM_DELETE_WINDOW")
+ (xwem-hints-wm-protocols (xwem-cl-hints cl))
"WM_DELETE_WINDOW")
(xwem-client-sendmsg-atom cl
- (X-Atom-find-by-name (xwem-dpy) "WM_DELETE_WINDOW"))
+ (X-Atom-find-by-name (xwem-dpy)
"WM_DELETE_WINDOW"))
t))
(define-xwem-deffered xwem-client-apply-state (cl)
@@ -1158,11 +1171,11 @@
PROPS - Properties list for new client.
XWEM-WIN - xwem window where new client should be managed(if possible)."
(let ((new-cl (make-xwem-cl
- :xwin xwin
- :ev-mask (Xmask-or xwem-client-ev-mask
- (if (xwem-frame-p (xwem-xwin-frame xwin))
- xwem-frame-ev-mask
- 0)))))
+ :xwin xwin
+ :ev-mask (Xmask-or xwem-client-ev-mask
+ (if (xwem-frame-p (xwem-xwin-frame xwin))
+ xwem-frame-ev-mask
+ 0)))))
(when (xwem-misc-xwin-valid-p xwin) ; just to check that XWIN still alive
(xwem-debug 'xwem-cl "New Client making name=%s, class=%S"
'(XGetWMName (xwem-dpy) xwin) '(XGetWMClass (xwem-dpy) xwin))
@@ -1526,8 +1539,8 @@
"Return base width and height for CL."
(let ((wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl))))
(cond ((and wmnh (X-WMSize-pbasesize-p wmnh))
- (cons (X-WMSize-base-width wmnh) ;base width
- (X-WMSize-base-height wmnh))) ;base height
+ (cons (X-WMSize-base-width wmnh) ;base width
+ (X-WMSize-base-height wmnh))) ;base height
((and wmnh (X-WMSize-pminsize-p wmnh))
(cons (X-WMSize-min-width wmnh)
(X-WMSize-min-height wmnh))))))
@@ -2290,7 +2303,8 @@
(xwem-win-width win)))
(not (= (X-Geom-height-with-borders clg)
(xwem-win-height win))))
- (xwem-cl-correct-size-for-size cl
+ (xwem-cl-correct-size-for-size
+ cl
(make-X-Geom :x (xwem-win-x win)
:y (xwem-win-y win)
:width (xwem-win-width win)
@@ -2396,7 +2410,7 @@
"Set CLIENT local VARIABLE to VALUE."
(setf (xwem-cl-local-variables client)
(put-alist variable value (xwem-cl-local-variables client)))
- (when (xwem-cl-selected)
+ (when (xwem-cl-selected-p client)
(set variable value)))
;;;###xwem-autoload
--- orig/lisp/xwem-minibuffer.el
+++ mod/lisp/xwem-minibuffer.el
@@ -39,7 +39,7 @@
(require 'xwem-manage)
(eval-when-compile
- (defvar x-emacs-application-class nil))
+ (defvar x-emacs-application-class nil))
;; Customization
(defgroup xwem-minibuffer nil
@@ -56,16 +56,16 @@
"*Background color to be used in `xwem-minib-frame'."
:type 'color
:set (lambda (sym val)
- (set sym val)
- (when (and xwem-minibuffer
- (X-Win-p (xwem-minib-xwin xwem-minibuffer)))
- (XSetWindowBackground
- (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
- (XAllocColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
- (xwem-make-color xwem-minibuffer-bgcol)))
- (XClearArea (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) 0 0
- (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))
- (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)) nil)))
+ (set sym val)
+ (when (and xwem-minibuffer
+ (X-Win-p (xwem-minib-xwin xwem-minibuffer)))
+ (XSetWindowBackground
+ (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
+ (XAllocColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
+ (xwem-make-color xwem-minibuffer-bgcol)))
+ (XClearArea (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) 0 0
+ (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))
+ (X-Geom-height (xwem-minib-xgeom xwem-minibuffer))
nil)))
:initialize 'custom-initialize-default
:group 'xwem-minibuffer)
@@ -73,11 +73,11 @@
"*Font to be used in `xwem-minib-frame'. May be nil or string."
:type '(restricted-sexp :match-alternatives ('nil try-font-name))
:set (lambda (sym val)
- (set sym val)
- (when (and xwem-minibuffer
- (xwem-minib-frame xwem-minibuffer))
- (set-face-font 'default xwem-minibuffer-font
- (xwem-minib-frame xwem-minibuffer))))
+ (set sym val)
+ (when (and xwem-minibuffer
+ (xwem-minib-frame xwem-minibuffer))
+ (set-face-font 'default xwem-minibuffer-font
+ (xwem-minib-frame xwem-minibuffer))))
:initialize 'custom-initialize-default
:group 'xwem-minibuffer)
@@ -112,7 +112,7 @@
:group 'xwem-minibuffer)
;;;###xwem-autoload
-(defcustom xwem-minibuffer-border-width 3
+(defcustom xwem-minibuffer-border-width 2
"Border width for `xwem-minibuffer'."
:type 'number
:set (lambda (sym val)
@@ -235,6 +235,7 @@
(defcustom xwem-minib-specifiers
'((default-toolbar-visible-p . nil)
+ (top-gutter . nil)
(menubar-visible-p . nil)
(horizontal-scrollbar-visible-p . nil)
((face-font 'default) . xwem-minibuffer-font))
@@ -275,16 +276,16 @@
(minibuffer-frame-list))
(make-frame minibuffer-frame-plist
(default-x-device))))
- (dd default-directory))
+ (dd default-directory))
(setf (xwem-minib-frame xwem-minibuffer) mframe)
;; Set specifiers values for MFRAME
(xwem-minib-apply-specifiers mframe)
- (redraw-frame mframe t) ; KEEP THIS!
+ (redraw-frame mframe t) ; KEEP THIS!
;; Hack over default-directory for minibuffer buffer
(with-current-buffer
- (window-buffer (frame-root-window mframe))
+ (window-buffer (frame-root-window mframe))
(setq default-directory dd))
mframe))
@@ -360,7 +361,8 @@
(xwem-client-set-property cl 'x-border-width xwem-minibuffer-border-width)
(xwem-client-set-property cl 'x-border-color
(xwem-face-foreground 'x-border-face
- (and (xwem-cl-selected-p cl) '(selected)) cl))
+ (and (xwem-cl-selected-p
cl)
+ '(selected)) cl))
;; Reparent xwem minib client to parent
;; XXX XXX
@@ -409,8 +411,8 @@
(xwem-debug 'xwem-minib "Refiting ..")
(let ((cl-xgeom (xwem-cl-xgeom cl))
- (cl-nx (and (xwem-cl-new-xgeom cl)
- (X-Geom-x (xwem-cl-new-xgeom cl))))
+ (cl-nx (and (xwem-cl-new-xgeom cl)
+ (X-Geom-x (xwem-cl-new-xgeom cl))))
(pxgeom (xwem-minib-xgeom (xwem-cl-minibuffer cl))))
;; Adjust geometry a little to fill into xwem-minib-xwin and apply
;; changes to life
@@ -419,17 +421,17 @@
;; CL has new x location - handle it
(setf (X-Geom-x pxgeom) (X-Geom-x cl-xgeom))
(setf (X-Geom-width pxgeom)
- (- (X-Geom-width (xwem-rootgeom))
- (X-Geom-x pxgeom)
- xwem-minibuffer-outer-border-width
- xwem-minibuffer-outer-border-width))
+ (- (X-Geom-width (xwem-rootgeom))
+ (X-Geom-x pxgeom)
+ xwem-minibuffer-outer-border-width
+ xwem-minibuffer-outer-border-width))
(xwem-minib-apply-pxgeom (xwem-cl-minibuffer cl)))
(xwem-cl-correct-size-for-size
cl
(make-X-Geom :x 0 :y 0
- :width (X-Geom-width-with-borders cl-xgeom)
- :height (X-Geom-height-with-borders cl-xgeom)
- :border-width (X-Geom-border-width cl-xgeom))
+ :width (X-Geom-width-with-borders cl-xgeom)
+ :height (X-Geom-height-with-borders cl-xgeom)
+ :border-width (X-Geom-border-width cl-xgeom))
'left 'top)
(xwem-cl-apply-xgeom cl)
@@ -656,6 +658,69 @@
(add-hook 'minibuffer-setup-hook 'xwem-minib-rsz-setup)
(remove-hook 'minibuffer-setup-hook 'xwem-minib-rsz-setup)))
+;;; xwem minibuffer modeline using top gutter
+(defvar xwem-modeline-format
+ '(("--" red)
+ ((symbol-name (xwem-cl-manage-type cl)) blue)
+ (": " blue)
+ ("[")
+ ((or (car (xwem-client-application cl))
+ "unknown"))
+ ("] ")
+ ((xwem-client-name cl) blue)
+ (" ")
+ ;; Minor modes
+ ("(")
+ ((mapconcat (lambda (mm)
+ (when (symbol-value (car mm))
+ (cadr mm)))
+ xwem-minor-mode-alist ""))
+ (")")
+ ("--" red))
+ "Modeline format.")
+(xwem-make-variable-client-local 'xwem-modeline-format)
+
+(defun xwem-modeline-regenerate ()
+ "Regenerate modeline string."
+ (mapconcat (lambda (me)
+ (let ((cl (xwem-cl-selected)))
+ (condition-case nil
+ (xwem-str-with-faces
+ (eval (car me))
+ (append '(buffers-tab) (cdr me)))
+ (t "<error>"))))
+ xwem-modeline-format ""))
+
+(define-xwem-deffered xwem-modeline-redraw (&optional cl)
+ "Redraw xwem modeline."
+ (if (and (xwem-cl-alive-p cl) (xwem-cl-selected-p cl))
+ (xwem-modeline-redraw)
+
+ (let* ((str (xwem-modeline-regenerate))
+ (mw (frame-width (xwem-minib-frame xwem-minibuffer))))
+ (set-specifier top-gutter str
+ (xwem-minib-frame xwem-minibuffer))
+ )))
+
+;;;###autoload(autoload 'xwem-modeline-enable "xwem-minibuffer" nil t)
+(define-xwem-command xwem-modeline-enable (arg)
+ "Enable modeline."
+ (xwem-interactive "P")
+
+ (add-hook 'xwem-cl-change-hook 'xwem-modeline-redraw)
+ (add-hook 'xwem-client-select-hook 'xwem-modeline-redraw)
+ (xwem-modeline-redraw))
+
+;;;###autoload(autoload 'xwem-modeline-disable "xwem-minibuffer" nil t)
+(define-xwem-command xwem-modeline-disable (arg)
+ "Disable modeline."
+ (xwem-interactive "P")
+
+ (remove-hook 'xwem-cl-change-hook 'xwem-modeline-redraw)
+ (remove-hook 'xwem-client-select-hook 'xwem-modeline-redraw)
+
+ (set-specifier top-gutter nil (xwem-minib-frame xwem-minibuffer)))
+
(provide 'xwem-minibuffer)
@@ -663,15 +728,15 @@
;; Define application
(add-to-list 'xwem-applications-alist
`("xemacs-xwem-minibuffer"
- (and (class-name ,(concat "^" x-emacs-application-class
"$"))
- (class-inst ,(concat "^" xwem-minibuffer-name "$")))))
+ (and (class-name ,(concat "^" x-emacs-application-class "$"))
+ (class-inst ,(concat "^" xwem-minibuffer-name "$")))))
;; Add manage type
(define-xwem-manage-model minibuffer
"Managing model for xwem minibuffer."
:cl-properties '(dummy-client-p t
- skip-deselect t
- override-skip-deselect t)
+ skip-deselect t
+ override-skip-deselect t)
:match-spec '(application "xemacs-xwem-minibuffer")
:manage-method 'xwem-manage-minibuffer
|