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

   1 ;;; xwem-special.el --- Special Emacs frames handling.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Thu Dec  4 15:01:21 MSK 2003
   7 ;; Keywords: xwem, xlib
   8 ;; X-CVS: $Id: xwem-special.el,v 1.11 2005-04-04 19:54:16 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 ;; Special emacs uses by XWEM to accomplish various tasks.  Such as
  32 ;; help system, and others.  Special frames are handled in different
  33 ;; way, but remain normal XWEM client.  Usually special frame used by
  34 ;; XWEM has dedicated window, i.e. removing window will remove frame,
  35 ;; but optionally you can create normal frames.  Take a look at
  36 ;; documentation for `xwem-special-popup-frame' function.
  37
  38 ;; XEmacs has a bug, when window is dedicated to buffer, after buffer
  39 ;; deletion window will be deleted as well and if it is only window in
  40 ;; frame frame will be also deleted.  But if there is no visible
  41 ;; frames at the moment `replace-buffer-in-windows' will skip value of
  42 ;; `allow-deletion-of-last-visible-frame' and does not deletes frame.
  43 ;; So we can't use dedicated windows, because almost everywhere we
  44 ;; will get such sitiation, for example runnig H-h H-h when there is
  45 ;; no active emacs frame.  `xwem-special-popup-frame' will use
  46 ;; dedicated frame to display buffer and here is advice for
  47 ;; `kill-buffer':
  48
  49 ;;    (defadvice kill-buffer (before delete-dedicated-frame activate)
  50 ;;      "Work around dedicated frame problem."
  51 ;;      (let ((frame (buffer-dedicated-frame (ad-get-arg 0))))
  52 ;;      (when (framep frame)
  53 ;;        (delete-frame frame))))
  54 ;;
  55
  56 ;;; TODO:
  57 ;;    - Models
  58
  59 ;;; Code:
  60 \f
  61 (require 'xwem-load)
  62 (require 'xwem-manage)
  63
  64 (eval-when-compile
  65   (defvar x-emacs-application-class nil))
  66
  67 ;;; Customisation
  68 (defgroup xwem-special nil
  69   "Group to customize special emacs frames handling."
  70   :prefix "xwem-special-"
  71   :group 'xwem-modes)
  72
  73 (defcustom xwem-special-frame-name "xwem-special-frame"
  74   "*Name for special emacs frames"
  75   :type 'string
  76   :group 'xwem-special)
  77
  78 (defcustom xwem-special-model-function 'xwem-special-at-center
  79   "*Special frame handiling model function."
  80   :type '(choice (const :tag "At Center" xwem-special-at-center)
  81                  (const :tag "At Pointer" xwem-special-at-pointer)
  82                  (function :tag "User function"))
  83   :group 'xwem-special)
  84
  85 (defcustom xwem-special-border-width 2
  86   "Border width of special Emacs frames."
  87   :type 'number
  88   :group 'xwem-special)
  89
  90 (defcustom xwem-special-border-color "red4"
  91   "Border color of special Emacs frames."
  92   :type 'color
  93   :group 'xwem-special)
  94
  95 (defcustom xwem-special-auto-hide nil
  96   "*Non-nill mean that special frames will autohide when loses focus or visibility."
  97   :type 'boolean
  98   :group 'xwem-special)
  99
 100 (defcustom xwem-special-hide-method 'XDestroyWindow
 101   "*Method used to hide special frames.
 102 One of 'XDestroyWindow or 'XUnmapWindow.
 103 If 'XUnmapWindow than special frames will not be removed from clients
 104 list, so it will be possible to access them after hidding."
 105   :type 'boolean
 106   :group 'xwem-special)
 107
 108 (defcustom xwem-special-menubar-visible-p nil
 109   "Non-nil for menubar in special Emacs frames."
 110   :type 'boolean
 111   :group 'xwem-special)
 112
 113 (defcustom xwem-special-toolbar-visible-p nil
 114   "Non-nil for toolbar in special Emacs frames."
 115   :type 'boolean
 116   :group 'xwem-special)
 117
 118 (defcustom xwem-special-display-buffer-names nil
 119   "*List of buffer names to display using special frame."
 120   :type '(repeat string)
 121   :group 'xwem-special)
 122
 123 (defcustom xwem-special-display-buffer-strategy 'half
 124   "*Strategy to use when display one of `xwem-special-display-buffer-names' buffer in special frame."
 125   :type '(choice (const :tag "Half screen" half)
 126                  (const :tag "Center" centre))
 127   :group 'xwem-special)
 128
 129 (defcustom xwem-special-default-strategy 'half
 130   "*Default strategy to use when displaying special Emacs frame."
 131   :type '(choice (const :tag "Half screen" half)
 132                  (const :tag "Fill current client" fill)
 133                  (const :tag "Center" centre))
 134   :group 'xwem-special)
 135
 136 (defcustom xwem-special-fill-border-width 10
 137   "*Pixels border when using `fill' strategy."
 138   :type 'number
 139   :group 'xwem-special)
 140
 141 ;;; Internal variables
 142
 143 (defvar xwem-special-frames-list nil "List of special frames.")
 144
 145 \f
 146 (defun xwem-special-frame-init ()
 147   "Initialize stuff to work with special emacs frames."
 148   (setq special-display-frame-plist
 149         (plist-put special-display-frame-plist 'minibuffer nil))
 150   (setq special-display-frame-plist
 151         (plist-put special-display-frame-plist 'name xwem-special-frame-name))
 152   (setq special-display-frame-plist
 153         (plist-put special-display-frame-plist 'border-width xwem-special-border-width))
 154   (setq special-display-frame-plist
 155         (plist-put special-display-frame-plist 'border-color xwem-special-border-color))
 156   (setq special-display-frame-plist
 157         (plist-put special-display-frame-plist 'menubar-visible-p xwem-special-menubar-visible-p))
 158   (setq special-display-frame-plist
 159         (plist-put special-display-frame-plist 'default-toolbar-visible-p xwem-special-toolbar-visible-p))
 160   (setq special-display-frame-plist
 161         (plist-put special-display-frame-plist 'wait-for-wm nil))
 162   )
 163
 164 ;; Functions
 165 ;; NOTE:
 166 ;;   - setting initially-unmapped to t causes double MapRequest
 167 ;;
 168 (defun xwem-special-make-frame ()
 169   "Make special frame.
 170 NOTE: frame is initially unmapped, use `make-frame-visible' to map it."
 171   (let ((props special-display-frame-plist))
 172     (setq props (plist-put props 'name xwem-special-frame-name))
 173 ;    (setq props (plist-put props 'initially-unmapped t))
 174
 175     (make-frame props (default-x-device))))
 176
 177 (defun xwem-special-display-popup-frame (buffer &optional args)
 178   "Popup special frame with BUFFER."
 179   (frame-selected-window (xwem-special-popup-frame buffer)))
 180
 181 ;;;###xwem-autoload
 182 (defun xwem-special-popup-frame (buf &optional nondedicated-p args)
 183   "As `special-display-popup-frame', but popup frame for sure.
 184 When NONDEDICATED-P is non-nil then frame will not be dedicated."
 185   (let ((sfr (xwem-special-make-frame)))
 186     (set-window-buffer (frame-selected-window sfr) buf)
 187     (unless nondedicated-p
 188       (set-window-dedicated-p (frame-selected-window sfr) t))
 189
 190     (set-buffer-dedicated-frame buf sfr) ; XXX
 191
 192     ;; Put special frame property, to know that this frame forced to
 193     ;; be special.
 194     (set-frame-property sfr 'xwem-forced-special t)
 195
 196     (make-frame-visible sfr)
 197 ;    (raise-frame sfr)
 198     (select-frame sfr)
 199     sfr))
 200
 201 ;;;###xwem-autoload
 202 (defun xwem-special-p (cl)
 203   "Return non-nil if CL is special client."
 204   (eq (xwem-cl-manage-type cl) 'emacs-special))
 205
 206 (defun xwem-special-select (cl)
 207   "Select special client CL."
 208   (xwem-client-set-property cl 'skip-deselect t)
 209   (xwem-client-set-property cl 'override-skip-deselect t)
 210
 211   (xwem-select-client cl))
 212
 213 ;;;###xwem-autoload
 214 (defun xwem-special-revert-focus (&optional spec-cl)
 215   "Try to predict who has focus, before SPEC-CL and revert to it."
 216   (xwem-client-set-property spec-cl 'skip-deselect nil)
 217   (xwem-client-set-property spec-cl 'override-skip-deselect nil)
 218
 219   (xwem-select-last-or-other-client spec-cl))
 220
 221 ;; Events handler
 222 (defun xwem-special-evhandler (xdpy win xev)
 223   "Event handler for speical emacs frames."
 224   (xwem-debug 'xwem-misc "XWEM-SPECIAL-EVHANDLER: ev = %S, winid = %S"
 225               '(X-Event-name xev) '(aref win 2))
 226
 227   (X-Event-CASE xev
 228     ((:X-FocusOut :X-VisibilityNotify)
 229      (when xwem-special-auto-hide
 230        (xwem-deactivate (xwem-xwin-cl win))))
 231
 232     ((:X-DestroyNotify :X-UnmapNotify)
 233      (when (X-Win-p win)
 234        (X-Win-EventHandler-rem win 'xwem-special-evhandler)
 235        (xwem-special-revert-focus (xwem-xwin-cl win))))
 236     ))
 237
 238 ;;;; ---- Manage methods for special frame ----
 239 ;;;###autoload
 240 (defun xwem-manage-emacs-special (cl)
 241   "Manage method for special emacs frame client CL."
 242   (let* ((frame (xwem-misc-find-emacs-frame cl))
 243          (bname (buffer-name (window-buffer (frame-selected-window frame))))
 244          (win (xwem-cl-xwin cl))
 245          (par-win (xwem-rootwin))
 246          strategy fgeom)
 247
 248     (cond ((member bname xwem-special-display-buffer-names)
 249            (setq strategy xwem-special-display-buffer-strategy))
 250           (t (setq strategy xwem-special-default-strategy)))
 251
 252     (cond ((eq strategy 'half)
 253            (setq fgeom
 254                  (make-X-Geom
 255                   :x 0
 256                   :y (/ (X-Geom-y (xwem-minib-xgeom xwem-minibuffer)) 2)
 257                   :width (X-Geom-width-with-borders
 258                           (xwem-minib-cl-xgeom xwem-minibuffer))
 259                   :height (/ (X-Geom-y (xwem-minib-xgeom xwem-minibuffer)) 2)
 260                   :border-width nil)))
 261
 262           ((and (eq strategy 'fill)
 263                 (xwem-cl-alive-p (xwem-cl-selected))
 264                 (not (eq cl (xwem-cl-selected))))
 265            (setq fgeom (copy-X-Geom (xwem-cl-xgeom (xwem-cl-selected))))
 266            (setf (X-Geom-x fgeom) 0)
 267            (setf (X-Geom-y fgeom) 0)
 268            (setf (X-Geom-border-width fgeom) xwem-special-fill-border-width)
 269            (setq par-win (xwem-cl-xwin (xwem-cl-selected)))))
 270
 271     ;; Operate on unmapped window
 272     (XSelectInput (xwem-dpy) win 0)
 273
 274     (when fgeom
 275       (xwem-cl-correct-size-for-size cl fgeom))
 276     (xwem-cl-apply-xgeom-1 cl)
 277
 278     (XReparentWindow (xwem-dpy) win par-win
 279                      (X-Geom-x (xwem-cl-xgeom cl))
 280                      (X-Geom-y (xwem-cl-xgeom cl)))
 281
 282     ;; Setup events handler for special frames
 283     (XSelectInput (xwem-dpy) win
 284                   (Xmask-or XM-FocusChange
 285                             XM-VisibilityChange XM-StructureNotify))
 286     (X-Win-EventHandler-add-new win 'xwem-special-evhandler)
 287
 288     ;; Select client
 289     (xwem-special-select cl)))
 290
 291 (define-xwem-deffered xwem-special-apply-state (cl)
 292   "Apply CL's state to life."
 293   (cond ((eq (xwem-cl-state cl) 'active)
 294          (xwem-misc-raise-xwin (xwem-cl-xwin cl))
 295          (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)))
 296
 297         ((eq (xwem-cl-state cl) '(inactive iconify))
 298          (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl))
 299          (xwem-special-revert-focus cl))))
 300
 301 (defun xwem-activate-emacs-special (cl &optional type)
 302   "Activate method for special emacs frame client CL."
 303   (xwem-special-apply-state cl))
 304
 305 (defun xwem-deactivate-emacs-special (cl &optional type)
 306   "Demanage specal xwem client CL."
 307   (cond ((eq type 'deactivate)
 308          (xwem-special-apply-state cl))))
 309
 310 (defun xwem-iconify-emacs-special (cl)
 311   "Iconify handler for special frame."
 312   (xwem-special-apply-state cl))
 313
 314 \f
 315 (provide 'xwem-special)
 316
 317 ;;;; On-load actions:
 318 ;; Define application
 319 (add-to-list 'xwem-applications-alist
 320              `("xemacs-xwem-special"
 321                    (and (class-name ,(concat "^" x-emacs-application-class "$"))
 322                         (class-inst ,(concat "^" xwem-special-frame-name "$")))))
 323
 324 ;; Add manage type
 325 (define-xwem-manage-model emacs-special
 326   "Managing model for special Emacs frames."
 327   :match-spec '(application "xemacs-xwem-special")
 328
 329   :manage-method 'xwem-manage-emacs-special
 330   :activate-method 'xwem-activate-emacs-special
 331   :deactivate-method 'xwem-deactivate-emacs-special
 332   :iconify-method 'xwem-iconify-emacs-special)
 333
 334 ;; - Before init hook
 335 (if xwem-started
 336     (xwem-special-frame-init)
 337   (add-hook 'xwem-before-init-hook 'xwem-special-frame-init))
 338
 339 ;;; xwem-special.el ends here