;;; source-wrap.el
;;;
;;; Copyright (C) 1997, 1998, 2004, 2007, 2008 Thien-Thi Nguyen
;;;
;;; This file is part of ttn's personal elisp library, released under
;;; the terms of the GNU General Public License as published by the
;;; Free Software Foundation; either version 3, or (at your option) any
;;; later version.  There is NO WARRANTY.  See file COPYING for details.

;;; Description: Put version control tags around source.

(require 'cl)

(defvar source-wrap-styles
  '(((emacs-lisp lisp-interaction lisp scheme) ";;;")
    ((sh perl makefile text) "#")
    ((c c++) "//"))
  "*List of styles consulted by `source-wrap'.
Each element has the form:
  ((MODE ...) BOL-COMMENT-PREFIX)
where MODE is a symbol that when suffixed with \"-mode\" produces
a symbol that is compared against the value of `major-mode'.  For
that mode, use the string BOL-COMMENT-PREFIX.")

;;;###autoload
(defun source-wrap (&optional copyright)
  "Insert source-related boilerplate around current buffer contents.
Optional arg COPYRIGHT specifies a file which contains copyright text.
Each line, including lines from COPYRIGHT if specified, is inserted
in the buffer prefixed w/ a bol-comment-prefix as determined by the
variable `source-wrap-styles'."
  (interactive "fCopyright file: ")
  (let* ((style (or (find (intern (substring (symbol-name major-mode) 0 -5))
                          source-wrap-styles
                          :test (lambda (x y) (memq x (car y))))
                    (error "%s Mode not registered in `source-wrap-styles'"
                           mode-name)))
         (bol-comment (cadr style))
         (name (file-name-nondirectory
                (or (buffer-file-name)
                    (if (interactive-p)
                        (read-file-name "No filename yet. New filename: ")
                      (error "No filename yet"))))))
    (setq copyright
          (unless (or (not copyright)
                      (string= "" copyright)
                      (not (file-exists-p copyright))
                      (string= name (file-name-nondirectory copyright)))
            (with-temp-buffer
              (insert-file-contents copyright)
              (split-string (buffer-string) "\n"))))
    (goto-char (point-max))
    (insert "\n" bol-comment " " name " ends here\n")
    (goto-char (point-min))
    (insert bol-comment " " name "\n"
            bol-comment "\n")
    (when (memq (vc-responsible-backend default-directory)
                '(RCS CVS))
      (insert bol-comment " $" "State" "$:$" "Name" "$\n" ; prevent expansion
              bol-comment "\n"))
    (dolist (line copyright)
      (insert bol-comment (if (string= "" line) "" " ") line "\n"))))

(provide 'source-wrap)

;;; source-wrap.el ends here