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

   1 ;;; xwem-keymacro.el --- Recording/playing keyboard macros.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Fri Dec 12 17:18:00 MSK 2003
   8 ;; Keywords: xwem, xlib
   9 ;; X-CVS: $Id: xwem-keymacro.el,v 1.11 2005-04-04 19:54:13 lg Exp $
  10
  11 ;; This file is part of XWEM.
  12
  13 ;; XWEM is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26 ;; 02111-1307, USA.
  27
  28 ;;; Synched up with: Not in FSF
  29
  30 ;;; Commentary:
  31
  32 ;; XWEM uses Record X extension to collect keypresses when saving
  33 ;; keyboard macros, this method is tranparent to user and allow
  34 ;; catching events without need of keyboard grabbing.
  35
  36 ;; XWEM keyboard macro is the same as Emacs keyboard macro.  It is a
  37 ;; vector of Emacs events.  XWEM uses special keymap -
  38 ;; `xwem-user-macros-map' to hold user defined macros.  This keymap
  39 ;; used to save/restore keyboard macros across XWEM sessions.
  40
  41 ;; XWEM's support for keyboard macros is full-featured.  It includes
  42 ;; H-x q command to start recursive edition, command which allow to
  43 ;; change keyboard macro execution on fly.  It has workaround Emacs
  44 ;; blocking, when Emacs enters minibuffer and block waiting for user
  45 ;; input, keyboard macro execution stops (deadlock! Emacs can't send
  46 ;; further input, because it waiting for this input), but when Emacs
  47 ;; is about to block, i.e. enter `read-from-minibuffer' XWEM installs
  48 ;; special itimer which track Emacs state and send next event if need.
  49 ;; This feature allow you to create keyboard macros which requires
  50 ;; interaction with user, for example 'H-x r xterm RET H-u H-z H-x b
  51 ;; emac RET'.  When defining keyboard macro remember that XWEM can't
  52 ;; track window operations such as map, configure, destroy and others,
  53 ;; so please use `xwem-misc-pause' command(default binded to H-z to
  54 ;; sleep for a while).  For example you need to define macro - 1)
  55 ;; start new xterm 2) in newly managed xterm enter "test it" text.  It
  56 ;; will be something like: H-x ( H-a x H-u H-z test it H-x ), because
  57 ;; when you start new xterm application it does not appear on screen
  58 ;; immediately, but when executing keyboard macro all keystrokes are
  59 ;; sent to X server as fast as possible.
  60
  61 ;; To save keyboard macros on on exit add something like:
  62 ;;
  63 ;;    (add-hook 'xwem-exit-hook 'xwem-keymacro-save-macros)
  64 ;;
  65 ;; And to restore saved keyboard macros on start do next:
  66 ;;
  67 ;;    (add-hook 'xwem-after-init-hook 'xwem-keymacro-load-macros)
  68 ;;
  69
  70 ;;; Code:
  71 \f
  72
  73 (require 'xlib-xtest)
  74 (require 'xlib-xrecord)
  75
  76 (require 'xwem-load)
  77 (require 'xwem-misc)
  78
  79 \f
  80 ;; Macros customization
  81 (defcustom xwem-keymacro-minib-bg "gray60"
  82   "*Background color for xwem's minibuffer while recording KBD macro.
  83 If nil - background will not change."
  84   :type 'color
  85   :group 'xwem-keyboard)
  86
  87 (defcustom xwem-keymacro-debug nil
  88   "*Non-nil mean run keyboard macrosing stuff in debug mode."
  89   :type 'boolean
  90   :group 'xwem-keyboard)
  91
  92 (defcustom xwem-keymacro-show-macro nil
  93   "*Non-nil mean show keyboard macro in minibuffer, while executing."
  94   :type 'boolean
  95   :group 'xwem-keyboard)
  96
  97 (defcustom xwem-keymacro-macrofile "xwem-macros.el"
  98   "*Default filename where keyboard macros stores."
  99   :type 'file
 100   :group 'xwem-keyboard)
 101
 102 ;;; Internal variables
 103
 104 \f
 105 ;;; Macros recording/playing internal variables
 106 ;;;###xwem-autoload
 107 (defvar xwem-keymacro-macros-stack nil
 108   "List of defined keyboard macroses.")
 109
 110 (defvar xwem-keymacro-macros-depth nil
 111   "Current depth of keyboard macro execution.
 112 INTERNAL VARIABLE.")
 113
 114 (defvar xwem-keymacro-default-command 'xwem-keymacro-default
 115   "Default command while recording/playing macro.
 116 NOTE: may be changed to play macro.")
 117
 118 (defvar xwem-keymacro-prefix-arg nil
 119   "Value of `xwem-prefix-arg' when entering macro recording.
 120 Internal variable, do not modify directly.")
 121
 122 (defvar xwem-keymacro-minib-old-bg nil
 123   "Variable used to hold old backgroup of xwem's minibuffer.
 124 Internal variable, do not modify directly.")
 125
 126 (defvar xwem-keymacro-saving nil
 127   "Non-nil mean that we saving macro now.
 128 Internal variable, do not modify it directly.")
 129 (defvar xwem-keymacro-dpy nil
 130   "Display used as data connection.
 131 Internal variable, do not modify it directly.")
 132 (defvar xwem-keymacro-rcontext nil
 133   "Record context used when keymacrosing.
 134 Internal variable, do not modify it directly.")
 135 (defvar xwem-keymacro-rclient nil
 136   "Client used when keymacrosing.
 137 Internal variable, do not modify it directly.")
 138 (defvar xwem-keymacro-rranges nil
 139   "Record ranges used when keymacrosing.
 140 Internal variable, do not modify it directly.")
 141
 142 (defvar xwem-keymacro-initialized nil
 143   "Non-nil when keyboard macrosing initialized.
 144 Internal variable, do not modify it directly.")
 145
 146 (defun xwem-keymacro-init ()
 147   "Initialize keyboard macrosing stuff."
 148   (pushnew '(macro "Macro") xwem-messages-label-prefixes)
 149
 150   ;; Use xlib-xrecord extension to intercept KeyPress/KeyRelease
 151   ;; events.
 152   (let ((xrec-ext (X-XRecordQueryVersion (xwem-dpy)))
 153         (xtest-ext (XQueryExtension (xwem-dpy) "XTEST")))
 154     (when (or (null (car xrec-ext))
 155               (null (car xtest-ext)))
 156       ;; No XRECORD or XTEST extension support
 157       (error 'xwem-error "RECORD or XTEST extension missing"))
 158
 159     ;; (xwem-dpy) supports XRECORD extension
 160     (setq xwem-keymacro-rcontext (make-X-RecordContext
 161                                   :dpy (xwem-dpy)
 162                                   :id (X-Dpy-get-id (xwem-dpy))))
 163     (setq xwem-keymacro-rranges
 164           ;; We are only interested in KeyPrees/KeyRelease events
 165           (list (make-X-RecordRange
 166                  :device-events (cons X-KeyPress X-KeyRelease))))
 167
 168     (setq xwem-keymacro-rclient (float X-XRecordAllClients))
 169     (setq xwem-keymacro-rcontext (X-XRecordCreateContext
 170                                   (xwem-dpy) xwem-keymacro-rcontext 0
 171                                   (list xwem-keymacro-rclient)
 172                                   xwem-keymacro-rranges))
 173     (X-XRecordRegisterClients (xwem-dpy) xwem-keymacro-rcontext 0
 174                               (list xwem-keymacro-rclient)
 175                               xwem-keymacro-rranges)
 176
 177     (setq xwem-keymacro-dpy (XOpenDisplay
 178                              (format "%s:%d" (X-Dpy-name (xwem-dpy))
 179                                      (X-Dpy-default-screen (xwem-dpy)))))
 180     (when xwem-keymacro-debug
 181       (setf (X-Dpy-log-buffer xwem-keymacro-dpy) "XREC.log"))
 182
 183     (setq xwem-keymacro-initialized t)))
 184
 185 (defun xwem-keymacro-extract (xevs &optional cutlen)
 186   "Extract keyboard macro from X-Events list XEVS.
 187 Return list of Emacs events.
 188 CUTLEN is how many events cut from the end (default is 1)."
 189   (let ((evs (butlast (xwem-xevents->emacs-events xevs nil)
 190                       (or cutlen 1))))
 191     (key-sequence-list-description (vconcat evs))))
 192
 193 ;;;###xwem-autoload
 194 (defun xwem-keymacro-executing-p ()
 195   "Return non-nil if executing keyboard macro."
 196   (and (boundp 'xwem-keymacro-keys)
 197        (boundp 'xwem-keymacro-keys-index)))
 198
 199 ;;;###xwem-autoload
 200 (defun xwem-keymacro-execute-keys (keys)
 201   "Execute keyboard macro KEYS."
 202   ;; XXX Adjust KEYS in case KEYS is 'self-insert
 203   (when (and (> (length keys) 1)
 204              (eq (aref keys 0) 'self-insert))
 205     (setq keys (vector keys)))
 206
 207   (let ((xwem-keymacro-keys keys)
 208         (xwem-keymacro-keys-index 0))
 209     (while (< xwem-keymacro-keys-index (length xwem-keymacro-keys))
 210       (xwem-dispatch-command-event
 211        (aref xwem-keymacro-keys xwem-keymacro-keys-index))
 212       (incf xwem-keymacro-keys-index))))
 213
 214 (defun xwem-keymacro-start-recording ()
 215   "Start recording Keys."
 216   ;; Clear events queue and enable context
 217   (setf (X-Dpy-evq xwem-keymacro-dpy) nil)
 218   (X-XRecordEnableContext xwem-keymacro-dpy xwem-keymacro-rcontext)
 219   (setq xwem-keymacro-saving t)
 220
 221   ;; Change xwem's minibuffer background
 222   (when xwem-keymacro-minib-bg
 223     (setq xwem-keymacro-minib-old-bg
 224           (face-background-name 'default (xwem-minib-frame xwem-minibuffer)))
 225     (set-face-property 'default 'background xwem-keymacro-minib-bg
 226                        (xwem-minib-frame xwem-minibuffer))))
 227
 228 (defun xwem-keymacro-stop-recording ()
 229   "Stop recording Keys."
 230   (X-XRecordDisableContext (xwem-dpy) xwem-keymacro-rcontext)
 231   (XFlush (xwem-dpy))
 232   (setq xwem-keymacro-saving nil)
 233
 234   ;; Change xwem's minibuffer background back
 235   (when xwem-keymacro-minib-old-bg
 236     (set-face-property 'default 'background xwem-keymacro-minib-old-bg
 237                        (xwem-minib-frame xwem-minibuffer))))
 238
 239 ;;;###autoload(autoload 'xwem-keymacro-begin "xwem-keymacro" nil t)
 240 (define-xwem-command xwem-keymacro-begin (arg)
 241   "Start to record keyboard macro.
 242 If used with prefix ARG, then query for bind after macro define."
 243   (xwem-interactive "P")
 244
 245   (when (not xwem-keymacro-initialized)
 246     (error 'xwem-error "Keyboard macros not initialized, use `xwem-keymacro-init'"))
 247
 248   (if xwem-keymacro-saving
 249       (xwem-message 'warning "Already defining macro...")
 250
 251     (xwem-message 'macro "Defining KBD macro ...")
 252     (setq xwem-keymacro-prefix-arg arg)
 253     (xwem-keymacro-start-recording)))
 254
 255 ;;;###autoload(autoload 'xwem-keymacro-end "xwem-keymacro" nil t)
 256 (define-xwem-command xwem-keymacro-end (arg)
 257   "Stop recording keyboard macro.
 258 If recording done with prefix argument, then query for key to bind."
 259   (xwem-interactive (list xwem-keymacro-prefix-arg))
 260
 261   (if (not xwem-keymacro-saving)
 262       (xwem-message 'warning "Not recording KBD macro.")
 263
 264     ;; Wait last keyrelease, so `xwem-keymacro-extract' will cut keys
 265     ;; properly.
 266     (when (= (X-Event-type xwem-last-xevent) X-KeyPress)
 267       (xwem-kbd-wait-key-release (X-Event-xkey-keycode xwem-last-xevent)))
 268
 269     (xwem-keymacro-stop-recording)
 270     (let ((kmacro (xwem-keymacro-extract (X-Dpy-evq xwem-keymacro-dpy)
 271                                          (length xwem-this-command-keys))))
 272       (if (not xwem-keymacro-prefix-arg)
 273           ;; Save last keyboard macro
 274           (push kmacro xwem-keymacro-macros-stack)
 275
 276         (let ((key (xwem-read-key "Enter character to bind: ")))
 277           (define-key 'xwem-user-macros-prefix (events-to-keys (vector key)) kmacro))))
 278
 279     (xwem-message 'macro "KBD macro defined.")))
 280
 281 ;;;###xwem-autoload
 282 (defun xwem-keymacro-internal-play (keys &optional times)
 283   "Play Emacs KEYS TIMES times."
 284   (unless times (setq times 1))
 285
 286   ;; Unset some variables
 287   (setq xwem-this-command-keys [])
 288   (setq xwem-kbd-now-grabbing nil)
 289   (setq xwem-prefix-arg nil)
 290
 291   (when xwem-keymacro-show-macro
 292     (xwem-message 'macro "Executing macro: '%s'%s"
 293                   (key-description keys)
 294                   (if (> times 1)
 295                       (format " %d times" times)
 296                     "")))
 297
 298   ;; Force release of modifiers
 299   (xwem-kbd-force-mods-release)
 300
 301   ;; Execute KEYS TIMES times
 302   (dotimes (i times)
 303     (xwem-keymacro-execute-keys keys)))
 304
 305 ;; Commands to be used in `xwem-keymacro-user-macros'
 306 ;;;###autoload(autoload 'xwem-keymacro-undefined "xwem-keymacro" nil t)
 307 (define-xwem-command xwem-keymacro-undefined ()
 308   "Undefined macro command."
 309   (xwem-interactive)
 310
 311   (xwem-message 'warning "Macro key `%s' is not defined"
 312                 (key-description xwem-this-command-keys)))
 313
 314 ;;;###autoload(autoload 'xwem-keymacro-play-last "xwem-keymacro")
 315 (define-xwem-command xwem-keymacro-play-last (arg)
 316   "Play last KBD macro ARG times."
 317   (xwem-interactive "*_p")
 318
 319   (when (null xwem-keymacro-macros-stack)
 320     (error 'xwem-error "No KBD macros defined"))
 321
 322   (if (null xwem-keymacro-macros-depth)
 323       (setq xwem-keymacro-macros-depth 0)
 324     (when (>= xwem-keymacro-macros-depth
 325               (1- (length xwem-keymacro-macros-stack)))
 326       (error 'xwem-error (format "Can't play macro of %d depth"
 327                                  (1+ xwem-keymacro-macros-depth))))
 328     (incf xwem-keymacro-macros-depth))
 329
 330   (xwem-unwind-protect
 331       (xwem-keymacro-internal-play
 332        (nth xwem-keymacro-macros-depth xwem-keymacro-macros-stack) arg)
 333
 334     (if (zerop xwem-keymacro-macros-depth)
 335         (setq xwem-keymacro-macros-depth nil)
 336       (decf xwem-keymacro-macros-depth))))
 337
 338 ;;;###autoload(autoload 'xwem-keymacro-recursive-edit "xwem-keymacro" nil t)
 339 (define-xwem-command xwem-keymacro-recursive-edit (arg)
 340   "Enter recursive edit.
 341 Using \\<xwem-global-map>\\[xwem-keymacro-recursive-edit] you can
 342 change keyboard macro execution in different way, i.e. you can
 343 temporary suspend macro execution.  Use
 344 \\<xwem-global-map>\\[xwem-exit-recursive-edit] to exit recursive
 345 edit."
 346   (xwem-interactive "_P")
 347
 348   (or (xwem-keymacro-executing-p)
 349       xwem-keymacro-saving
 350       (error 'xwem-error "Not defining or executing keyboard macro"))
 351
 352   (let ((xwem-this-command-keys [])
 353        (xwem-prefix-arg nil))
 354
 355     (unless (xwem-keymacro-executing-p)
 356       (X-XRecordDisableContext (xwem-dpy) xwem-keymacro-rcontext))
 357
 358     (xwem-recursive-edit)
 359
 360     (unless (xwem-keymacro-executing-p)
 361       (X-XRecordEnableContext xwem-keymacro-dpy xwem-keymacro-rcontext))
 362     ))
 363
 364 ;;;###autoload(autoload 'xwem-keymacro-exit-recursive-edit "xwem-keymacro" nil t)
 365 (define-xwem-command xwem-keymacro-exit-recursive-edit ()
 366   "Exit recursive edition."
 367   (xwem-interactive "*")
 368
 369   ;; XXX
 370   (when (xwem-keymacro-executing-p)
 371     (xwem-kbd-force-mods-release))
 372
 373   (xwem-exit-recursive-edit))
 374
 375 ;;;###autoload
 376 (defun xwem-keymacro-save-macros (&optional file)
 377   "Save all defined macros to FILE.
 378 Default value for FILE is ~/.xwem/xwem-macros.el."
 379   (let ((buf (get-buffer-create " * temp keymacro buffer *")))
 380     (with-current-buffer buf
 381       (erase-buffer)
 382
 383       (map-keymap #'(lambda (kseq fbind)
 384                       (when (vectorp fbind)
 385                         (insert (format "(define-key 'xwem-user-macros-prefix '%S %S)\n" kseq fbind))))
 386                   (xwem-kbd-fixup-keymap 'xwem-user-macros-prefix))
 387
 388       (write-file (or file (expand-file-name xwem-keymacro-macrofile xwem-dir)))
 389       (kill-buffer buf))))
 390
 391 ;;;###autoload
 392 (defun xwem-keymacro-load-macros (&optional file)
 393   "Load macros saved with `xwem-key-save-macros' from FILE.
 394 Default value for FILE is ~/.xwem/xwem-macros.el"
 395   (load (or file (expand-file-name xwem-keymacro-macrofile xwem-dir))))
 396
 397 \f
 398 (provide 'xwem-keymacro)
 399
 400 ;;; On-load actions
 401 (if xwem-started
 402     (xwem-keymacro-init)
 403   (add-hook 'xwem-keyboard-init-hook 'xwem-keymacro-init))
 404
 405 ;;; xwem-keymacro.el ends here