stumpwm/icelandic.lisp @ 4f28fbfd7d63

(in-package :stumpwm-user)

(defcommand send-key (key &optional (win (current-window))) (:key)
  "Send key press and key release events for KEY to window WIN."
  ;; from https://github.com/alezost/stumpwm-config/blob/master/utils.lisp
  (let ((xwin (window-xwin win)))
    (multiple-value-bind (code state) (stumpwm::key-to-keycode+state key)
      (flet ((send (event)
               (xlib:send-event xwin event (xlib:make-event-mask event)
                                :display *display*
                                :root (screen-root (window-screen win))
                                :x 0 :y 0 :root-x 0 :root-y 0
                                :window xwin :event-window xwin
                                :code code
                                :state state)))
        (send :key-press)
        (send :key-release)
        (xlib:display-finish-output *display*)))))

(defun send-keys (keys &key (win (current-window)) (sleep 0))
  (dolist (k keys)
    (send-key (kbd k) win)
    (sleep sleep)))

(defmacro defmultikey (name key compose-keys)
  ;; Unfortunately we can't reliably autogen the name with something like
  ;; (symb 'mk- compose-key) here because things like đ (th) and Đ (TH) would
  ;; case fold to the same name.
  `(progn
     (defcommand ,name () ()
       (send-keys '("Multi_key" ,@(map 'list #'string compose-keys))))
     (define-key *top-map*
       (kbd ,key) ,(string name))))

(defmacro defmultikeys (&rest bindings)
  `(progn ,@(loop for binding :in bindings :collect `(defmultikey ,@binding))))

(defmultikeys
  (isk-l-á "M-a" "'a")
  (isk-u-Á "M-A" "'A")
  (isk-l-é "M-e" "'e")
  (isk-u-É "M-E" "'E")
  (isk-l-í "M-i" "'i")
  (isk-u-Í "M-I" "'I")
  (isk-l-ó "M-o" "'o")
  (isk-u-Ó "M-O" "'O")
  (isk-l-ö "M-m" "\"o")
  (isk-u-Ö "M-M" "\"O")
  (isk-l-ú "M-u" "'u")
  (isk-u-Ú "M-U" "'U")
  (isk-l-ý "M-y" "'y")
  (isk-u-Ý "M-Y" "'Y")
  (isk-l-þ "M-t" "th")
  (isk-u-Þ "M-T" "TH")
  (isk-l-đ "M-d" "dh")
  (isk-u-Đ "M-D" "DH")
  (isk-l-æ "M-h" "ae")
  (isk-u-Æ "M-H" "AE"))


(defcommand thinkpad-ret () ()
  (send-key (kbd "RET")))

(defcommand thinkpad-bs () ()
  (send-key (kbd "BackSpace")))