cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-minibuffer.el

   1 ;;; xwem-minibuffer.el --- XWEM minibuffer support.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Thu Dec  4 15:13:12 MSK 2003
   7 ;; Keywords: xwem, xlib
   8 ;; X-CVS: $Id: xwem-minibuffer.el,v 1.12 2005-04-04 19:54:13 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; XWEM minibuffer stuff.  XWEM minibuffer is Emacs frame with
  32 ;; 'minibuffer property set to 'only.  It is used for various thigs,
  33 ;; such as messages displaying, system tray, etc.
  34
  35 ;;; Code:
  36 \f
  37 (require 'xwem-load)
  38 (require 'xwem-focus)
  39 (require 'xwem-manage)
  40
  41 (eval-when-compile
  42   (defvar x-emacs-application-class nil))
  43
  44 ;; Customization
  45 (defgroup xwem-minibuffer nil
  46   "Group to customize XWEM minibuffer."
  47   :prefix "xwem-minibuffer-"
  48   :group 'xwem-modes)
  49
  50 (defcustom xwem-minibuffer-name "xwem-minibuffer"
  51   "*Minibuffer name to be used by XWEM."
  52   :type 'string
  53   :group 'xwem-minibuffer)
  54
  55 (defcustom xwem-minibuffer-bgcol "gray80"
  56   "*Background color to be used in `xwem-minib-frame'."
  57   :type 'color
  58   :set (lambda (sym val)
  59          (set sym val)
  60          (when (and xwem-minibuffer
  61                     (X-Win-p (xwem-minib-xwin xwem-minibuffer)))
  62            (XSetWindowBackground
  63             (xwem-dpy) (xwem-minib-xwin xwem-minibuffer)
  64             (XAllocColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
  65                          (xwem-make-color xwem-minibuffer-bgcol)))
  66            (XClearArea (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) 0 0
  67                        (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))
  68                        (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)) nil)))
  69   :initialize 'custom-initialize-default
  70   :group 'xwem-minibuffer)
  71
  72 (defcustom xwem-minibuffer-font (face-font-name 'default)
  73   "*Font to be used in `xwem-minib-frame'.  May be nil or string."
  74   :type '(restricted-sexp :match-alternatives ('nil try-font-name))
  75   :set (lambda (sym val)
  76          (set sym val)
  77          (when (and xwem-minibuffer
  78                     (xwem-minib-frame xwem-minibuffer))
  79            (set-face-font 'default xwem-minibuffer-font
  80                           (xwem-minib-frame xwem-minibuffer))))
  81   :initialize 'custom-initialize-default
  82   :group 'xwem-minibuffer)
  83
  84 (defcustom xwem-minibuffer-height 1
  85   "Height of `xwem-minibuffer'."
  86   :type 'number
  87   :set (lambda (sym val)
  88          (set sym val)
  89          ;; DO NOT RELY on `set-frame-height'
  90          (let ((frame (and xwem-minibuffer (xwem-minib-frame xwem-minibuffer)))
  91                (mcl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer))))
  92            (when (and frame mcl)
  93              (setq st (/ (frame-pixel-height frame) (frame-height frame))
  94                    nsz (* st xwem-minibuffer-height))
  95              (xwem-client-resize mcl nil nsz))))
  96   :initialize 'custom-initialize-default
  97   :group 'xwem-minibuffer)
  98
  99 (defcustom xwem-minibuffer-width 80
 100   "*Usable width of `xwem-minibuffer' frame."
 101   :type 'number
 102   :set (lambda (sym val)
 103          (set sym val)
 104          ;; DO NOT RELY on `set-frame-width'
 105          (let ((frame (and xwem-minibuffer (xwem-minib-frame xwem-minibuffer)))
 106                (mcl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer))))
 107            (when (and frame mcl)
 108              (setq st (/ (frame-pixel-width frame) (frame-width frame))
 109                    nsz (* st xwem-minibuffer-width))
 110              (xwem-client-resize mcl nsz nil))))
 111   :initialize 'custom-initialize-default
 112   :group 'xwem-minibuffer)
 113
 114 ;;;###xwem-autoload
 115 (defcustom xwem-minibuffer-border-width 2
 116   "Border width for `xwem-minibuffer'."
 117   :type 'number
 118   :set (lambda (sym val)
 119          (set sym val)
 120          (let ((cl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer))))
 121            (when (xwem-cl-p cl)
 122              (xwem-client-set-property
 123               cl 'x-border-width xwem-minibuffer-border-width))))
 124   :initialize 'custom-initialize-default
 125   :group 'xwem-minibuffer)
 126
 127 (defcustom xwem-minibuffer-passive-border-color "blue3"
 128   "Border color for `xwem-minibuffer'."
 129   :type 'color
 130   :set (lambda (sym val)
 131          (set sym val)
 132          (let ((cl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer))))
 133            (when (xwem-cl-p cl)
 134              (xwem-set-face-foreground
 135               'x-border-face xwem-minibuffer-passive-border-color nil cl)
 136              (xwem-client-set-property
 137               cl 'x-border-color
 138               (xwem-face-foreground
 139                'x-border-face (and (xwem-cl-selected-p cl) '(selected)) cl)))))
 140   :initialize 'custom-initialize-default
 141   :group 'xwem-minibuffer)
 142
 143 (defcustom xwem-minibuffer-active-border-color "blue"
 144   "Border color for `xwem-minibuffer' when it focused."
 145   :type 'color
 146   :set (lambda (sym val)
 147          (set sym val)
 148          (let ((cl (and xwem-minibuffer (xwem-minib-cl xwem-minibuffer))))
 149            (when (xwem-cl-p cl)
 150              (xwem-set-face-foreground
 151               'x-border-face xwem-minibuffer-active-border-color
 152               '(selected) cl)
 153              (xwem-client-set-property
 154               cl 'x-border-color
 155               (xwem-face-foreground
 156                'x-border-face (and (xwem-cl-selected-p cl)
 157                                    '(selected)) cl)))))
 158   :initialize 'custom-initialize-default
 159   :group 'xwem-minibuffer)
 160
 161 (defcustom xwem-minibuffer-hide-cursor-mode t
 162   "*Non-nil mean that Emacs cursor will be invisible in `xwem-minibuffer'.
 163 When `xwem-minibuffer' loses focus Emacs cursor hides, and unhides
 164 when it focused."
 165   :type 'boolean
 166   :group 'xwem-minibuffer)
 167
 168 (defcustom xwem-minibuffer-hide-show-parameter 0
 169   "*Animation delay parameter, when hiding/showing xwem minibuffer."
 170   :type 'number
 171   :group 'xwem-minibuffer)
 172
 173 (defcustom xwem-minibuffer-autohide-timeout nil
 174   "*Non-nil mean xwem minibuffer will be autohided, after that many seconds."
 175   :type '(choice (const :tag "Disabled" nil)
 176                  (number :tag "Seconds"))
 177   :set (lambda (sym value)
 178          (set sym value)
 179          (let ((mcl (xwem-minib-cl xwem-minibuffer)))
 180            (when mcl
 181              (if value
 182                  (xwem-minibuffer-enable-autohide-timer mcl)
 183                (xwem-activate mcl)
 184                (xwem-minibuffer-disable-autohide-timer mcl)))))
 185   :initialize 'custom-initialize-default
 186   :group 'xwem-minibuffer)
 187
 188 (defcustom xwem-minibiffer-always-on-top-rank 20
 189   "*Always on top rank or nil."
 190   :type '(choice (const :tag "No rank" nil)
 191                  (number :tag "Rank"))
 192   :set (lambda (sym value)
 193          (set sym value)
 194          (let ((xwin (xwem-minib-xwin xwem-minibiffer)))
 195            (when xwin
 196              (if value
 197                  (xwem-misc-set-xwin-always-on-top xwin value)
 198                (xwem-misc-unset-always-on-top xwin)))))
 199   :initialize 'custom-initialize-default
 200   :group 'xwem-minibuffer)
 201
 202 (defcustom xwem-minibuffer-raise-when-active t
 203   "*Non-nil mean xwem minibuffer is raised when activated."
 204   :type 'boolean
 205   :group 'xwem-minibuffer)
 206
 207 (defcustom xwem-minibuffer-emacs-frames-has-minibuffer t
 208   "*Non-nil mean Emacs frames will have their own minibuffers."
 209   :type 'boolean
 210   :group 'xwem-minibuffer)
 211
 212 (defcustom xwem-minibuffer-set-default-minibuffer-frame t
 213   "*Non-nil mean that xwem minibuffer frame will be set as `default-minibuffer-frame'.
 214 Modify this variable only if you know what you are doing."
 215   :type 'boolean
 216   :group 'xwem-minibuffer)
 217
 218 ;;;###xwem-autoload
 219 (defcustom xwem-minibuffer-outer-border-width 1
 220   "*Outer border width for xwem minibuffer."
 221   :type 'number
 222   :group 'xwem-minibuffer)
 223
 224 (defcustom xwem-minibuffer-outer-border-color "black"
 225   "*Outer border color for xwem minibuffer."
 226   :type 'color
 227   :group 'xwem-minibuffer)
 228
 229 ;;;###autoload
 230 (defcustom xwem-minibuffer-focusin-hook nil
 231   "*Hooks called when xwem minibuffer got focus."
 232   :type 'hook
 233   :group 'xwem-minibuffer
 234   :group 'xwem-hooks)
 235
 236 ;;;###autoload
 237 (defcustom xwem-minibuffer-focusout-hook nil
 238   "*Hooks called when xwem minibuffer lose focus."
 239   :type 'hook
 240   :group 'xwem-minibuffer
 241   :group 'xwem-hooks)
 242
 243 (defcustom xwem-minib-resize-exact t
 244   "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents.
 245 Otherwise, the minibuffer frame can temporarily increase in size but
 246 never get smaller while it is active."
 247   :type 'boolean
 248   :group 'xwem-minibuffer)
 249
 250 (defcustom xwem-minib-specifiers
 251   '((default-toolbar-visible-p . nil)
 252
 253     ;; Gutters
 254     (default-gutter-visible-p . t)
 255     (top-gutter . nil)
 256     (top-gutter-border-width . 1)
 257
 258     (menubar-visible-p . nil)
 259     (horizontal-scrollbar-visible-p . nil)
 260     ((face-font 'default) . xwem-minibuffer-font))
 261   "*Alist of specifiers to be set for xwem minibuffer."
 262   :type '(repeat (cons (sexp :tag "Specifier sexp")
 263                        (sexp :tag "Specifier value sexp")))
 264   :set (lambda (sym value)
 265          (set sym value)
 266          (when (and xwem-minibuffer
 267                     (frame-live-p (xwem-minib-frame xwem-minibuffer)))
 268            (xwem-minib-apply-specifiers (xwem-minib-frame xwem-minibuffer))))
 269   :group 'xwem-minibuffer)
 270
 271 ;;; Internal variables
 272
 273 ;; Variables
 274 ;;;###xwem-autoload
 275 (defvar xwem-minibuffer nil
 276   "Default xwem minibuffer.")
 277
 278 (defvar xwem-minibuffer-map
 279   (let ((map (make-sparse-keymap)))
 280     (define-key map (xwem-kbd "H-g") 'minibuffer-keyboard-quit)
 281     (define-key map (xwem-kbd "C-<button1>") 'xwem-client-imove)
 282     map)
 283   "Keymap used while in xwem.")
 284
 285 \f
 286 (defun xwem-minib-apply-specifiers (frame)
 287   "Apply `xwem-minib-specifiers' to FRAME."
 288   (mapc #'(lambda (spc)
 289             (set-specifier (eval (car spc)) (eval (cdr spc))
 290                            frame nil 'remove-locale))
 291         xwem-minib-specifiers))
 292
 293 (defun xwem-minib-create ()
 294   "Create minibuffer that will be used by xwem, or use existen."
 295   (let ((mframe (or (xwem-misc-find-frame xwem-minibuffer-name
 296                                           (minibuffer-frame-list))
 297                     (make-frame minibuffer-frame-plist
 298                                 (default-x-device))))
 299         (dd default-directory))
 300
 301     (setf (xwem-minib-frame xwem-minibuffer) mframe)
 302     ;; Set specifiers values for MFRAME
 303     (xwem-minib-apply-specifiers mframe)
 304     (redraw-frame mframe t)             ; KEEP THIS!
 305
 306     ;; Hack over default-directory for minibuffer buffer
 307     (with-current-buffer
 308         (window-buffer (frame-root-window mframe))
 309       (setq default-directory dd))
 310
 311     mframe))
 312
 313 (defmacro xwem-cl-minibuffer (cl)
 314   `(xwem-cl-get-sys-prop ,cl 'xwem-minibuffer))
 315 (defsetf xwem-cl-minibuffer (cl) (minib)
 316   `(xwem-cl-put-sys-prop ,cl 'xwem-minibuffer ,minib))
 317
 318 ;;; Minibuffer focus model
 319 (define-xwem-focus-mode minibuffer (cl action &optional xev)
 320   "Focus mode for xwem minibuffer"
 321   (let ((mb (xwem-cl-minibuffer cl)))
 322     (when (and (xwem-minib-p mb)
 323                (X-Event-p xev)
 324                (not (member (X-Event-xfocus-mode xev)
 325                             (list X-NotifyVirtual X-NotifyNonlinearVirtual))))
 326       (cond ((eq action 'focus-in)
 327              ;; XWEM Minibuffer activates
 328              (run-hook-with-args 'xwem-minibuffer-focusin-hook mb))
 329             ((eq action 'focus-out)
 330              ;; XWEM Minibuffer deactivates
 331              (run-hook-with-args 'xwem-minibuffer-focusout-hook mb))))))
 332
 333 ;;;; ---- XWEM Minibuffer manage type ----
 334 (defun xwem-minibuffer-client-p (cl)
 335   "Return non-nil if CL is minibuffer client."
 336   (xwem-cl-minibuffer cl))
 337
 338 (defun xwem-manage-minibuffer (cl)
 339   "Manage method for xwem minibuffers."
 340   (let* ((xgeom (make-X-Geom :x 0       ; XXX
 341                              :y (- (X-Geom-height (xwem-rootgeom))
 342                                    xwem-minibuffer-outer-border-width
 343                                    xwem-minibuffer-outer-border-width)
 344                              :width (- (X-Geom-width (xwem-rootgeom))
 345                                        xwem-minibuffer-outer-border-width
 346                                        xwem-minibuffer-outer-border-width)
 347                              :height (X-Geom-height-with-borders
 348                                       (xwem-cl-xgeom cl))
 349                              :border-width xwem-minibuffer-outer-border-width))
 350          (minib (make-xwem-minib
 351                  :frame (xwem-misc-find-emacs-frame cl)
 352                  :cl cl
 353                  :xgeom xgeom)))
 354
 355     (setf (xwem-minib-xwin minib)
 356           (XCreateWindow (xwem-dpy) nil
 357                          (X-Geom-x xgeom)
 358                          (X-Geom-y xgeom)
 359                          (X-Geom-width xgeom)
 360                          (X-Geom-height xgeom)
 361                          (X-Geom-border-width xgeom)
 362                          nil nil nil
 363                          (make-X-Attr :override-redirect t
 364                                       :background-pixel
 365                                       (XAllocNamedColor
 366                                        (xwem-dpy) (XDefaultColormap (xwem-dpy))
 367                                        xwem-minibuffer-bgcol))))
 368     ;; Setup window a little
 369     (when xwem-minibuffer-outer-border-color
 370       (XSetWindowBorder (xwem-dpy) (xwem-minib-xwin minib)
 371                         (XAllocNamedColor
 372                          (xwem-dpy) (XDefaultColormap (xwem-dpy))
 373                          xwem-minibuffer-outer-border-color)))
 374
 375     ;; Save CL's minibuffer
 376     (setf (xwem-cl-minibuffer cl) minib)
 377
 378     ;; Setup x-border-face for minibuffer
 379     (xwem-set-face-foreground 'x-border-face xwem-minibuffer-active-border-color
 380                               '(selected) cl)
 381     (xwem-set-face-foreground 'x-border-face xwem-minibuffer-passive-border-color
 382                               nil cl)
 383     (xwem-client-set-property cl 'x-border-width xwem-minibuffer-border-width)
 384     (xwem-client-set-property cl 'x-border-color
 385                               (xwem-face-foreground 'x-border-face
 386                                                     (and (xwem-cl-selected-p cl)
 387                                                          '(selected)) cl))
 388
 389     ;; Reparent xwem minib client to parent
 390     ;; XXX XXX
 391     (setf (X-Geom-x (xwem-cl-xgeom cl)) 0)
 392     (setf (X-Geom-y (xwem-cl-xgeom cl)) 0)
 393     (XReparentWindow (xwem-dpy) (xwem-minib-cl-xwin minib)
 394                      (xwem-minib-xwin minib) 0 0)
 395
 396     ;; Set minibuffer focus model
 397     (xwem-focus-mode-set cl 'minibuffer)
 398
 399     ;; Install minibuffer local keymap
 400     (xwem-use-local-map xwem-minibuffer-map cl)
 401
 402     ;; Finnally refit cl and map parent
 403     (xwem-refit cl)
 404     (XMapWindow (xwem-dpy) (xwem-minib-xwin minib))
 405
 406     ;; Set always on top rank (if any)
 407     (when xwem-minibiffer-always-on-top-rank
 408       (xwem-misc-set-xwin-always-on-top
 409        (xwem-minib-xwin minib) xwem-minibiffer-always-on-top-rank))
 410
 411     ;; Set default minibuffer, if not already set
 412     (unless (xwem-cl-p (xwem-minib-cl xwem-minibuffer))
 413       (setq xwem-minibuffer minib)
 414       (when xwem-minibuffer-set-default-minibuffer-frame
 415         (setq default-minibuffer-frame (xwem-minib-frame xwem-minibuffer))))
 416
 417     ;; Now activate minibuffer
 418     (xwem-activate cl)
 419     (xwem-minib-apply-state-1 minib )))
 420
 421 (define-xwem-deffered xwem-minib-apply-pxgeom (minib)
 422   "Apply MINIB's parent geometry to life."
 423   (let ((pxgeom (xwem-minib-xgeom minib)))
 424     (XMoveResizeWindow (xwem-dpy)
 425                        (xwem-minib-xwin minib)
 426                        (X-Geom-x pxgeom)
 427                        (X-Geom-y pxgeom)
 428                        (X-Geom-width pxgeom)
 429                        (X-Geom-height pxgeom))))
 430
 431 ;;
 432 ;; Some bug here:
 433
 434 ;;  Do `(xwem-refit (xwem-minib-cl xwem-minibuffer))' - xwem minib
 435 ;;  will change its width. (ONLY when xwem-minib-resize-mode is on)
 436
 437 (defun xwem-refit-minibuffer (cl)
 438   "Refit xwem minibuffer client CL."
 439   (xwem-debug 'xwem-misc "Minib: Refiting .. to %S" '(xwem-cl-new-xgeom cl))
 440
 441   (let ((cl-xgeom (xwem-cl-xgeom cl))
 442         (cl-nx (and (xwem-cl-new-xgeom cl)
 443                     (X-Geom-x (xwem-cl-new-xgeom cl))))
 444         (pxgeom (xwem-minib-xgeom (xwem-cl-minibuffer cl))))
 445     ;; Adjust geometry a little to fill into xwem-minib-xwin and apply
 446     ;; changes to life
 447     (xwem-cl-apply-new-xgeom cl)
 448     (when cl-nx
 449       ;; CL has new x location - handle it
 450       (setf (X-Geom-x pxgeom) (X-Geom-x cl-xgeom))
 451       (setf (X-Geom-width pxgeom)
 452             (- (X-Geom-width (xwem-rootgeom))
 453                (X-Geom-x pxgeom)
 454                xwem-minibuffer-outer-border-width
 455                xwem-minibuffer-outer-border-width))
 456       (xwem-minib-apply-pxgeom (xwem-cl-minibuffer cl)))
 457     (xwem-cl-correct-size-for-size
 458      cl
 459      (make-X-Geom :x 0 :y 0
 460                   :width (X-Geom-width-with-borders cl-xgeom)
 461                   :height (X-Geom-height-with-borders cl-xgeom)
 462                   :border-width (X-Geom-border-width cl-xgeom))
 463      'left 'top)
 464     (xwem-cl-apply-xgeom cl)
 465
 466     ;; Check maybe parent need to be resized/moved?
 467     (unless (= (X-Geom-height-with-borders cl-xgeom)
 468                (X-Geom-height pxgeom))
 469       (when (eq (xwem-cl-state cl) 'active)
 470         (decf (X-Geom-y pxgeom)
 471               (- (X-Geom-height-with-borders cl-xgeom)
 472                  (X-Geom-height pxgeom))))
 473       (setf (X-Geom-height pxgeom)
 474             (X-Geom-height-with-borders cl-xgeom))
 475       (xwem-minib-apply-pxgeom (xwem-cl-minibuffer cl)))))
 476
 477 (defun xwem-minibuffer-autohide-timer (cl)
 478   (when (and (numberp xwem-minibuffer-autohide-timeout)
 479              (not (xwem-cl-selected-p cl)))
 480     (xwem-deactivate cl))
 481   (xwem-cl-rem-sys-prop cl 'auto-hide-timer))
 482
 483 (defun xwem-minibuffer-disable-autohide-timer (cl)
 484   (let ((tmr (xwem-cl-get-sys-prop cl 'auto-hide-timer)))
 485     (when tmr
 486       (disable-timeout tmr)
 487       (xwem-cl-rem-sys-prop cl 'auto-hide-timer))))
 488
 489 (defun xwem-minibuffer-enable-autohide-timer (cl)
 490   (when (numberp xwem-minibuffer-autohide-timeout)
 491     (xwem-minibuffer-disable-autohide-timer cl)
 492     (xwem-cl-put-sys-prop cl 'auto-hide-timer
 493       (add-timeout xwem-minibuffer-autohide-timeout
 494                    'xwem-minibuffer-autohide-timer cl))))
 495
 496 (define-xwem-deffered xwem-minib-apply-state (minib)
 497   "Apply xwem minibuffer MINIB's state to life."
 498   (let* ((pgeom (xwem-minib-xgeom minib))
 499          (cyo (X-Geom-height pgeom))
 500          (state (xwem-cl-state (xwem-minib-cl minib)))
 501          (param (and (numberp xwem-minibuffer-hide-show-parameter)
 502                      (not (zerop xwem-minibuffer-hide-show-parameter))
 503                      xwem-minibuffer-hide-show-parameter))
 504          (i 0))
 505     (when (not (eq state (xwem-minib-get-prop minib 'saved-state)))
 506       (xwem-debug 'xwem-misc "Minib: new state .. %S" 'state)
 507
 508       (while (< i cyo)
 509         (setf (X-Geom-y (xwem-minib-xgeom minib))
 510               (funcall (if (eq state 'active) '- '+)
 511                        (X-Geom-y (xwem-minib-xgeom minib)) 1))
 512         (XMoveWindow (xwem-dpy) (xwem-minib-xwin minib)
 513                      (X-Geom-x (xwem-minib-xgeom minib))
 514                      (X-Geom-y (xwem-minib-xgeom minib)))
 515         (XFlush (xwem-dpy))
 516         (when param
 517           (sit-for param t))
 518         (setq i (1+ i)))
 519       (xwem-minib-put-prop minib 'saved-state state)
 520
 521       (when (and xwem-minibuffer-raise-when-active
 522                  (eq state 'active))
 523         (xwem-misc-raise-xwin (xwem-minib-xwin minib))))
 524
 525     (when (eq state 'active)
 526       (xwem-minibuffer-enable-autohide-timer (xwem-minib-cl minib)))))
 527
 528 (defun xwem-activate-minibuffer (cl &optional type)
 529   "Activate xwem minibuffer CL."
 530   (cond ((eq type 'activate)
 531          (xwem-minib-apply-state (xwem-cl-minibuffer cl)))
 532
 533         ((eq type 'select)
 534          (when xwem-minibuffer-hide-cursor-mode
 535            (set-frame-property (xwem-minib-frame (xwem-cl-minibuffer cl))
 536                                'text-cursor-visible-p t))
 537
 538          (xwem-minibuffer-disable-autohide-timer cl))))
 539
 540 (defun xwem-deactivate-minibuffer (cl &optional type)
 541   "Deactivate xwem minibuffer client CL."
 542   (cond ((eq type 'deactivate)
 543          (xwem-minib-apply-state (xwem-cl-minibuffer cl)))
 544
 545         ((eq type 'deselect)
 546          (when xwem-minibuffer-hide-cursor-mode
 547            (set-frame-property (xwem-minib-frame (xwem-cl-minibuffer cl))
 548                                'text-cursor-visible-p nil))
 549          (when xwem-minibuffer-autohide-timeout
 550            (xwem-deactivate cl)))))
 551
 552 (defun xwem-iconify-minibuffer (cl)
 553   "Iconify xwem minibuffer client CL."
 554   (xwem-deactivate cl))
 555
 556 ;; Events handler
 557 (define-xwem-deffered xwem-minib-focusin-autoraise (minib)
 558   "Mainly for use in `xwem-minibuffer-focusout-hook'."
 559   (xwem-misc-raise-xwin (xwem-minib-xwin minib)))
 560
 561 (define-xwem-deffered xwem-minib-focusout-autolower (minib)
 562   "Mainly for use in `xwem-minibuffer-focusout-hook'."
 563   (xwem-misc-lower-xwin (xwem-minib-xwin minib)))
 564
 565 ;;;###autoload(autoload 'xwem-minibuffer-activate "xwem-minibuffer" "" t)
 566 (define-xwem-command xwem-minibuffer-activate ()
 567   "Switch to xwem minibuffer if it is in active state."
 568   (xwem-interactive)
 569   (if (eq (active-minibuffer-window)
 570           (frame-selected-window (xwem-minib-frame xwem-minibuffer)))
 571       (xwem-select-client (xwem-minib-cl xwem-minibuffer))
 572     (xwem-activate (xwem-minib-cl xwem-minibuffer))))
 573
 574 ;;;###autoload
 575 (defun xwem-minibuffer-init ()
 576   "Initialize xwem minibuffer."
 577   (xwem-message 'init "Initializing minibuffer ...")
 578
 579   (setq minibuffer-frame-plist
 580         (xwem-misc-merge-plists
 581          minibuffer-frame-plist
 582          `(name ,xwem-minibuffer-name
 583                 wait-for-wm nil
 584                 height ,xwem-minibuffer-height
 585                 text-cursor-visible-p ,(not xwem-minibuffer-hide-cursor-mode)
 586                 width ,xwem-minibuffer-width
 587                 minibuffer only)))
 588
 589   ;; Adjust initial frame params
 590   (unless xwem-minibuffer-emacs-frames-has-minibuffer
 591     (setq initial-frame-plist
 592           (plist-put initial-frame-plist 'minibuffer nil)))
 593   (setq initial-frame-plist
 594         (plist-put initial-frame-plist 'wait-for-wm nil))
 595
 596   ;; Adjust default frame params
 597   (unless xwem-minibuffer-emacs-frames-has-minibuffer
 598     (setq default-x-frame-plist
 599           (plist-put default-x-frame-plist 'minibuffer nil)))
 600   (setq default-x-frame-plist
 601         (plist-put default-x-frame-plist 'wait-for-wm nil))
 602
 603   ;; Create XEmacs minibuffer only frame for xwem minibuffer
 604   (setq xwem-minibuffer (make-xwem-minib))
 605   (setf (xwem-minib-frame xwem-minibuffer)
 606         (make-initial-minibuffer-frame nil))
 607   (xwem-message 'init "Initializing minibuffer ... done"))
 608
 609 ;;; Resize-minibuffer mode
 610 (defvar xwem-minib-rsz-saved-height nil)
 611
 612 (defun xwem-minib-rsz-count-window-lines (&optional start end)
 613   "Return number of window lines occupied by text in region.
 614 The number of window lines may be greater than the number of actual lines
 615 in the buffer if any wrap on the display due to their length.
 616
 617 Optional arguments START and END default to point-min and point-max,
 618 respectively."
 619   (or start (setq start (point-min)))
 620   (or end   (setq end   (point-max)))
 621   (if (= start end)
 622       0
 623     (save-excursion
 624       (save-restriction
 625         (widen)
 626         (narrow-to-region start end)
 627         (goto-char start)
 628         (vertical-motion (buffer-size))))))
 629
 630 (defun xwem-minib-rsz-restore ()
 631   "Restore xwem minibuffer size."
 632   (xwem-minib-rsz-resize xwem-minib-rsz-saved-height)
 633   (xwem-misc-lower-xwin (xwem-minib-xwin xwem-minibuffer)))
 634
 635 (defun xwem-minib-rsz-check ()
 636   "Called in `pre-command-hook'.
 637 Check is next command is actually keyboard quit.
 638 If yes, then restore xwem minibuffer size."
 639   (when (member this-command '(minibuffer-keyboard-quit keyboard-quit))
 640     (xwem-minib-rsz-restore)))
 641
 642 (defun xwem-minib-rsz-resize (&optional new-height)
 643   "Resize xwem minibuffer to fit either NEW-HEIGHT.
 644 If NEW-HEIGHT is ommited, current window height considered."
 645   (let* ((frame (xwem-minib-frame xwem-minibuffer))
 646          (height (frame-height frame))
 647          (lines (or new-height (1+ (xwem-minib-rsz-count-window-lines))))
 648          w n)
 649     (cond ((or new-height xwem-minib-resize-exact (> lines height))
 650            (setq w (frame-pixel-height frame))
 651            (set-frame-size frame (frame-width frame) lines)
 652            (setq n (frame-pixel-height frame))
 653
 654            (xwem-misc-raise-xwin (xwem-minib-xwin xwem-minibuffer))
 655
 656            ;; Adjust xwem minibuffer cl height
 657            (xwem-client-resize (xwem-minib-cl xwem-minibuffer) nil
 658                                (+ (X-Geom-height
 659                                    (xwem-minib-cl-xgeom xwem-minibuffer))
 660                                   (- n w)))
 661            ))))
 662
 663 (defun xwem-minib-rsz-setup ()
 664   "Setup xwem resize minibuffer mode for xwem minibuffer."
 665   (when (eq (window-frame (minibuffer-window))
 666             (xwem-minib-frame xwem-minibuffer))
 667     (setq xwem-minib-rsz-saved-height
 668           (frame-property (selected-frame) 'height))
 669
 670     (make-local-hook 'minibuffer-exit-hook)
 671     (add-hook 'minibuffer-exit-hook 'xwem-minib-rsz-restore nil t)
 672     (make-local-hook 'pre-command-hook)
 673     (add-hook 'pre-command-hook 'xwem-minib-rsz-check nil t)
 674     (make-local-hook 'post-command-hook)
 675     (add-hook 'post-command-hook 'xwem-minib-rsz-resize nil t)
 676
 677     (unless (and (boundp 'icomplete-mode)
 678                  (eval 'icomplete-mode)) ; shutup compiler
 679       (xwem-minib-rsz-resize))
 680     ))
 681
 682 ;;;###autoload(autoload 'xwem-minib-resize-mode "xwem-minibuffer" "" t)
 683 (define-xwem-command xwem-minib-resize-mode (arg)
 684   "Start/stop xwem minibuffer auto-resize mode.
 685 With prefix ARG start, without - stop."
 686   (xwem-interactive "P")
 687   (if arg
 688       (add-hook 'minibuffer-setup-hook 'xwem-minib-rsz-setup)
 689     (remove-hook 'minibuffer-setup-hook 'xwem-minib-rsz-setup)))
 690
 691 ;;; xwem minibuffer modeline using top gutter
 692 (defvar xwem-modeline-format
 693   '("--"
 694     (symbol-name (xwem-cl-manage-type cl))
 695     ": "
 696     "["
 697     (or (car (xwem-client-application cl))
 698         "unknown")
 699     "]"
 700
 701     ;; Some additional info
 702     " "
 703     (if (xwem-cl-marked-p cl) "*" "-")
 704     (let ((reg (xwem-client-property cl 'register)))
 705       (if reg (list (format "%c" reg) 'bold) "-"))
 706     " "
 707
 708     (list (xwem-client-name cl) 'modeline-buffer-id)
 709     "   "
 710     ;; Minor modes
 711     "("
 712     (mapconcat 'identity
 713                (delq nil (mapcar #'(lambda (mm)
 714                                      (and (symbol-value (car mm))
 715                                           (cadr mm)))
 716                                  xwem-minor-mode-alist)) " ")
 717     ")"
 718     "----"
 719     (let ((usz (xwem-cl-get-usize cl)))
 720       (format "%dx%d" (car usz) (cdr usz)))
 721     "--")
 722   "Modeline format.")
 723 (xwem-make-variable-client-local 'xwem-modeline-format)
 724
 725 (defun xwem-modeline-regenerate ()
 726   "Regenerate modeline string."
 727   (mapconcat #'(lambda (me)
 728                  (let ((cl (xwem-cl-selected)))
 729                    (setq cl cl)         ; shutup compiler
 730                    (condition-case nil
 731                        (let ((str "") (faces nil))
 732                          (setq me (eval me))
 733                          (if (listp me)
 734                              (setq str (copy-sequence (car me))
 735                                    faces (cdr me))
 736                            (setq str (copy-sequence me)
 737                                  faces nil))
 738                          (xwem-str-with-faces str (append '(modeline) faces)))
 739                      (t "<error>"))))
 740              xwem-modeline-format ""))
 741
 742 (define-xwem-deffered xwem-modeline-redraw (&optional cl)
 743   "Redraw xwem modeline."
 744   (if (xwem-cl-alive-p cl)
 745       (when (xwem-cl-selected-p cl)
 746         (xwem-modeline-redraw))
 747
 748     (let* ((str (xwem-modeline-regenerate))
 749            (mw (frame-width (xwem-minib-frame xwem-minibuffer))))
 750       (set-specifier top-gutter (substring str 0 (and (> (length str) mw) mw))
 751                      (xwem-minib-frame xwem-minibuffer))
 752       )))
 753
 754 ;;;###autoload(autoload 'xwem-modeline-enable "xwem-minibuffer" nil t)
 755 (define-xwem-command xwem-modeline-enable ()
 756   "Enable modeline."
 757   (xwem-interactive)
 758
 759   (add-hook 'xwem-cl-change-hook 'xwem-modeline-redraw)
 760   (add-hook 'xwem-client-select-hook 'xwem-modeline-redraw)
 761
 762   (set-specifier top-gutter-visible-p t
 763                  (xwem-minib-frame xwem-minibuffer))
 764   ;; Start showing gutter
 765   (xwem-modeline-redraw-1)
 766   ;; Fix xwem minibuffer height size
 767   (xwem-client-resize
 768    (xwem-minib-cl xwem-minibuffer) nil
 769    (+ (X-Geom-height-with-borders (xwem-minib-cl-xgeom xwem-minibuffer))
 770       (gutter-pixel-height 'top (xwem-minib-frame xwem-minibuffer))
 771       (specifier-instance top-gutter-border-width
 772                           (xwem-minib-frame xwem-minibuffer))
 773       (specifier-instance top-gutter-border-width
 774                           (xwem-minib-frame xwem-minibuffer)))))
 775
 776 ;;;###autoload(autoload 'xwem-modeline-disable "xwem-minibuffer" nil t)
 777 (define-xwem-command xwem-modeline-disable ()
 778   "Disable modeline."
 779   (xwem-interactive)
 780
 781   (remove-hook 'xwem-cl-change-hook 'xwem-modeline-redraw)
 782   (remove-hook 'xwem-client-select-hook 'xwem-modeline-redraw)
 783
 784   ;; Fix xwem minibuffer height size
 785   (xwem-client-resize
 786    (xwem-minib-cl xwem-minibuffer) nil
 787    (- (X-Geom-height-with-borders (xwem-minib-cl-xgeom xwem-minibuffer))
 788       (gutter-pixel-height 'top (xwem-minib-frame xwem-minibuffer))
 789       (specifier-instance top-gutter-border-width
 790                           (xwem-minib-frame xwem-minibuffer))
 791       (specifier-instance top-gutter-border-width
 792                           (xwem-minib-frame xwem-minibuffer))))
 793   ;; Stop showing gutter
 794   (set-specifier top-gutter nil
 795                  (xwem-minib-frame xwem-minibuffer)))
 796
 797 \f
 798 (provide 'xwem-minibuffer)
 799
 800 ;;;; On-load actions:
 801 ;; Define application
 802 (add-to-list 'xwem-applications-alist
 803              `("xemacs-xwem-minibuffer"
 804                (and (class-name ,(concat "^" x-emacs-application-class "$"))
 805                     (class-inst ,(concat "^" xwem-minibuffer-name "$")))))
 806
 807 ;; Add manage type
 808 (define-xwem-manage-model minibuffer
 809   "Managing model for xwem minibuffer."
 810   :cl-properties '(dummy-client-p t
 811                                   skip-deselect t
 812                                   override-skip-deselect t)
 813   :match-spec '(application "xemacs-xwem-minibuffer")
 814
 815   :manage-method 'xwem-manage-minibuffer
 816   :activate-method 'xwem-activate-minibuffer
 817   :deactivate-method 'xwem-deactivate-minibuffer
 818   :refit-method 'xwem-refit-minibuffer
 819   :iconify-method 'xwem-iconify-minibuffer)
 820
 821 ;; - Before init hook
 822 (if xwem-started
 823     (xwem-minib-create)
 824   (add-hook 'xwem-config-read-hook 'xwem-minibuffer-init)
 825   (add-hook 'xwem-before-init-hook 'xwem-minib-create))
 826
 827 ;;; xwem-minibuffer.el ends here