;;; xwem-mouse.el --- Mouse support 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: xwem-mouse.el,v 1.4 2004/05/05 22:43:07 lg Exp $

;; 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:
;;
;; XWEM supports mouse as well as keyboard.

;;; Code:

(defcustom xwem-popup-menu-function 'popup-menu
  "*Function used to popup menus.
It is created for case when you change default `popup-menu' function,
for example if you are using tpum.el."
  :type 'function
  :group 'xwem)


(defun xwem-mouse-change-cursor (cursor)
  "XXX.
CURSOR - Dunno."
  (XChangeActivePointerGrab (xwem-dpy) cursor
			    (Xmask-or XM-ButtonPress XM-ButtonRelease)))

;;;###autoload
(defun xwem-mouse-grab (cursor &optional win mask)
  "Begin to grab mouse, showing CURSOR in WIN using event mask MASK.
Default WIN is root window.
Default MASK is capturing ButtonPress or ButtonRelease events."
  ;; TODO: install custom events handlers?
  (XGrabPointer (xwem-dpy)
		(or win (xwem-rootwin))
		(or mask (Xmask-or XM-ButtonPress XM-ButtonRelease))
		cursor)
  )

;;;###autoload
(defun xwem-mouse-ungrab ()
  "Stop grabing mouse."
  (XUngrabPointer (xwem-dpy))
  )

;;; Menus
(defvar xwem-applications-submenu
  '("Applications"
     ["XEmacs" (make-frame)]
     ["xterm" (xwem-execute-program "xterm")]
     ["gv" (xwem-execute-program "gv")]
     ["xfontsel" (xwem-execute-program "xfontsel")]
     )
  "Submenu with applications.")

(defvar xwem-menu
  (list "XWEM Menu"
	xwem-applications-submenu
	'("Windows"
	  ["Vertical Split" (xwem-frame-split-vert nil)]
	  ["Horizontal Split" (xwem-frame-split-horiz nil)]
	  ["Delete Window" (xwem-window-delete)]
	  ["Delete Others" (xwem-window-delete-others)]
	  ["Balance" (xwem-balance-windows (xwem-frame-selected))])
	)
  "Popup menu to be used by xwem."
  )

(defun xwem-menu-generate ()
  "Generate xwem menu on fly."
  (list "XWEM Menu"
        '("xwem-frames" :filter
          (lambda (not-used)
            (mapcar (lambda (el)
                      (let ((fn (xwem-frame-num el)))
                        (vector
                         (concat "Frame " (int-to-string fn) ": " (xwem-frame-name el))
                         `(xwem-frame-switch-nth ,fn))))
                    xwem-frames-list)))

        '("xwem-clients" :filter
          (lambda (not-used)
            (mapcar (lambda (el)
                      (let ((nam (xwem-hints-wm-name (xwem-cl-hints el))))
                        (vector nam `(xwem-cl-pop-to-client ,el)
                                :active (if (xwem-cl-exclude-p el) nil t))))
                    xwem-clients)))
        "--"
	xwem-applications-submenu
        
        ;; XXX - it is just demo of popup menus
        ))

;;;###autoload(autoload 'xwem-popup-clients-menu "xwem-mouse" nil t)
(define-xwem-command xwem-popup-clients-menu ()
  "Popup clients menu."
  (xwem-interactive)

  (let ((menu (list "XWEM Clients" :filter
                    (lambda (not-used)
                      (mapcar (lambda (cl)
                                (let ((frame (xwem-cl-frame cl))
                                      (name (xwem-hints-wm-name (xwem-cl-hints cl))))
                                  (vector (if (xwem-frame-p frame)
                                              (format "[%d](%s): %s" (xwem-frame-num (xwem-cl-frame cl))
                                                      (xwem-frame-name (xwem-cl-frame cl))
                                                      name)
                                            name)
                                          `(xwem-cl-pop-to-client ,cl)
                                          :active (if (xwem-cl-exclude-p cl) nil t))))
                              xwem-clients)))))

    (xwem-popup-menu menu)))

;;;###autoload
(defun xwem-gen-cl-menu (cl &optional maxnlen)
  "Generate menu for CL.
MAXNLEN - maximum menu width in characters."
  (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 nil ,cl))
        (vector "Transpose <==" `(xwem-cl-transpose '(4) ,cl))
        (vector "Mark client" `(if (xwem-cl-marked-p ,cl)
                                   (xwem-client-unset-mark ,cl)
                                 (xwem-client-set-mark nil ,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 nil ,cl))
        (vector "X Hard kill" `(xwem-client-kill '(4) ,cl))
        ))

;;;###autoload
(defun xwem-popup-menu (menu &optional event)
  "Popup MENU.
MENU and EVENT is same as for `popup-menu'."
  (xwem-mouse-ungrab)

  (funcall xwem-popup-menu-function menu event))

;;;###autoload(autoload 'xwem-popup-function-menu "xwem-mouse")
(define-xwem-command xwem-popup-function-menu (arg)
  "Just popup `xwem-menu'.
ARG - Not used yet."
  (xwem-interactive "_P")

  ;; TODO:
  ;;   * use ARG
  (xwem-popup-menu xwem-menu))

;;;###autoload(autoload 'xwem-popup-auto-menu "xwem-mouse")
(define-xwem-command xwem-popup-auto-menu (arg)
  "Popup menu generated by `xwem-menu-generate'.
ARG - Not used yet."
  (xwem-interactive "_P")

  (xwem-popup-menu (xwem-menu-generate)))


(provide 'xwem-mouse)

;;; xwem-mouse.el ends here
