Skip to content
Snippets Groups Projects
xwem-manage.el 5.94 KiB
Newer Older
viteno's avatar
viteno committed
;;; xwem-manage.el --- Manage stuff for xwem.

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: 21 Mar 2003
;; Keywords: xlib, xwem
;; X-CVS: $Id$

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;;

;;; Code


;; Variables
(defvar xwem-manda-list nil
  "Manage database list, all manage instances should be there.")

;;;###autoload
(defstruct xwem-manda
  name                                  ; manda name
  matcher-function
  priority
  
  exclude-p                             ; non-nil if such clients
					; should be excluded from
					; clients list

  init-fun
  manage-fun
  demanage-fun
  iconify-fun
  refit-fun
  )


;;; Functions
;;;###autoload
(defun xwem-manda-fun-run (manel fun &rest args)
  "Run function FUN for MANEL.
FUN is one of 'init, 'manage, 'demanage or 'refit
NOTE: A little bit hackish, do not do so at home." 
  (let* ((ifun (intern (format "xwem-manda-%s-fun" fun)))
	 (val (funcall ifun manel)))

    (when val
      (apply val args))))

;;;###autoload
(defun xwem-manda-find-inst (cl)
  "Find instance for CL in manage database.
NOTE: Find first match."
  (let ((manls xwem-manda-list))
    (while (and manls (not (funcall (xwem-manda-matcher-function (car manls)) cl)))
      (setq manls (cdr manls)))

    (car manls)))

(defun define-xwem-manda (name matcher-function &optional priority exclude-p 
                               init-fun manage-fun demanage-fun iconify-fun refit-fun)
  "Define new entry in manage database."
  
  (let ((man (make-xwem-manda :name name
                              :priority priority
                              :exclude-p exclude-p
                              :matcher-function matcher-function
                              :init-fun init-fun
                              :manage-fun manage-fun
                              :demanage-fun demanage-fun
                              :iconify-fun iconify-fun
                              :refit-fun refit-fun)))
    (setq xwem-manda-list (cons man xwem-manda-list))

    ;; Resort by priority
    (setq xwem-manda-list (sort xwem-manda-list
                                (lambda (el1 el2)
                                  (> (xwem-manda-priority el1)
                                     (xwem-manda-priority el2)))))
    man))

;;;###autoload
(defun xwem-manda-init ()
  "Initialize manage database."
  (setq xwem-manda-list nil)

  ;; Generic manda entry
  (define-xwem-manda 'generic (lambda (cl) t)
    -100 nil
    'xwem-init-clients 'xwem-cl-manage 'xwem-cl-demanage
    'xwem-cl-iconify 'xwem-cl-refit)

  ;; Manda entry to handle xwem minibuffer
  (define-xwem-manda 'xwem-minibuffer
    (lambda (cl)
      (let ((class (xwem-hints-wm-class (xwem-cl-hints cl))))
        (and (nth 0 class) (string= (nth 0 class) xwem-minibuffer-name))))
    0 t
    'xwem-minibuffer-init 'xwem-minib-manage nil nil 'xwem-minib-refit)

  ;; Manda entry to manage special Emacs frames
  (define-xwem-manda 'xwem-special
    (lambda (cl)
      (let ((class (xwem-hints-wm-class (xwem-cl-hints cl))))
        (and (nth 0 class) (string= (nth 0 class) xwem-special-frame-name))))
    0 t
    'xwem-special-frame-init 'xwem-special-frame-manage
    'xwem-special-frame-demanage 'xwem-special-frame-iconify)

  ;; Manda entry to manage transient-for(dialogs) windows
  (define-xwem-manda 'transient-for
    (lambda (cl)
      (xwem-hints-wm-transient-for (xwem-cl-hints cl)))
    0 t
    nil 'xwem-trans-for-manage 'xwem-trans-for-demanage
    'xwem-trans-for-demanage)

  ;; run init functions
  (mapc (lambda (manel)
	  (xwem-manda-fun-run manel 'init))
	xwem-manda-list))


;; Transient for clients handling
(defcustom xwem-cl-transient-border-color "blue4"
  "Border color for transient for windows."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-cl)

(defcustom xwem-cl-transient-border-width 2
  "Border width in pixels of transient for windows."
  :type 'number
  :group 'xwem-cl)

(defun xwem-trans-for-manage (cl &rest others)
  "Manage CL that have transient-for flag."
  ;; Map window for witch CL is transient and just map and raise CL
  ;; over it
  (let* ((xwin (xwem-cl-xwin cl))
	 (tfwin (xwem-cl-transient-for cl))
	 (trc (xwem-find-client tfwin)))

    (XChangeWindowAttributes (xwem-dpy) xwin
			     (make-X-Attr :border-pixel (XAllocNamedColor
							 (xwem-dpy) (XDefaultColormap (xwem-dpy))
							 xwem-cl-transient-border-color
							 (make-X-Color :dpy (xwem-dpy)))
					  ))
    (XSetWindowBorderWidth (xwem-dpy) xwin xwem-cl-transient-border-width)

    (XMapWindow (xwem-dpy) (xwem-cl-xwin cl))
    (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl))
    (XSelectInput (xwem-dpy) (xwem-cl-xwin cl) (Xmask-or XM-StructureNotify))

    (when (xwem-cl-p trc)
      (setf (xwem-cl-translist trc) (cons cl (xwem-cl-translist trc))))

    (xwem-focus-set cl)
    ))

(defun xwem-trans-for-demanage (cl &rest others)
  "Demanage CL that have transient-for flag."
  (let* ((tfwin (xwem-cl-transient-for cl))
	 (trc (xwem-find-client tfwin)))

    (when (xwem-cl-p trc)
      (xwem-message 'info "here i trc=%d" (X-Win-id (xwem-cl-xwin trc)))

      (setf (xwem-cl-translist trc) (delete cl (xwem-cl-translist trc))))
    
    (xwem-focus-pop-set)))

  
(provide 'xwem-manage)

;;; xwem-manage.el ends here