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

   1 ;;; xwem-edmacro.el --- Keyboard macro editor for XWEM.
   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 11:19:50 MSK 2003
   8 ;; Keywords: xwem, xlib
   9 ;; X-CVS: $Id: xwem-edmacro.el,v 1.9 2005-04-04 19:54:11 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 ;; Macro editing package.  Allow you to edit XWEM keyboard macros like
  33 ;; `edmacro' allow you to edit Emacs keyboard macros.  Uses xwem
  34 ;; special frame, so you can edit keyboard macro from any point.
  35
  36 ;; You might change `xwem-edmacro-can-edit-unbinded' to non-nil to
  37 ;; allow edition of non-macro keys.
  38
  39 ;;; Code:
  40 \f
  41 (eval-and-compile
  42   (require 'edmacro))
  43
  44 (require 'xwem-load)
  45 \f
  46 ;;; Customization
  47 (defgroup xwem-edmacro nil
  48   "Group to customize `xwem-edmacro' addon."
  49   :prefix "xwem-edmacro-"
  50   :group 'xwem-keyboard)
  51
  52 (defcustom xwem-edmacro-can-edit-unbinded t
  53   "*Non-nil mean that `xwem-edmacro' allows edit unbinded keys."
  54   :type 'boolean
  55   :group 'xwem-edmacro)
  56
  57 (defcustom xwem-edmacro-can-edit-nonmacro nil
  58   "*Non-nil allow you to edit keys binded to non-macro commands.
  59 USE WITH CAUTION, if this variable is non-nil you can override any
  60 binding in `xwem-global-map'!"
  61   :type 'boolean
  62   :group 'xwem-edmacro)
  63
  64 ;;; Internal variables
  65
  66 ;; Variables
  67 (defvar xwem-edmacro-prefix-arg nil
  68   "Value of prefix argument.
  69 Internal variable, do not modify.")
  70
  71 (defvar xwem-edmacro-store-place nil
  72   "Place where to store new keyboard macro after editing.
  73 Internal variable, do not use.")
  74
  75 \f
  76 ;; Functions
  77 (defun xwem-edmacro-store (mac)
  78   "Store new keyboard macro MAC."
  79   (setq mac (key-sequence-list-description mac))
  80   (cond ((eq xwem-edmacro-store-place 'xwem-keymacro-macros-stack)
  81          (if xwem-keymacro-macros-stack
  82              (setcar xwem-keymacro-macros-stack mac)
  83            (setq xwem-keymacro-macros-stack (list mac)))
  84          (xwem-message 'info "New keymacro stored to `%S'"
  85                        xwem-edmacro-store-place))
  86
  87         (t
  88          ;; redefine key in user macros map
  89          (define-key xwem-global-map xwem-edmacro-store-place mac)))
  90
  91   (setq xwem-edmacro-store-place nil))
  92
  93 (defun xwem-edmacro-finish (frame)
  94   "Called when edmacro finishes.
  95 FRAME is special emacs frame where macro editing occurs.
  96 Keep selected buffer to be selected even after FRAME deleted."
  97   (let ((buf (current-buffer)))
  98     (if (frame-live-p frame)
  99         (delete-frame frame t)
 100       (xwem-special-revert-focus nil))
 101     (set-buffer buf)))
 102
 103 ;;;###autoload(autoload 'xwem-edmacro-edit-kbd-macro "xwem-edmacro" "" t)
 104 (define-xwem-command xwem-edmacro-edit-kbd-macro (xwem-keys &optional arg)
 105   "Edit XWEM keyboard macro specified by XWEM-KEYS.
 106 With a prefix ARG, format the macro in a more concise way."
 107   (xwem-interactive
 108    (list
 109     (xwem-read-key-sequence
 110      (substitute-command-keys
 111       (concat "Enter `\\<xwem-global-map>\\[xwem-keymacro-play-last]' "
 112               "or one of `\\<xwem-global-map>\\[xwem-user-macros-prefix] XXX': ")))
 113     (prefix-numeric-value xwem-prefix-arg)))
 114
 115   (xwem-kbd-stop-grabbing)
 116
 117   (let ((xwem-cmd (xwem-kbd-get-binding xwem-keys nil t))
 118         xwem-evs frame)
 119
 120     (setq xwem-evs (cond ((eq xwem-cmd 'xwem-keymacro-play-last)
 121                           (setq xwem-edmacro-store-place
 122                                 'xwem-keymacro-macros-stack)
 123                           (or (car xwem-keymacro-macros-stack) []))
 124
 125                          ((vectorp xwem-cmd)
 126                           (setq xwem-edmacro-store-place xwem-keys)
 127                           xwem-cmd)
 128
 129                          ((and xwem-edmacro-can-edit-unbinded (null xwem-cmd))
 130                           (setq xwem-edmacro-store-place xwem-keys)
 131                           [])
 132
 133                          (xwem-edmacro-can-edit-nonmacro
 134                           (setq xwem-edmacro-store-place xwem-keys)
 135                           [])
 136
 137                          (t nil)))
 138
 139     (if (null xwem-evs)
 140         (cond ((and (not xwem-edmacro-can-edit-unbinded) (null xwem-cmd))
 141                (xwem-message 'warning
 142                              (concat "Dissalowed to edit unbinded key "
 143                                      (key-description xwem-keys)
 144                                      " by `xwem-edmacro-can-edit-unbinded'")))
 145               ((not xwem-edmacro-can-edit-nonmacro)
 146                (xwem-message 'warning
 147                              (concat "Dissalowed to edit non-macro key "
 148                                      (key-description xwem-keys)
 149                                      " by `xwem-edmacro-can-edit-nonmacro'.")))
 150               (t (xwem-message 'warning "Invalid keyboard macro given.")))
 151
 152       ;; XXX
 153       (when xwem-edmacro-store-place
 154         (setq frame (xwem-special-popup-frame
 155                      (get-buffer-create "*Edit Macro*") t))
 156
 157         ;; Add some info in *Edit Macro* buffer
 158         (let ((edmacro-format-hook
 159                #'(lambda ()
 160                    (save-excursion
 161                      (re-search-backward "Macro:")
 162                      (previous-line 1)
 163                      (insert (format "\n;; Key: %s\n"
 164                                      (key-description xwem-keys)))
 165                      (insert (format ";; Type: %s\n"
 166                                      (if xwem-cmd
 167                                          (if (vectorp xwem-cmd)
 168                                              "binded macro"
 169                                            "binded command")
 170                                        "unbinded")))
 171                      (when (not (vectorp xwem-cmd))
 172                        (insert (format ";; Cmd: %S\n" xwem-cmd)))))))
 173
 174           ;; edmacro.el has a bug, it dos not understand self-insert
 175           ;; in list form, i.e. does not recognize space in [(?a)
 176           ;; (space) (?b)] as special("SPC") form.  Problem in
 177           ;; `edmacro-format-keys'.
 178           ;;
 179           ;; We adjust xwem-evs to avoid such things.
 180           (setq xwem-evs
 181                 (mapvector #'(lambda (k)
 182                                (if (and (listp k)
 183                                         (= (length k) 1))
 184                                    (car k)
 185                                  k))
 186                            xwem-evs))
 187
 188           ;; Start edmacro
 189           (edit-kbd-macro xwem-evs arg
 190                           `(lambda () (xwem-edmacro-finish ,frame))
 191                           'xwem-edmacro-store)))
 192       )))
 193
 194 \f
 195 (provide 'xwem-edmacro)
 196
 197 ;;; xwem-edmacro.el ends here