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

   1 ;;; xwem-main.el --- Main part of xwem.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: 21 Mar 2003
   7 ;; Keywords: xlib, xwem
   8 ;; X-CVS: $Id: xwem-main.el,v 1.18 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 ;; This main part of XWEM.
  32 ;;
  33 ;; I strongly recommend you to raise max-lisp-eval-depth value to say
  34 ;; 5000.
  35 ;;      (setq max-lisp-eval-depth 5000)
  36 ;;
  37 ;; Try to avoid to use such evil thing as `mouse-avoidance-mode', but
  38 ;; if you really want it, than set it to either 'banish or 'jump.
  39 ;;
  40 ;; If you want develop some xwem addons or take in touch with xwem, it
  41 ;; will be usefull to change `find-function-regexp', because xwem uses
  42 ;; its own syntax to define interactive commands.
  43
  44 ;;     (setq find-function-regexp
  45 ;;           (concat "^\\s-*(\\(def[^cgvW]\\w+\\*?"
  46 ;;                "\\|define-function"
  47 ;;                "\\|define-obsolete-function-alias"
  48 ;;                "\\|define-compatible-function-alias"
  49 ;;                "\\|define-derived-mode"
  50 ;;                "\\|define-xwem-command"
  51 ;;                "\\)\\s-+%s\\(\\s-\\|$\\)"))
  52
  53 ;; XWEM core:
  54 ;;   List of files XWEM can't live without.
  55 ;;
  56 ;;   xwem-interactive.el - Interactive stuff
  57 ;;   xwem-focus.el       - Focuses
  58 ;;   xwem-minibuffer.el  - XWEM Minibuffer.
  59 ;;   xwem-manage.el      - Manage database.
  60 ;;   xwem-keyboard.el    - Keyboard stuff.
  61 ;;   xwem-clients.el     - Clients support.
  62 ;;   xwem-win.el         - Windows.
  63 ;;   xwem-frames.el      - Frames support.
  64
  65 ;;; Code:
  66
  67 \f
  68
  69 (eval-when-compile
  70   (require 'cl))                        ;last, intersection etc
  71
  72 (require 'xwem-load)
  73 (require 'xwem-minibuffer)
  74 (require 'xwem-version)
  75
  76 (defgroup xwem nil
  77   "XWEM window manager."
  78   :prefix "xwem-"
  79   :group 'applications)
  80
  81 (defgroup xwem-hooks nil
  82   "Group to customize xwem hooks."
  83   :prefix "xwem-"
  84   :group 'xwem)
  85
  86 ;;;###autoload
  87 (defcustom xwem-dir (file-name-as-directory
  88                      (expand-file-name ".xwem" (getenv "HOME")))
  89   "Directory to store XWEM's files."
  90   :type 'directory
  91   :group 'xwem)
  92
  93 (defcustom xwem-inhibit-startup-message nil
  94   "*Non-nil mean, do not show message after successful XWEM start."
  95   :type 'boolean
  96   :group 'xwem)
  97
  98 (defcustom xwem-debug nil
  99   "*Non-nil mean run xlib and xwem in debugging mode."
 100   :type 'boolean
 101   :group 'xwem)
 102
 103 ;;;###autoload
 104 (defcustom xwem-debug-routines
 105   '(xwem-cl xwem-event xwem-frame xwem-misc xwem-root xwem-deffered xwem-tray
 106             ;; and X routines
 107             x-misc x-event x-tray x-error x-record)
 108   "Routines to debug on."
 109   :type '(set (const :tag "XWEM CLients" xwem-cl)
 110               (const :tag "XWEM Events" xwem-event)
 111               (const :tag "XWEM Frames" xwem-frame)
 112               (const :tag "XWEM Misc" xwem-misc)
 113               (const :tag "XWEM Root" xwem-root)
 114               (const :tag "XWEM Deffered calls" xwem-deffered)
 115               (const :tag "XWEM Tray" xwem-tray)
 116               (const :tag "X Misc" x-misc)
 117               (const :tag "X Event" x-event)
 118               (const :tag "X Tray" x-tray)
 119               (const :tag "X Error" x-error)
 120               (const :tag "X RECORD" x-record))
 121   :group 'xwem)
 122
 123 ;;;###xwem-autoload
 124 (defcustom xwem-commands-gc-cons-threshold 5000000
 125   "*Value of `gc-cons-threshold' to use when executing xwem commands.
 126 Make sense only if `xwem-commands-inhibit-gc' is non-nil."
 127   :type 'number
 128   :group 'xwem)
 129
 130 ;;;###xwem-autoload
 131 (defcustom xwem-commands-inhibit-gc t
 132   "*Non-nil mean that xwem interactive commands runs without GCing."
 133   :type 'boolean
 134   :group 'xwem)
 135
 136 (defcustom xwem-custom-display nil      ;"127.0.0.1:2"
 137   "*Custom display, mostly for debugging purposes."
 138   :type '(choice (const :tag "No custom display" nil)
 139                  (const "127.0.0.1:2")
 140                  (string :tag "Custom display"))
 141   :group 'xwem)
 142
 143 ;;;###autoload
 144 (defcustom xwem-load-hook nil
 145   "*Hooks to call after xwem was load."
 146   :type 'hook
 147   :group 'xwem-hooks)
 148
 149 ;;;###autoload
 150 (defcustom xwem-config-read-hook nil
 151   "*Hooks to call after xwem read config file."
 152   :type 'hook
 153   :group 'xwem-hooks)
 154
 155 ;;;###autoload
 156 (defcustom xwem-before-init-wins-hook nil
 157   "Hooks called before `xwem-init-wins'."
 158   :type 'hook
 159   :group 'xwem-hooks)
 160
 161 ;;;###autoload
 162 (defcustom xwem-after-init-wins-hook nil
 163   "Hooks called after `xwem-init-wins'."
 164   :type 'hook
 165   :group 'xwem-hooks)
 166
 167 ;;;###autoload
 168 (defcustom xwem-before-init-hook nil
 169   "Hooks to be run before xwem initialization."
 170   :type 'hook
 171   :group 'xwem-hooks)
 172
 173 ;;;###autoload
 174 (defcustom xwem-after-init-hook nil
 175   "Hooks to be runned after xwem initialisation."
 176   :type 'hook
 177   :group 'xwem-hooks)
 178
 179 (defcustom xwem-exit-hook nil
 180   "Hooks called after xwem exit."
 181   :type 'hook
 182   :group 'xwem-hooks)
 183
 184 \f
 185 ;;; Variables
 186 ;;;###autoload
 187 (defvar xwem-started nil
 188   "Non-nil when xwem started.
 189 Do not modify!")
 190
 191 \f
 192 ;;; Functions
 193 (defun xwem-initial-manage ()
 194   "Manage all visible clients.
 195 Even clients with override-redirect attribute set can be managed."
 196   (xwem-message 'init "Initializing X windows ...")
 197
 198   (run-hooks 'xwem-before-init-wins-hook)
 199
 200   (let ((wins (XQueryTree (xwem-dpy) (xwem-rootwin)))
 201         cln-wins)
 202     (setq wins (cdr (cdr (cdr (cdr wins)))))
 203
 204     (xwem-debug 'xwem-misc "IN xwem-initial-manage: wins length = %d"
 205                 '(length wins))
 206     (while wins
 207       (when (and (= (X-Attr-mapstate
 208                      (XGetWindowAttributes (xwem-dpy) (car wins)))
 209                     X-Viewable)
 210                  (not (X-Win-get-prop (car wins) 'xwem-frame)))
 211         ;; X window visible and not an XWEM frame
 212         (setq cln-wins (cons (car wins) cln-wins)))
 213       (setq wins (cdr wins)))
 214
 215     ;; Manage all visible clients
 216     (mapc 'xwem-xwin-try-to-manage (nreverse cln-wins)))
 217
 218   (run-hooks 'xwem-after-init-wins-hook)
 219   (xwem-message 'init "Initializing X windows ... done"))
 220
 221 (defun xwem-after-window-setup ()
 222   "Function which will be added to `window-setup-hook'.
 223 Called after ~/.emacs file loaded and Emacs X window subsystems
 224 initialized."
 225
 226   (run-hooks 'xwem-before-init-hook)
 227
 228   (let ((dfen (or xwem-custom-display (getenv "DISPLAY"))))
 229     (xwem-init-root
 230      (if (eq (aref dfen 0) ?\:)
 231          (concat "127.0.0.1" dfen)
 232        dfen)))
 233
 234   ;; Debugging? yes
 235   (when xwem-debug
 236     (setf (X-Dpy-log-buffer (xwem-dpy)) "*xwem-debug*")
 237     (X-Dpy-set-log-routines (xwem-dpy) xwem-debug-routines))
 238
 239   ;; Mark as started
 240   (setq xwem-started t)
 241
 242   ;; Initialize misc stuff
 243   (xwem-misc-init)
 244   ;; Create initial frames
 245   (xwem-frames-init)
 246
 247   ;; Handle all X clients
 248   (xwem-initial-manage)
 249
 250   ;; Now xwem is fully intialized and it is time to run hooks
 251   (run-hooks 'xwem-after-init-hook)
 252
 253   ;; If the user is being tricky with $XWEM_RUNNING variable, set it
 254   ;; to "yes"
 255   (when (getenv "XWEM_RUNNING")
 256     (setenv "XWEM_RUNNING" "yes"))
 257
 258   (XSync (xwem-dpy))
 259
 260   (unless xwem-inhibit-startup-message
 261     (xwem-message
 262      'asis (concat (xwem-logo-string)
 263                    " succesfully started. Start with `"
 264                    (substitute-command-keys
 265                     "\\<xwem-global-map>\\[xwem-help-prefix]") "'."))))
 266
 267 (defcustom xwem-use-presetup t
 268   "*When non-nil, us things that normally should be in xwemrc."
 269   :type 'boolean
 270   :group 'xwem)
 271
 272 ;;; Internal variables
 273
 274 ;;;###autoload
 275 (defun xwem-init ()
 276   "Initialization of xwem subsystems."
 277   (setq inhibit-startup-message t)      ; DO NOT REMOVE
 278
 279   (when xwem-use-presetup
 280     (setq allow-deletion-of-last-visible-frame t
 281           auto-lower-frame t)
 282
 283     ;; Yes, do it --ignotus
 284     (let ((xwem-max-specdpl 10000)
 285           (xwem-max-lisp-eval-depth 10000))
 286       (when (< max-specpdl-size xwem-max-specdpl)
 287         (setq max-specpdl-size xwem-max-specdpl))
 288       (when (< max-lisp-eval-depth xwem-max-lisp-eval-depth)
 289         (setq max-lisp-eval-depth xwem-max-lisp-eval-depth)))
 290
 291     ;; Destroy XEmacs frame when killing dedicated buffer
 292     (defadvice kill-buffer (before delete-dedicated-frame activate)
 293       "Work around dedicated frame problem."
 294       (let ((frame (buffer-dedicated-frame
 295                     (get-buffer (or (ad-get-arg 0) (current-buffer))))))
 296         (when (framep frame)
 297           (delete-frame frame))))
 298
 299     ;; When XEmacs frame deselects, select xwem minibuffer
 300     (add-hook 'deselect-frame-hook
 301               #'(lambda ()
 302                   (unless (eq (xwem-minib-frame xwem-minibuffer)
 303                               (selected-frame))
 304                     (select-frame (xwem-minib-frame xwem-minibuffer)))))
 305
 306     ;; Raise/lower minibuffer
 307     (add-hook 'xwem-minibuffer-focusin-hook 'xwem-minib-focusin-autoraise)
 308     (add-hook 'xwem-minibuffer-focusout-hook 'xwem-minib-focusout-autolower)
 309
 310     ;; Generic managing model
 311     (require 'xwem-clgen)
 312     ;; Use nice tabber for frames
 313     (require 'xwem-tabbing)
 314     ;; Transient-for clients support
 315     (require 'xwem-transient)
 316     ;; Support netwm stuff
 317     (require 'xwem-netwm))
 318
 319   ;; Load default keys definitions
 320   (require 'xwem-keydefs)
 321 ;  (load "xwem-keydefs")
 322
 323   ;; read configuration
 324   (let ((cfg (expand-file-name "xwemrc.el" xwem-dir)))
 325     (if (file-exists-p cfg)
 326         (load cfg)
 327       (xwem-message 'warning "Configuration file `%s' does not exists" cfg)))
 328
 329   ;; Config just readed, so run hooks
 330   (run-hooks 'xwem-config-read-hook)
 331
 332   (add-hook 'window-setup-hook 'xwem-after-window-setup)
 333   (add-hook 'kill-emacs-hook 'xwem-fini t)
 334   )
 335
 336 ;;;###autoload(autoload 'xwem-fini "xwem-main" nil t)
 337 (define-xwem-command xwem-fini ()
 338   "Fini all subsystems."
 339   (xwem-interactive)
 340 ;  (xwem-kbd-quit)
 341 ;  (xwem-frames-fini)
 342 ;  (xwem-fini-clients)
 343
 344   ;; Finally run exit hooks
 345   (run-hooks 'xwem-exit-hook)
 346
 347   ;; Remove XWEM_RUNNING environment variable if it is set
 348   (when (getenv "XWEM_RUNNING")
 349     (setenv "XWEM_RUNNING" nil 'unset))
 350
 351   ;; And close display
 352   (xwem-fini-root)
 353   )
 354
 355 \f
 356 (provide 'xwem-main)
 357
 358 ;;; xwem-main.el ends here