1. xemacs
  2. xwem


xwem / lisp / xwem-minibuffer.el

;;; xwem-minibuffer.el --- XWEM minibuffer support.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Thu Dec  4 15:13:12 MSK 2003
;; Keywords: xwem, xlib
;; 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
;; 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:
(defstruct xwem-minib
  frame					; Emacs frame
  (evmask 0.0)				; events to select

  plist					; User defined plist

(defmacro xwem-minib-xgeom (minb)
  "Get MINB xgeom."
  `(xwem-cl-xgeom (xwem-minib-cl ,minb)))

(defmacro xwem-minib-xwin (minb)
  "Get MINB xwin."
  `(xwem-cl-xwin (xwem-minib-cl ,minb)))

(defsetf xwem-minib-xgeom (minb) (xgeom)
  `(setf (xwem-cl-xgeom (xwem-minib-cl ,minb)) ,xgeom))

(defsetf xwem-minib-xwin (minb) (xwin)
  `(setf (xwem-cl-xwin (xwem-minib-cl ,minb)) ,xwin))

;; Customization
(defgroup xwem-minibuffer nil
  "Group to customize XWEM minibuffer."
  :prefix "xwem-minibuffer-"
  :group 'xwem)

(defcustom xwem-minibuffer-name "xwem-minibuffer"
  "*Minibuffer name to be used by XWEM."
  :type 'string
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-bgcol "gray80"
  "*Background color to be used in `xwem-minib-frame'."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-font nil
  "*Font to be used in `xwem-minib-frame'.  May be nil or string."
  :type '(restricted-sexp :match-alternatives ('nil try-font-name))
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-height 1
  "Height of `xwem-minibuffer'."
  :type 'number
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-width 80
  "*Usable width of `xwem-minibuffer' frame."
  :type 'number
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-border-width 3
  "Border width for `xwem-minibuffer'."
  :type 'number
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-passive-border-color "blue3"
  "Border color for `xwem-minibuffer'."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-active-border-color "blue"
  "Border color for `xwem-minibuffer' when it focused."
  :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p))
  :group 'xwem-minibuffer)

