2011年9月18日日曜日

popup.elで遊んでみる

overlayを使ってポップアップメニューを表示するpopup.elを使ってみました。
rclk:rclkコマンドを実行すると、*rckl:clauses*に設定されている条件に
したがってメニューを表示します。


右クリックをイメージしています。



;; (require 'popup)

(defvar *rclk:clauses* nil)

(defvar *rclk:format-function* nil)

(defun rclk:rclk ()
(interactive)
(rclk:popup-menu*
(rclk:select *rclk:clauses*)))

(defun rclk:clause-name (clause)
(if (<= (length clause) 2)
(second clause)
(third clause)))

(defun rclk:select (clauses)
(let ((result nil))
(dolist (c clauses)
(let ((strs (funcall (first c))))
(unless (listp strs)
(setf strs (list strs)))
(dolist (s strs)
(push (list s (second c) (third c)) result))))
(nreverse result)))

(defun rclk:popup-menu* (clauses)
(when clauses
(let ((popup-clauses (mapcar 'rclk:clause->popup clauses)))
(let ((result (popup-menu* (mapcar 'first popup-clauses))))
(when result
(let ((selected (find result popup-clauses
:key 'first
:test 'string-equal)))
(funcall (third selected) (second selected))
t))))))

(defun rclk:clause->popup (clause)
(let ((str (substring-no-properties
(funcall *rclk:format-function* clause))))
(cons str clause)))

;;; test
(defun symbol-at-point-as-str ()
(when (symbol-at-point)
(symbol-name (symbol-at-point))))
(defun find-function-from-str (str)
(find-function (intern str)))

;; clause = (文字列のリストを返す関数 選択時に呼び出される関数 表示項目名)
(setf *rclk:clauses*
`((word-at-point apropos "apropos")
(symbol-at-point-as-str find-function-from-str "find-function")))

(setf *rclk:format-function*
(lambda (clause)
(format "<%s> %s"
(rclk:clause-name clause)
(first clause))))