モジュールの習作。

stumpwmは、Common Lispの機能をフルに利用して、各種モジュールを作成することができます。
なんか作ってみよー、ということで、動的にキーバインドにアプリケーションの起動を割り振る、簡単なランチャを作成してみました。
まだ一部機能しか実装してないんですが、別段不便でもないのでこれはこれでいけそうです。

英語が違うよ？とかは勘弁してください。

;;; Usage:

;; This StumpWM module acts as Simple Application launchar.
;;
;; To use it add this to your ~/.stumpwmrc :
;;
;;  (load "/path/to/simplelaunchar.lisp")
;;
;; Then add the directory and file name for save launch application list.
;;
;;  (setf *simplelaunchar-file-directory* "~/.application-list")
;;
;; You might want to bin *simplelaunchar-map* to a Key:
;;
;;  (define-key *root-map* (kbd "r") '*simplelaunchar-map*)
;;
;; With this map you can add application to list, and launch application's.
;;

;;; Code:

(in-package :stumpwm)

(defvar *simplelaunchar-file-directory* nil)

(defvar *simplelaunchar-map*
  (let ((m (make-sparse-keymap)))
    (define-key m (kbd "C-a") "simplelaunchar-add")
    m))

(defun simplelaunchar-init ()
  "Initialize simplelaunchar"
  ;; ファイルの存在チェック
  (with-open-file (s *simplelaunchar-file-directory*
                     :if-does-not-exist nil)
    (if s
        (load *simplelaunchar-file-directory*)
        (with-open-file (s *simplelaunchar-file-directory*
                           :if-does-not-exist :create)
          (format s ";; application-list~%(in-package :stumpwm)")))))

(defcommand simplelaunchar-add (appname key)
  ((:rest "Application Name: ")
   (:rest "Register key: "))
  "Add a Application and Launch key-binding.
If Application is already registered with application-list, it will be remove
previous key binding, and register new key binding for Application"
  (when (and (< 0 (length appname))
             (< 0 (length key)))
    ;; 対象のapplicationをrun-or-raiseするようにして、ファイルに書き込
    ;; む。
    (let ((command (simplelaunchar-make-command-datum
                    appname (simplelaunchar-make-command-name appname)))
          (keys (simplelaunchar-make-define-key-datum key
                                                      (simplelaunchar-make-command-name
                                                       appname)))
          )
      ;; 開いたファイルに新しく書き出す。
      (with-open-file (s *simplelaunchar-file-directory* :direction :output :if-does-not-exist nil
                         :if-exists :append)
        (when s
          (format s "~A~%~A~%" command keys)
          (message "append simplelaunchar: ~a"  appname)))
      ;; 書き出したファイルを再評価する。
      (load *simplelaunchar-file-directory*))
    ))

(defun simplelaunchar-make-command-name (name)
  "make simplelaunchar command name"
  (let ((formatter "simplelaunchar-command-~A"))
    (format nil formatter (file-namestring name))))

(defun simplelaunchar-make-define-key-datum (key app)
  "return to difinition of application launching key binding"
  (let ((formatter "(define-key *simplelaunchar-map* (kbd ~W) ~W)"))
    (format nil formatter key app)))
;;   (let ((formatter "(define-key *simplelaunchar-map* (kbd \"~A\") \"~A\")"))
;;     (format nil formatter key app)))

(defun simplelaunchar-make-command-datum (app name)
  "return to command difinition of applicaton launching "
  (let ((formatter "(defcommand ~A () () (run-shell-command ~W))"))
    (format nil formatter name app)))