anekos/rc.cl

## gistfile1.txt
インストール

1. sbcl をインストール
2. quicklisp をインストール http://www.quicklisp.org/beta/
3. sbcl で以下の実行
  > (ql:quickload :clx)
  > (ql:quickload :cl-ppcre)
4. git checkout -t origin/feature/key-map-with-class
5. iron-maiden のディレクトリで make

実行

$ sudo ./iron-maiden <設定ファイル>

## rc.cl
; vim: set lispwords+=tap,for-device,for-window-class,def-event-co-routine,when-let :

(in-package :im-user)

; utils {{{

(defun command-path (name)
  (dolist (dir *path*)
    (let ((path (merge-pathnames name dir)))
      (when (probe-file path)
        (return (namestring path))))))

(defun run (cmd &rest args)
  (if-let (cmd-path (command-path cmd))
    (sb-ext:run-program "/bin/sudo" `("-u" ,*user* ,cmd-path ,@(alexandria:flatten args)) :wait nil :output t)
    (format t "command not found: ~A~%" cmd)))

(defun slock ()
  (run "slock"))

(defun zip-with (func &rest lists)
  (apply #'mapcar (cons func lists)))

(defmacro key-map-to-action (lhs &rest action)
  (with-gensyms (history lhs-c wait-for last-key)
    (eval `(defvar ,lhs-c (im-key:key-pair-list-from-text ,lhs :symbol-modifiers t)))
    (eval `(defvar ,history (im-ring-buffer:make-ring-buffer (length ,lhs-c))))
    (eval `(defvar ,wait-for nil))
    (eval `(defvar ,last-key (caar (last ,lhs-c))))
    `(if ,wait-for
       (when-key-press
         (when (= code ,last-key)
           (equal-case value
             (value-repeat
               ,@action)
             (value-up
               (setf ,wait-for nil)))
           (next-event)))
       (let ((modifiers ($ im keyboard-state im-state:current-modifires)))
         (when-key-down
           (im-ring-buffer:put-to-buffer ,history (cons code modifiers))
           (when (equalp (coerce ,lhs-c 'vector) (im-ring-buffer:get-straight ,history))
             ,@action
             (im-ring-buffer:clear-all-buffer ,history)
             (setf ,wait-for t)
             (next-event)))))))

(defmacro key-map-to-key (lhs rhs)
  `(key-map-to-action ,lhs (press-key im ,rhs)))

(defmacro key-map (lhs rhs &rest rhs-rest)
  (if (stringp rhs)
    `(key-map-to-key ,lhs ,rhs)
    `(key-map-to-action ,lhs ,rhs ,@rhs-rest)))

(defmacro x-and-y (original-key change-key modifier-key)
  (with-gensyms (pressing any-key-pressed)
    (eval `(defvar ,pressing nil))
    (eval `(defvar ,any-key-pressed nil))
    `(when-key-press
       (if (= code ,original-key)
         (equal-case
           value
           (imv:value-down
             (setf ,pressing t)
             (next-event))
           (imv:value-repeat
             (next-event))
           (imv:value-up
             (if ,any-key-pressed
               (progn
                 (send-event im imv:ev-key ,modifier-key imv:value-up)
                 (setf ,any-key-pressed nil))
               (progn
                 (let ((send-key (or ,change-key ,original-key)))
                   (send-event im imv:ev-key send-key imv:value-down)
                   (send-event im imv:ev-key send-key imv:value-up))))
             (setf ,pressing nil)
             (next-event)))
         (when (and (= value imv:value-down) ,pressing (not ,any-key-pressed))
           (send-event im imv:ev-key ,modifier-key imv:value-down)
           (setf ,any-key-pressed t))))))

(defun toggle-output-mode ()
  (format t "toggle output-mode~%")
  (setf *output-mode* (not *output-mode*)))

; }}}

; co-routines {{{

(def-pedal-routine pedal-shell key-a "shell")
(def-pedal-routine pedal-ranger key-b "ranger")
(def-pedal-routine pedal-calc key-c "calc")

; }}}

; main {{{

(defvar *output-mode* nil)
(defvar *user* "anekos")
(defvar *home-directory* (merge-pathnames #P"/home/" *user*))
(defvar *path* (list #P"/home/anekos/.xmonad/bin/"
                     #P"/home/anekos/local/bin/"
                     #P"/home/anekos/bin/"
                     #P"/usr/bin/"))

(iron-maiden

  (define-keyboard "HHKB"
                   :path #P"/dev/input/by-id/usb-Topre_Corporation_HHKB_Professional-event-kbd")
  (define-keyboard "Pedal3"
                   :path #P"/dev/input/by-id/usb-RDing_FootSwitch3F1.-event-mouse")

  ; safety
  (let ((ring (imrb:make-ring-buffer 10)))
    (define-processor
      (for-keyboard
        (when-key-down
          (when (= code key-esc)
            (imrb:put-to-buffer ring msec)
            (when-let (next (imrb:next-buffer ring))
              (when (< (- msec next) 2000)
                (imrb:clear-all-buffer ring)
                (sb-ext:exit))))))))

  ; pp - alt 三回おすとデバッグ出力
  (define-processor
    (when *output-mode*
      (pp t ev))
    (for-keyboard
      (key-map-to-action
        "<leftalt><leftalt><leftalt>"
        (toggle-output-mode))))

  ; ignore
  (define-processor
    (for-device "PowerMate"
      (next-event)))


  ; キー入れ替え
  (define-processor
    (for-device "Kinesis"
      (change key-capslock key-leftctrl))))
	インストール

	1. sbcl をインストール
	2. quicklisp をインストール http://www.quicklisp.org/beta/
	3. sbcl で以下の実行
	> (ql:quickload :clx)
	> (ql:quickload :cl-ppcre)
	4. git checkout -t origin/feature/key-map-with-class
	5. iron-maiden のディレクトリで make

	実行

	$ sudo ./iron-maiden <設定ファイル>
	; vim: set lispwords+=tap,for-device,for-window-class,def-event-co-routine,when-let :

	(in-package :im-user)

	; utils {{{

	(defun command-path (name)
	(dolist (dir path)
	(let ((path (merge-pathnames name dir)))
	(when (probe-file path)
	(return (namestring path))))))

	(defun run (cmd &rest args)
	(if-let (cmd-path (command-path cmd))
	(sb-ext:run-program "/bin/sudo" `("-u" ,user ,cmd-path ,@(alexandria:flatten args)) :wait nil :output t)
	(format t "command not found: ~A~%" cmd)))

	(defun slock ()
	(run "slock"))

	(defun zip-with (func &rest lists)
	(apply #'mapcar (cons func lists)))

	(defmacro key-map-to-action (lhs &rest action)
	(with-gensyms (history lhs-c wait-for last-key)
	(eval `(defvar ,lhs-c (im-key:key-pair-list-from-text ,lhs :symbol-modifiers t)))
	(eval `(defvar ,history (im-ring-buffer:make-ring-buffer (length ,lhs-c))))
	(eval `(defvar ,wait-for nil))
	(eval `(defvar ,last-key (caar (last ,lhs-c))))
	`(if ,wait-for
	(when-key-press
	(when (= code ,last-key)
	(equal-case value
	(value-repeat
	,@action)
	(value-up
	(setf ,wait-for nil)))
	(next-event)))
	(let ((modifiers ($ im keyboard-state im-state:current-modifires)))
	(when-key-down
	(im-ring-buffer:put-to-buffer ,history (cons code modifiers))
	(when (equalp (coerce ,lhs-c 'vector) (im-ring-buffer:get-straight ,history))
	,@action
	(im-ring-buffer:clear-all-buffer ,history)
	(setf ,wait-for t)
	(next-event)))))))

	(defmacro key-map-to-key (lhs rhs)
	`(key-map-to-action ,lhs (press-key im ,rhs)))

	(defmacro key-map (lhs rhs &rest rhs-rest)
	(if (stringp rhs)
	`(key-map-to-key ,lhs ,rhs)
	`(key-map-to-action ,lhs ,rhs ,@rhs-rest)))

	(defmacro x-and-y (original-key change-key modifier-key)
	(with-gensyms (pressing any-key-pressed)
	(eval `(defvar ,pressing nil))
	(eval `(defvar ,any-key-pressed nil))
	`(when-key-press
	(if (= code ,original-key)
	(equal-case
	value
	(imv:value-down
	(setf ,pressing t)
	(next-event))
	(imv:value-repeat
	(next-event))
	(imv:value-up
	(if ,any-key-pressed
	(progn
	(send-event im imv:ev-key ,modifier-key imv:value-up)
	(setf ,any-key-pressed nil))
	(progn
	(let ((send-key (or ,change-key ,original-key)))
	(send-event im imv:ev-key send-key imv:value-down)
	(send-event im imv:ev-key send-key imv:value-up))))
	(setf ,pressing nil)
	(next-event)))
	(when (and (= value imv:value-down) ,pressing (not ,any-key-pressed))
	(send-event im imv:ev-key ,modifier-key imv:value-down)
	(setf ,any-key-pressed t))))))

	(defun toggle-output-mode ()
	(format t "toggle output-mode~%")
	(setf output-mode (not output-mode)))

	; }}}

	; co-routines {{{

	(def-pedal-routine pedal-shell key-a "shell")
	(def-pedal-routine pedal-ranger key-b "ranger")
	(def-pedal-routine pedal-calc key-c "calc")

	; }}}

	; main {{{

	(defvar output-mode nil)
	(defvar user "anekos")
	(defvar home-directory (merge-pathnames #P"/home/" user))
	(defvar path (list #P"/home/anekos/.xmonad/bin/"
	#P"/home/anekos/local/bin/"
	#P"/home/anekos/bin/"
	#P"/usr/bin/"))

	(iron-maiden

	(define-keyboard "HHKB"
	:path #P"/dev/input/by-id/usb-Topre_Corporation_HHKB_Professional-event-kbd")
	(define-keyboard "Pedal3"
	:path #P"/dev/input/by-id/usb-RDing_FootSwitch3F1.-event-mouse")

	; safety
	(let ((ring (imrb:make-ring-buffer 10)))
	(define-processor
	(for-keyboard
	(when-key-down
	(when (= code key-esc)
	(imrb:put-to-buffer ring msec)
	(when-let (next (imrb:next-buffer ring))
	(when (< (- msec next) 2000)
	(imrb:clear-all-buffer ring)
	(sb-ext:exit))))))))

	; pp - alt 三回おすとデバッグ出力
	(define-processor
	(when output-mode
	(pp t ev))
	(for-keyboard
	(key-map-to-action
	"<leftalt><leftalt><leftalt>"
	(toggle-output-mode))))

	; ignore
	(define-processor
	(for-device "PowerMate"
	(next-event)))


	; キー入れ替え
	(define-processor
	(for-device "Kinesis"
	(change key-capslock key-leftctrl))))