cl-hogehoge を #xyzzy に移植するときのテンプレート生成

gistfile1.lisp

;;
;; あるパッケージ内で定義されているシンボルの中から
;; ansify にあるシンボルと未定義のシンボルを取得して、
;; パッケージのテンプレートを生成する。
;;
;; cl-hogehoge の移植用に。
;;
;; 以下で定義している関数を利用しています。
;;
;; #xyzzy にはないシンボルと ansify にあるシンボルに色をつけるためのキーワードファイルの生成
;; https://gist.github.com/1305799

(defparameter *package-template* "
(defpackage :~A
  (:use :lisp)
  (:shadowing-import-from :ansify
~{   :~A~^~%~}
   )
  )

(in-package :~A)

~{
(defun ~A ()
  ;; TODO
  )
~}
")

(defun generate-package-template (pkg)
  (multiple-value-bind (ansify-syms missing-syms)
      (find-missing-symbols pkg)
    (insert (format nil *package-template*
                    pkg ansify-syms
                    pkg missing-syms))))

(defun find-missing-symbols (pkg)
  "指定したパッケージのシンボルの中から以下を多値で返す。
1. xyzzy になくて ansify にあるシンボル (ansify から import すれば OK)
2. xyzzy になくて ansify にもないシンボル (移植が必要)"
  (let ((syms (package-symbols pkg))
        (ansify-syms (ansify-external-symbols))
        (missing-syms (missing-symbols)))
    (values (intersection syms ansify-syms :test #'string=)
            (remove-if #'(lambda (name)
                           (let ((sym (find-symbol name pkg)))
                             (or (fboundp sym)
                                 (boundp sym))))
                       (set-difference (intersection syms missing-syms :test #'string=)
                                       ansify-syms :test #'string=)))))

(defun package-symbols (pkg)
  (let (r)
    (setf pkg (find-package pkg))
    (do-symbols (sym pkg)
      (when (equal (symbol-package sym)
                   pkg)
        (push (symbol-name sym) r)))
    (nreverse r)))