anythingに魅かれてlisp始めました
Emacs歴約10年。
今までカンでlispをカスタマイズしていたが、Anythingを活用したくて、本格的にlispの勉強を始めました。
しかし良くカンだけでやってきたなぁと思ったり思わなかったり。
↓は約3年前にマニュアルを見つつ格闘した自作lisp。
C++のUnitTestをサポートするツール「河童」を更にサポートするためのlispです。
;;-*- emacs-lisp -*- ;; 河童プロジェクトの子馬/子河童サポートLisp ;; (defun cocuppa () "河童プロジェクトの子河童をサポートするLisp。 cocuppa --include *1 --skeleton *2 *3 *4 ....... インクルードファイル … *1に相当(複数指定可能) 作成クラス名 … *2 に相当。.cppはcocuppa側がつけるので、不要。 作成メソッド名 … *3、*4...に相当 " (interactive) (let ( include-files class-name method-names found) ;; include-filesの取得 (catch 'found (let (file-name) (while t (setq file-name (read-file-name "インクルードするファイル(RETのみで終了) : " "" "" t)) ;; 要マッチ (if (equal file-name "") (throw 'found t)) (setq include-files (concat include-files " --include ")) (setq include-files (concat include-files file-name))))) ;; 作成クラス名取得(何かを入力するまでは、抜けない) (catch 'found (let ( (now-buffer-name (buffer-name (current-buffer))) (default-name "") match-index) (if (string-match "^[^ ].*\\.cpp.*" now-buffer-name) (progn (setq match-index (string-match "\\.cpp" now-buffer-name)) (setq default-name (substring now-buffer-name 0 match-index)) (setq default-name (concat default-name "Test")) )) (while t (setq class-name (read-string "作成クラス名 : " default-name)) (if (not (equal class-name "")) (throw 'found t))))) ;; メソッドネームの取得 (catch 'found (let (m-name) (while t (setq m-name (read-string "作成メソッド名(RETのみで終了) : " "test")) (if (or (equal m-name "") (equal m-name "test")) (throw 'found t)) (setq method-names (concat method-names " " )) (setq method-names (concat method-names m-name))))) ;; cocuppa呼び出し (let ( (command-str "cocuppa " )) (if (not (equal include-files nil)) (progn (setq command-str (concat command-str include-files)) (setq command-str (concat command-str " ")))) (setq command-str (concat command-str " --skeleton ")) (setq command-str (concat command-str class-name)) (setq command-str (concat command-str " " )) (setq command-str (concat command-str method-names)) (call-process shell-file-name nil nil t shell-command-switch command-str)) ;; ファイルを開く (find-file (concat class-name ".cpp")) ) ;; let ) ;; defun (defun couma () "河童プロジェクトの子馬をサポートするLispです" (interactive) ; buffer-alist キー=ファイル名-.cpp : 値=バッファ名の連想配列 ; cuppa-class-name 子馬に渡すクラス名 ; cuppa-function-name 子馬に渡す関数名 ; b-name バッファ名 (let (buffer-alist cuppa-class-name cuppa-function-name b-name found ) ;; クラス名(ファイル名-.cpp) と バッファ名の連想リストを作成 (let (fname bname match-index (blist (buffer-list))) ; fname = ファイル名 : bname = バッファ名 (while blist (setq bname (buffer-name (car blist))) (setq fname (buffer-file-name (car blist))) (if (and fname ;; ファイルが存在する時のみ (string-match "^[^ ].*Test\\.cpp.*" bname )) ;; .cppバッファのみ対象にする (progn (setq match-index (string-match "\\.cpp" fname )) (if match-index (progn (let (cname) (setq cname (substring fname 0 match-index)) ; (setq class-names (cons cname class-names)) (if (not (assoc cname buffer-alist)) (setq buffer-alist (cons (list cname bname) buffer-alist)))))))) (setq blist (cdr blist)))) ;; クラス名の入力 (let ( (completion-ignore-case t)) (setq cuppa-class-name (completing-read "クラス: " buffer-alist nil t ))) ;; 初期値を後で入れる ; (setq cuppa-function-name (read-string "メソッド名: " "test")) ;;メソッド名の入力 (catch 'found (let (tmp-function-name) (while t (setq tmp-function-name (read-string "メソッド名: (RETのみで終了) : " "test")) (if (not (string-match "^test.+" tmp-function-name)) (throw 'found t)) (setq cuppa-function-name (concat cuppa-function-name " ")) (setq cuppa-function-name (concat cuppa-function-name tmp-function-name))))) ;; バッファ名を取得する (let ( tmp-list ) (setq tmp-list (assoc cuppa-class-name buffer-alist) ) (setq b-name (cdr tmp-list)) (setq b-name (car b-name)) ) ;; バッファが未セーブならば、問い合わせ後、セーブする (if (buffer-modified-p (get-buffer b-name)) (if (yes-or-no-p "ファイルを書き込みますか？") (save-excursion (set-buffer (get-buffer b-name)) (basic-save-buffer)) ) ) ;; couma呼び出し ; file-path-str /home/user/xxxx/FooTest の path部分(/home/user/xxxx/) ; class-name-str /home/user/xxxx/FooTest のクラス名部分 (FooTest) (let ( (class-str-index 0) (file-path-str "./") (class-name-str "") (command-str "")) (setq class-str-index (string-match "[^/]+$" cuppa-class-name)) (if (not (equal class-str-index nil)) (progn (setq file-path-str (substring cuppa-class-name 0 class-str-index)) ;; file-path-str 取得 (setq class-name-str (substring cuppa-class-name class-str-index nil)) ;; class-name-str 取得 )) ;; cd コマンド (setq command-str (concat command-str "cd ")) (setq command-str (concat command-str file-path-str)) (setq command-str (concat command-str "; ")) ;; couma コマンド (if (not (string= class-name-str "")) (progn (setq command-str (concat command-str "couma ")) (setq command-str (concat command-str "--skeleton ")) (setq command-str (concat command-str class-name-str)) ; (setq command-str (concat command-str cuppa-class-name)) (setq command-str (concat command-str cuppa-function-name)) (setq command-str (concat command-str ".")) ;;関数名の直後に'.'をつけると、メソッドの定義位置をクラスの外に変更出来る (call-process shell-file-name nil nil t shell-command-switch command-str) )) ) ;; ;; バッファを新しいファイルに更新 (if (not (buffer-modified-p (get-buffer b-name))) (save-excursion (set-buffer (get-buffer b-name)) (find-alternate-file (concat cuppa-class-name ".cpp") ))) ) )
