xwem / lisp / xwem-special.el

;;; xwem-special.el --- Special Emacs frames handling.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Thu Dec  4 15:01:21 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:

;; Special emacs uses by XWEM to accomplish various tasks.  Such as
;; help system, and others.  Special frames are handled in different
;; way, but remain normal XWEM client.  Usually special frame used by
;; XWEM has dedicated window, i.e. removing window will remove frame,
;; but optionally you can create normal frames.  Take a look at
;; documentation for `xwem-special-popup-frame' function.

;; XEmacs has a bug, when window is dedicated to buffer, after buffer
;; deletion window will be deleted as well and if it is only window in
;; frame frame will be also deleted.  But if there is no visible
;; frames at the moment `replace-buffer-in-windows' will skip value of
;; `allow-deletion-of-last-visible-frame' and does not deletes frame.
;; So we can't use dedicated windows, because almost everywhere we
;; will get such sitiation, for example runnig H-h H-h when there is
;; no active emacs frame.  `xwem-special-popup-frame' will use
;; dedicated frame to display buffer and here is advice for
;; `kill-buffer':

;;    (defadvice kill-buffer (before delete-dedicated-frame activate)
;;      "Work around dedicated frame problem."
;;      (let ((frame (buffer-dedicated-frame (ad-get-arg 0))))
;;	(when (framep frame)
;;	  (delete-frame frame))))

;;; TODO:
;;    - Models

;;; Code:
  (require 'xlib-xwin)
  (require 'xwem-misc))
(defgroup xwem-special nil
  "Group to customize special emacs frames handling."
  :prefix "xwem-special-"
  :group 'xwem)

(defcustom xwem-special-enabled t
  "*Non-nil mean make xwem to understand emacs special frames."
  :type 'boolean
  :group 'xwem-special)

(defcustom xwem-special-frame-name "xwem-special-frame"
  "*Name for special emacs frames"
  :type 'string
  :group 'xwem-special)

(defcustom xwem-special-model-function 'xwem-special-at-center
  "*Special frame handiling model function."
  :type '(choice (const :tag "At Center" xwem-special-at-center)
		 (const :tag "At Pointer" xwem-special-at-pointer)
		 (function :tag "User function"))
  :group 'xwem-special)

(defcustom xwem-special-border-width 2
  "Border width of special Emacs frames."
  :type 'number
  :group 'xwem-special)

(defcustom xwem-special-border-color "red4"
  "Border color of special Emacs frames."
  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
  :group 'xwem-special)

(defcustom xwem-special-menubar-visible-p nil
  "Non-nil for menubar in special Emacs frames."
  :type 'boolean
  :group 'xwem-special)

(defcustom xwem-special-toolbar-visible-p nil
  "Non-nil for toolbar in special Emacs frames."
  :type 'boolean
  :group 'xwem-special)

;; Internal variables
(defvar xwem-special-frames-list nil "List of special frames.")

;; Functions
;; NOTE:
;;   - setting initially-unmapped to t causes double MapRequest
(defun xwem-special-make-frame ()
  "Make special frame.
NOTE: frame is initially unmapped, use `make-frame-visible' to map it."
  (let ((props special-display-frame-plist))
    (setq props (plist-put props 'name xwem-special-frame-name))
;    (setq props (plist-put props 'initially-unmapped t))

    (make-frame props)))

(defun xwem-special-frame-p (thing)
  "Check THING is acctually special emacs frame.
THING may be X window or xwem clinet."
  (cond ((X-Win-p thing) (string= (car (XGetWMClass (xwem-dpy) thing))
	((xwem-cl-p thing) (string= (car (xwem-hints-wm-class (xwem-cl-hints thing)))
	(t nil))

(defun xwem-special-display-popup-frame (buffer &optional args)
  "Popup special frame with BUFFER."
  (frame-selected-window (xwem-special-popup-frame buffer)))

(defun xwem-special-popup-frame (buf &optional nondedicated-p args)
  "As `special-display-popup-frame', but popup frame for sure.
When NONDEDICATED-P is non-nil then frame will not be dedicated."
  (let ((sfr (xwem-special-make-frame)))
    (set-window-buffer (frame-selected-window sfr) buf)
    (unless nondedicated-p
      (set-window-dedicated-p (frame-selected-window sfr) t))

    (set-buffer-dedicated-frame buf sfr) ; XXX

    ;; Put special frame property, to know that this frame forced to
    ;; be special.
    (set-frame-property sfr 'xwem-forced-special t)

;    (make-frame-visible sfr)
    (raise-frame sfr)
    (select-frame sfr)

(defun xwem-special-at-center (cl)
  "Display special frame at center of selected xwem frame."

(defun xwem-special-frame-manage (cl &rest not-used)
  "Manage special xwem client CL."
  (X-Dpy-log (xwem-dpy) "HERE in `xwem-special-frame-manage'.\n")
  ;; Make it just above xwem-minibuffer

  ;; TODO: * What is if xwem minibuffer is not managed yet, e.g. when
  ;;         we processes after QueryTree and special frame is before
  ;;         xwem minibuffer frame.
  ;;       * Implement various special frame manage models
  ;;          - center of selected frame
  ;;          - just above xwem minibuffer
  ;;          - pointer at the center
  ;;          - other
;  (funcall xwem-special-model-function cl)
  (let* ((ming (xwem-minib-xgeom xwem-minibuffer))
	 (win (xwem-cl-xwin cl))
	 (clgeo (xwem-cl-xgeom cl))
	 (clhe (X-Geom-height clgeo))
	 (clwi (X-Geom-width clgeo))
	 (cfr (xwem-frame-selected))
;	 (cfrwi (if cfr (xwem-frame-width cfr) (X-Geom-width (xwem-rootgeom))))
	 (yoff 0)
	 (xoff 0))

    (X-Dpy-log (xwem-dpy) "HERE AGAIN: clgeo=%S\n" 'clgeo)
    (setq yoff (- (X-Geom-y ming) clhe 4))
;    (setq xoff (/ (- (X-Geom-width (xwem-rootgeom)) clwi) 2))
    (setq xoff (+ (xwem-frame-x cfr) (/ (- (xwem-frame-width cfr) clwi) 2)))
    (X-Dpy-log (xwem-dpy) "HERE again: xoff=%d yoff=%d\n" 'xoff 'yoff)
;    (XReparentWindow (xwem-dpy) win (xwem-rootwin) xoff yoff)
    (XMoveWindow (xwem-dpy) win xoff yoff)
    (XMapWindow (xwem-dpy) win)
    (XRaiseWindow (xwem-dpy) win)

    (XSelectInput (xwem-dpy) win (Xmask-or XM-FocusChange

    ;; Setup events handler for special frames
    (X-Win-EventHandler-add-new win 'xwem-special-evhandler)

    ;; TODO: hooking?
    (xwem-focus-set win t)

(defun xwem-special-revert-focus ()
  "Try to predict who has focus, before special and revert to it."

(defun xwem-special-frame-demanage (cl &rest args)
  "Demanage specal xwem client CL."
  (when (xwem-misc-xwin-valid-p (xwem-cl-xwin cl))
    (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)))


(defun xwem-special-frame-iconify (cl &rest args)
  "Iconify handler for special frame."
  (xwem-special-frame-demanage cl))

;; Events handler
(defun xwem-special-evhandler (xdpy win xev)
  "Event handler for speical emacs frames."
  (X-Dpy-log (xwem-dpy) "XWEM-SPECIAL-EVHANDLER: ev = %S, winid = %S\n"
	     '(X-Event-name xev) '(aref win 2))

  (X-Event-CASE xev
     (xwem-special-frame-demanage (xwem-find-client win)))

     (when (X-Win-p win)
       (X-Win-EventHandler-rem win 'xwem-special-evhandler))

     (when (X-Win-p win)
       (X-Win-EventHandler-rem win 'xwem-special-evhandler))

     (xwem-special-frame-demanage (xwem-find-client win)))

(defun xwem-special-frame-init ()
  "Initialize stuff to work with special emacs frames."
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'minibuffer nil))
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'name xwem-special-frame-name))
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'border-width xwem-special-border-width))
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'border-color xwem-special-border-color))
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'menubar-visible-p xwem-special-menubar-visible-p))
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'default-toolbar-visible-p xwem-special-toolbar-visible-p))
  (setq special-display-frame-plist
        (plist-put special-display-frame-plist 'wait-for-wm nil))

  ;; XXX -- this should be in ~/.xwem/xwemrc.el
;  (add-to-list 'special-display-regexps (cons "*Help" nil))
;  (add-to-list 'special-display-regexps (cons "*Completions" nil))

(provide 'xwem-special)

;;; xwem-special.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.