(defcustom xwem-minibuffer-hide-cursor-mode t
  "*Non-nil value mean that cursor will be hided, when xwem-minibuffer
loses focus, and unhides when it focused."
  :type 'boolean
  :group 'xwem-minibuffer)

;; Variables
(defvar xwem-minibuffer nil
  "Internal variable, holds `xwem-minibuffer' structure.")

(defvar xwem-minib-after-creat-hooks nil
  "Hooks to be called after xwem minibuffer created.")

(defun xwem-minib-create ()
  "Create minibuffer that will be used by xwem, or use existen."
  (let ((mframe (xwem-misc-find-frame xwem-minibuffer-name)))

    (when (null mframe)
      ;; not yet created
      (xwem-message 'info "here creating minibuffer. frames=%S" (frame-list))
      (setq mframe (make-frame minibuffer-frame-plist)))

    (setq default-minibuffer-frame mframe)
    (setf (xwem-minib-frame xwem-minibuffer) mframe)

    ;; XXX - maybe move it to `xwem-minib-after-creat-hooks'?
    (when xwem-minibuffer-font
      (set-face-property 'default 'font xwem-minibuffer-font (xwem-minib-frame xwem-minibuffer)))
    (when xwem-minibuffer-bgcol
      (set-face-property 'default 'background xwem-minibuffer-bgcol
			 (xwem-minib-frame xwem-minibuffer)))

    ;; TODO: run after create hooks

;; Manda functions
(defun xwem-minib-refit (cl &rest args)
  "Refit xwem minibuffer.
CL is non-nil when `xwem-minib-refit' is called internally by xwem-minb-manage.
ARGS is additional arguments."
  ;; Adjust geometry a little
  (xwem-cl-correct-size-for-size cl (xwem-cl-xgeom cl) 'left 'bottom)

  (let ((mgeom (xwem-minib-xgeom xwem-minibuffer)))
    (XMoveResizeWindow (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
		       (X-Geom-x mgeom) (X-Geom-y mgeom) (X-Geom-width mgeom) (X-Geom-height mgeom)))

(defun xwem-minib-manage (cl)
  "Manage XWEM's minibuffer client CL."
  (setf (xwem-minib-cl xwem-minibuffer) cl)
  (setf (xwem-cl-xgeom cl)
	(make-X-Geom :x 0 :y (- (X-Geom-height (xwem-rootgeom))
				(X-Geom-height (xwem-cl-xgeom cl)))
		     :width (X-Geom-width (xwem-rootgeom))
		     :height (X-Geom-height (xwem-cl-xgeom cl))
		     :border-width 0))

  ;; Install event handler for xwem minibuffer window.
  (setf (xwem-minib-evmask xwem-minibuffer)
	(Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-FocusChange))
  (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) (xwem-minib-evmask xwem-minibuffer))
  (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer) 'xwem-minib-events-handler)

  ;; Install grabs
  (xwem-kbd-install-grab xwem-global-map (xwem-minib-xwin xwem-minibuffer))

  (xwem-minib-refit cl))
(defun xwem-minib-demanage (cl &rest args)
  "Demage xwem minibuffer client CL.
ARGS is additional arguments."
  ;; Is this really needed?

(defun xwem-minib-iconify (cl &rest args)
  "Iconify xwem minibuffer client CL.
ARGS is additional arguments."
  ;; Is this really needed?

;; Events handler
(defun xwem-minib-events-handler (xdpy xwin xev)
  "Events handler for minibuffer window.
XDPY - X-Dpy .
XWIN - X-Win for which event is generated.
XEV  - X-Event to handle."
  (X-Dpy-log (X-Event-dpy xev) "MINIBUFFER: %S event win = %S\n"
	     '(X-Event-name xev) '(X-Win-id (X-Event-win xev)))

  (X-Event-CASE xev
     (when (and (not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinear))
		(not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinearVirtual)))
       ;; XWEM Minibuffer activates
       (set-frame-property (xwem-minib-frame xwem-minibuffer)
			   'border-color xwem-minibuffer-active-border-color)
       (when xwem-minibuffer-hide-cursor-mode
	 (set-frame-property (xwem-minib-frame xwem-minibuffer) 'text-cursor-visible-p t))

     (when (and (not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinear))
		(not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinearVirtual)))
       ;; XWEM Minibuffer deactivates
       (set-frame-property (xwem-minib-frame xwem-minibuffer)
			   'border-color xwem-minibuffer-passive-border-color)
       (when xwem-minibuffer-hide-cursor-mode
	 (set-frame-property (xwem-minib-frame xwem-minibuffer) 'text-cursor-visible-p nil))

    ;; TODO: add more?
    (t nil)))

(defvar xwem-saved-menubar-visible-p nil
  "Saved value of `menubar-visible-p' specifier.")

(defun xwem-minibuffer-init ()
  "Initialize xwem minibuffer."
  (xwem-message 'msg "Initializing minibuffer ... wait")

  ;; Xt will wait ConfigureNotify event unless we specify to not do
  ;; so. We can't send it because process already blocked.
;  (modify-frame-parameters nil '((wait-for-wm . nil)))

  (setq minibuffer-frame-plist
	(list 'menubar-visible-p nil
	      'default-toolbar-visible-p nil
	      'name xwem-minibuffer-name
	      'height xwem-minibuffer-height
	      'border-width xwem-minibuffer-border-width
	      'border-color xwem-minibuffer-passive-border-color
	      'width xwem-minibuffer-width
	      'wait-for-wm nil

  (setq default-frame-plist
	(plist-put default-frame-plist 'minibuffer nil))
  (setq default-frame-plist
	(plist-put default-frame-plist 'wait-for-wm nil))
  (setq initial-frame-plist
	(plist-put initial-frame-plist 'minibuffer nil))
  (setq initial-frame-plist
	(plist-put initial-frame-plist 'wait-for-wm nil))

  ;; Some strange things happens with XEmacs, it skips
  ;; `menubar-visible-p' property, so there is hack to set
  ;; `menubar-visible-p' specifier temporary to nil and after XWEM
  ;; minibuffer creating revert it back.
  (setq xwem-saved-menubar-visible-p (specifier-instance menubar-visible-p))
  (set-specifier menubar-visible-p nil)

  (setq xwem-minibuffer (make-xwem-minib))

(provide 'xwem-minibuffer)

;;; xwem-minibuffer.el ends here