;; macros.jl -- emacs-style keyboard macros for sawfish
;;
;; Author: Mark Triggs <mst@dishevelled.net>
;;

(require 'sawfish.wm.util.keymap)

(defvar *start-recording* "Super-(")
(defvar *stop-recording* "Super-)")
(defvar *play-macro* "Super-SPC")
(defvar *bind-macro* "Super-@")
(defvar *last-kbd-macro* nil)

(defun record-macro ()
  "Record a new emacs-style keyboard macro"
  (setq *last-kbd-macro*
        (let* ((delimit (lambda (list sep) (mapconcat identity list sep)))
               (prompt (lambda (&optional events)
                         (format nil
                                 "%sHit next key or press '%s' to end macro"
                                 (if events
                                     (concat (delimit (reverse events) ", ")
                                             "\n")
                                   "")
                                 *stop-recording*))))
          (do ((current-event (event-name (read-event (prompt)))
                              (event-name (read-event
                                           (prompt (cons current-event
                                                         events)))))
               (events nil (cons current-event events)))
              ((string= current-event *stop-recording*) (reverse events))))))

(defun play-macro ()
  "Send the last keyboard macro to the current window"
  (when *last-kbd-macro*
    (play-events *last-kbd-macro* (input-focus))))

(defun play-events (events window)
  "Send each event from EVENTS to WINDOW"
  (cond ((null events) nil)
        (t (synthesize-event (car events) window)
           (play-events (cdr events) window))))

(defun bind-last-kbd-macro ()
  (let ((macro *last-kbd-macro*)
        (key (event-name (read-event "Key binding?"))))
    (bind-keys global-keymap key
               (lambda () (play-events macro (input-focus))))))

;; these values can be changed above
(bind-keys global-keymap *start-recording* '(record-macro))
(bind-keys global-keymap *play-macro* '(play-macro))
(bind-keys global-keymap *bind-macro* '(bind-last-kbd-macro))

(provide 'macros)