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

   1 ;;; xwem-register.el --- Registers support for XWEM.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Fri Feb  6 08:04:24 MSK 2004
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-register.el,v 1.8 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 ;; Just like `register' packege for Emacs, but for XWEM.
  32 ;;
  33 ;; To start using it add:
  34 ;;
  35 ;;    (require 'xwem-register)
  36 ;;    (xwem-register-install-bindings)
  37 ;;
  38 ;; to your xwemrc.  That will add bonus bindings to `xwem-global-map',
  39 ;; such as `H-x 6' to store current window configuration to register,
  40 ;; `H-x /' to store current client to register and `H-x j' to jump to
  41 ;; register, i.e. set saved window config or pop to saved client, and
  42 ;; others.
  43
  44 ;; Idea about automatic registers belongs to Steve Youngs
  45 ;; <steve@youngs.au.com>.
  46
  47 ;;; Code:
  48 \f
  49 (require 'xwem-load)
  50 (require 'xwem-help)
  51
  52
  53 ;;; Customisation, note: uses `xwem-misc' group
  54 (defgroup xwem-registers nil
  55   "Group to customize xwem registers behaviour."
  56   :prefix "xwem-registers-"
  57   :group 'xwem-misc)
  58
  59 (defcustom xwem-registers-frame-config-no-delete t
  60   "This valued passed as NO-DELETE argument to `xwem-set-frame-configuration'."
  61   :type 'boolean
  62   :group 'xwem-registers)
  63
  64 (defcustom xwem-registers-win-config-select-frame t
  65   "*Non-nil mean, when jumping to window configuration also select
  66 frame for which config was generated.  Directly passed as
  67 SELECT-FRAME-P to `xwem-set-window-configuration'."
  68   :type 'boolean
  69   :group 'xwem-registers)
  70
  71 (defcustom xwem-registers-auto-registers
  72   '((?x (application "xemacs")))
  73   "*List of automatic registers.
  74
  75 Sample configuration:
  76
  77   (setq xwem-registers-auto-registers
  78     '((?x (application \"xemacs\"))
  79       (?m (application \"mozilla\"))))
  80 "
  81   :type '(repeat (cons (character :tag "Register")
  82                        (sexp :tag "Match expression")))
  83   :group 'xwem-registers)
  84
  85 (defcustom xwem-registers-auto-override nil
  86   "*Non-nil mean when autoregister matches and such register already
  87 exists it would override it with new value."
  88   :type 'boolean
  89   :group 'xwem-registers)
  90
  91 ;;; Internal variables
  92
  93 (defvar xwem-registers nil
  94   "XWEM registers alist.
  95 Each element in form (NAME . VALUE), one for each register.
  96 NAME is a character. VALUE is a string, number, client or a list.
  97 A list in form (XWEM-WIN-CONFIG CONFIG) represent a window
  98 configuration.")
  99
 100 (defun xwem-register-set (register value)
 101   "Set contents of XWEM register named REGISTER to VALUE.
 102 Return VALUE, see documentation for `xwem-registers' for possible VALUE."
 103   (setq xwem-registers
 104         (put-alist register value xwem-registers)))
 105
 106 (defun xwem-register-get (reg)
 107   "Return contents of XWEM register named REG, or nil if none."
 108   (cdr (assq reg xwem-registers)))
 109
 110 (defun xwem-register-del (reg)
 111   "Delete REG from registers list."
 112   (setq xwem-registers (remassq reg xwem-registers)))
 113
 114 (defun xwem-register-del-by-value (type value)
 115   "Remove all register of TYPE which has VALUE."
 116   (mapc #'(lambda (r)
 117             (when (and (eq (car (cdr r)) type)
 118                        (eq (cadr (cdr r)) value))
 119               (xwem-register-del (car r))))
 120         xwem-registers))
 121
 122 ;;;###autoload(autoload 'xwem-register-client "xwem-register" "" t)
 123 (define-xwem-command xwem-register-client (register)
 124   "Store selected client to REGISTER."
 125   (xwem-interactive "kClient to register: ")
 126   (xwem-client-set-property (xwem-cl-selected) 'register (event-key register)))
 127
 128 ;;;###autoload(autoload 'xwem-register-win-config "xwem-register" "" t)
 129 (define-xwem-command xwem-register-win-config (register)
 130   "Store window configuration in REGISTER."
 131   (xwem-interactive "kWindow Configuration to register: ")
 132
 133   (let ((reg (event-key register)))
 134     (xwem-register-set reg (list 'XWEM-WIN-CONFIG
 135                                  (xwem-window-configuration)))))
 136
 137 ;;;###autoload(autoload 'xwem-register-frame-config "xwem-register" "" t)
 138 (define-xwem-command xwem-register-frame-config (register)
 139   "Store frame configuration to REGISTER."
 140   (xwem-interactive "kFrame Configuration to register: ")
 141
 142   (let ((reg (event-key register)))
 143     (xwem-register-set reg (list 'XWEM-FRAME-CONFIG
 144                                  (xwem-frame-configuration)))))
 145
 146 ;;;###autoload(autoload 'xwem-register-jump "xwem-register" "" t)
 147 (define-xwem-command xwem-register-jump (register &optional arg)
 148   "Jump to REGISTER.
 149 If prefix ARG is supplied remove REGISTER from `xwem-registers' alist."
 150   (xwem-interactive "kJump to register: \nP")
 151
 152   (let ((reg (event-key register))
 153          rval)
 154     (if arg
 155         (xwem-register-del reg)
 156
 157       ;; Jump to REGISTER value
 158       (setq rval (xwem-register-get reg))
 159       (cond ((and (listp rval)
 160                   (eq 'XWEM-CLIENT (car rval))
 161                   (xwem-cl-p (cadr rval)))
 162              (xwem-cl-pop-to-client (cadr rval)))
 163
 164             ((and (listp rval) (eq 'XWEM-WIN-CONFIG (car rval)))
 165              (xwem-set-window-configuration
 166               (cadr rval) xwem-registers-win-config-select-frame))
 167
 168             ((and (listp rval) (eq 'XWEM-FRAME-CONFIG (car rval)))
 169              (xwem-set-frame-configuration
 170               (cadr rval) xwem-registers-frame-config-no-delete))
 171
 172             (t (xwem-message 'todo "Hanle register value: %S" rval)))
 173       )))
 174
 175 ;;;###xwem-autoload(autoload 'xwem-registers-help "xwem-registers" nil "Show info about registers.")
 176 (define-xwem-command xwem-registers-list ()
 177   "Show info about registers."
 178   (xwem-interactive)
 179
 180   (xwem-help-display "registers"
 181    (insert "Registers:\n\n")
 182    (mapc #'(lambda (r)
 183              (insert (format "  '%c'  - " (car r)))
 184              (let ((rval (cdr r)))
 185                (cond ((and (listp rval) (eq 'XWEM-CLIENT (car rval)))
 186                       (insert "CLIENT")
 187                       (let ((cl (cadr rval)))
 188                         (insert (format " / %s" (if (xwem-cl-alive-p cl)
 189                                                     "alive" "dead")))
 190                         (when (xwem-cl-alive-p cl)
 191                           (insert " / ")
 192                           (insert (xwem-client-name cl)))))
 193                      ((and (listp rval) (eq 'XWEM-WIN-CONFIG (car rval)))
 194                       (insert "WIN-CONFIG")
 195                       (let ((frame (xwem-win-config-frame (cadr rval))))
 196                         (insert (format " / %s" (if (xwem-frame-alive-p frame)
 197                                                     "alive" "dead")))
 198                         (when (if (xwem-frame-alive-p frame) "alive" "dead")
 199                           (insert (format " / [%d] " (xwem-frame-num frame)))
 200                           (insert (xwem-frame-name frame)))))
 201                      )
 202                (insert "\n")))
 203          xwem-registers)
 204    ))
 205
 206 (defun xwem-registers-remove-client (cl)
 207   "CL is dead, so remove it frome registers."
 208   (xwem-register-del-by-value 'XWEM-CLIENT cl))
 209
 210 (defun xwem-registers-auto-register (cl)
 211   "Put CL to register according to "
 212   (let ((r (car (xwem-manda-find-match-1
 213                  cl xwem-registers-auto-registers 'cdr))))
 214     (when (and r (or xwem-registers-auto-override
 215                      (not (xwem-register-get r))))
 216       (xwem-register-set r (list 'XWEM-CLIENT cl)))))
 217
 218
 219 ;;; Register as client property
 220 (defun xwem-client-set-register (cl rprop reg)
 221   "Set CL's register property RPROP to REG."
 222   ;; Remove REG from any other clients
 223   (mapc #'(lambda (ocl)
 224             (when (eq reg (xwem-cl-get-prop ocl rprop))
 225               (xwem-cl-rem-prop ocl rprop)))
 226         (xwem-clients-list))
 227
 228   ;; Save it in CL's plist
 229   (xwem-cl-put-prop cl rprop reg)
 230
 231   ;; And finally register REG
 232   (when reg
 233     (xwem-register-set reg (list 'XWEM-CLIENT cl))))
 234
 235 (define-xwem-client-property register nil
 236   "CL's register."
 237   :type 'char
 238   :set 'xwem-client-set-register)
 239
 240 \f
 241 (provide 'xwem-register)
 242
 243 ;;; On-load actions
 244 (add-hook 'xwem-cl-create-hook 'xwem-registers-auto-register)
 245 (add-hook 'xwem-cl-destroy-hook 'xwem-registers-remove-client)
 246
 247 ;;; xwem-register.el ends here