emacs lisp

emacsで編集中で、バッファに存在するファイルをsvn commitするemacs lispを書きました。
exclusion-listに登録した文字列以外のバッファをcommit対象のファイルとし、さらにファイル一つずつcommitするかどうか尋ねます。まぁ、elispの勉強を兼ねて自分用に作ったので他の方は改造してからお使いください。。

;;; svncommit.el --- svn commit interface for emacs 

;; Author      Sodex
;; Revision    0.1
;; License     suspension
;; Date        creae: 2007/09/10

(defconst svn-buffer-name "svncommitbuffer")
(defconst exclusion-list '("*" "nil"))

(setq debug-on-error t)

(defun svn-commit ()
  (interactive)
  (save-excursion
   (let* ((username (read-string "username: "))
          (comment (read-string "comment: " "" nil ""))
          (old-buffer (current-buffer))
          (buffername-list (sss-get-buffername-list (buffer-list)))
          (file-list (sss-check-buffername-list buffername-list)))
     (save-current-buffer 
       (sss-set-my-buffer)
       (setq file-list (sss-check-commit-files file-list))
       (setq args (sss-create-arg-string file-list username comment))
       (start-process-shell-command "svncommit" svn-buffer-name "svn" args)))))
;       (call-process "svn" nil t nil "commit" "--username" username 
;                     "-m" comment " " args)))))

(defun svn-log ()
  (interactive)
  (save-excursion
    (let ((username (read-string "username: ")))
      (sss-set-my-buffer)
      (call-process "svn" nil t nil "log"
                    "--username" username))))

(defun svn-up ()
  (interactive)
  (save-excursion
    (let ((username (read-string "username: ")))
      (sss-set-my-buffer)
      (call-process "svn" nil t nil "up"
                    "--username" username))))

(defun sss-set-my-buffer ()
  (if (get-buffer svn-buffer-name)
      (kill-buffer svn-buffer-name))
    (set-buffer (get-buffer-create svn-buffer-name)))

(defun sss-insert-buffer-list (list write-buffer)
  (when list
    (let ((buf (car list)))
      (if (buffer-modified-p buf)
          (insert (format "%s\n" (buffer-name buf)) (write-buffer))))))

(defun sss-get-buffername-list (buffer-list)
  (setq new-list '())
  (while buffer-list
    (let ((file-name (sss-clear-buf-name (car buffer-list))))
      (bury-buffer (car buffer-list))
      (setq buffer-list (cdr buffer-list))
      (setq new-list (cons file-name new-list))))
  new-list)

(defun sss-check-buffername-list (list)
  (setq new-list '())
  (setq flag t)
  (while list
    (let ((file-name (car list)))
      (setq list (cdr list))
      (defun sss-check-buffer-name-list-itr (ex-list)
        (when ex-list
          (if (string-match (car ex-list) file-name)
              (setq flag nil)
            (progn
              (setq flag t)
              (sss-check-buffer-name-list-itr (cdr ex-list))))))
      (sss-check-buffer-name-list-itr exclusion-list)
      (if (eq flag t)
          (setq new-list (cons file-name new-list)))))
  new-list)

(defun sss-check-commit-files (list)
  (setq new-list '())
  (while list
    (let* ((file-name (car list))
           (user-reply
            (read-string (format "%s commit ? (yes or no): " file-name))))
      (setq list (cdr list))
      (if (or (string= user-reply "yes")
              (string= user-reply "y"))
          (setq new-list (cons file-name new-list)))))
  new-list)

(defun sss-create-arg-string (list username comment)
  (setq args (concat "commit --force-log --username " username " -m " comment))
  (while list
    (let ((file-name (car list)))
      (if file-name
          (setq args (if (string= args "")
                         file-name
                       (concat args " " file-name)))))
    (setq list (cdr list)))
  args)

(defun sss-print-list (list)
  (when list
    (print (car list) (get-buffer svn-buffer-name))
    (sss-print-list (cdr list))))

(defun sss-clear-buf-name (buffer)
  (format "%s" (buffer-file-name buffer)))