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

   1 ;;; xwem-recover.el --- Autorecovery tool for xwem.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Sat Sep 11 23:20:23 GMT 2004
   7 ;; Keywords: xlib, xwem
   8 ;; X-CVS: $Id: xwem-recover.el,v 1.2 2005-04-04 19:54:15 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 ;; Sometimes xlib desyncronises with X server.  In such circumstatces
  32 ;; only restarting helps.  This tool tries to recover xlib from
  33 ;; desyncronisation.  Desync may occur because XEmacs can block
  34 ;; whenever he want, and there no visible way to control it.
  35
  36 ;; xwem-recover installs x error hooks and if many x errors occurs in
  37 ;; a little time it starts recovering routines.
  38
  39 ;; Any time you are feeling that something wrong, you can use
  40 ;; `xwem-recover-do-recover' command to force recovering.
  41
  42 ;;; Code:
  43 \f
  44 (require 'xwem-load)
  45
  46 (defgroup xwem-recover nil
  47   "Group to customize xwem recovering tool."
  48   :prefix "xwem-recover-"
  49   :group 'xwem)
  50
  51 (defcustom xwem-recover-parameter '(12 . 3)
  52   "*How many errors allowed without recovering.
  53 car specifies number of errors, cdr specifies time in seconds."
  54   :type '(cons number number)
  55   :group 'xwem-recover)
  56
  57 ;;; Internal variables
  58
  59 (defvar xwem-recover-mode nil
  60   "Non-nil mean we are in recovering mode.
  61 Use `xwem-recover-turn-on', `xwem-recover-turn-off' and
  62 `xwem-recover-toggle' to change mode.")
  63
  64 (defvar xwem-recover-errors nil
  65   "List of times when X error occurs.
  66 Internal variable.")
  67
  68 \f
  69 (define-xwem-deffered xwem-recover-real-recover ()
  70   "Do real recovering routines."
  71   (setf (X-Dpy-snd-queue (xwem-dpy)) nil)
  72   (setf (X-Dpy-message-buffer (xwem-dpy)) "")
  73   (setf (X-Dpy-evq (xwem-dpy)) nil))
  74
  75 ;;;###autoload(autoload 'xwem-recover-do-recover "xwem-recover" "" t)
  76 (define-xwem-command xwem-recover-do-recover (xdpy)
  77   "Recover XDPY from desyncronisation with X server."
  78   (xwem-interactive (list (xwem-dpy)))
  79
  80   (flet ((old-x-dpy-filter (proc out)))
  81     (fset 'old-x-dpy-filter (symbol-function 'X-Dpy-filter))
  82     (flet ((X-Dpy-filter (proc out)
  83              ;; Skip any data on XDPY, but continue processing on
  84              ;; other displays.
  85              (unless (eq (X-Dpy-proc xdpy) proc)
  86                (old-x-dpy-filter proc out))))
  87       (while (accept-process-output (X-Dpy-proc xdpy) 2))
  88
  89       ;; At this point all pending readed, so do cleanup things.  This
  90       ;; is not 100% will work.  In some circumstances this will only
  91       ;; add problems.
  92       (xwem-recover-real-recover)
  93       )))
  94
  95 (defun xwem-recover-xerr-hook (xdpy xerr)
  96   "Called when on display XDPY X error XERR occured.
  97 Check excedance of `xwem-recover-parameter' and if it seems like xlib
  98 got desyncronised with X server, start recovering routines."
  99
 100   (let ((ct (current-time)))
 101     (setq xwem-recover-errors (nreverse xwem-recover-errors))
 102     (while (and xwem-recover-errors
 103                 (> (itimer-time-difference ct (car xwem-recover-errors))
 104                    (cdr xwem-recover-parameter)))
 105       (setq xwem-recover-errors (cdr xwem-recover-errors)))
 106     (setq xwem-recover-errors
 107           (cons ct (nreverse xwem-recover-errors)))
 108
 109     ;; Check (car xwem-recover-errors) is not exceeded
 110     (when (or (> (length xwem-recover-errors) (car xwem-recover-parameter))
 111               ;; Also recover when error code isn't recognized
 112               (not (memq (X-Event-xerror-code xerr)
 113                          '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 128 255))))
 114       (xwem-message 'alarm "Recovering from desyncronisation .. (errors = %d)\n"
 115                     (length xwem-recover-errors))
 116       (xwem-recover-do-recover xdpy))
 117     ))
 118
 119 ;;;###autoload(autoload 'xwem-recover-turn-on "xwem-recover" "" t)
 120 (define-xwem-command xwem-recover-turn-on ()
 121   "Enable xwem recovering mode."
 122   (xwem-interactive)
 123
 124   (unless xwem-recover-mode
 125     (pushnew 'xwem-recover-xerr-hook (X-Dpy-error-hooks (xwem-dpy)))
 126     (setq xwem-recover-mode t)))
 127
 128 ;;;###autoload(autoload 'xwem-recover-turn-off "xwem-recover" "" t)
 129 (define-xwem-command xwem-recover-turn-off ()
 130   "Turn off xwem recovering mode."
 131   (xwem-interactive)
 132
 133   (when xwem-recover-mode
 134     (setf (X-Dpy-error-hooks (xwem-dpy))
 135           (delq 'xwem-recover-xerr-hook (X-Dpy-error-hooks (xwem-dpy))))
 136     (setq xwem-recover-mode nil)))
 137
 138 ;;;###autoload(autoload 'xwem-recover-toggle "xwem-recover" "" t)
 139 (define-xwem-command xwem-recover-toggle (arg)
 140   "Toggle xwem recovering mode.
 141 With positive ARG turn it on, with negative turn it off.
 142 If ARG is ommited - toggle it."
 143   (xwem-interactive "P")
 144
 145   (cond ((null arg)
 146          (if xwem-recover-mode
 147              (xwem-recover-turn-off)
 148            (xwem-recover-turn-on)))
 149         ((< (prefix-numeric-value arg) 0)
 150          (xwem-recover-turn-off))
 151         (t (xwem-recover-turn-on))))
 152
 153 \f
 154 (provide 'xwem-recover)
 155
 156 ;;; xwem-recover.el ends here