;;; xlicense.el --- Insert a pre-defined license text

;; Copyright (C) 2010  Seong-Kook Shin

;; Author: Seong-Kook Shin <cinsky@gmail.com>
;; Keywords: abbrev, convenience

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; $Id: xlicense.el,v 1.1 2010/12/16 08:26:26 cinsk Exp $

;;; Code:

(require 'skeleton)
;;(eval-when-compile (require 'cl))

(defvar license-directory (concat
                           (file-name-directory load-file-name)
                           "licenses")
  "Directory for license templates")

(defvar license-types '((gpl . "GPL-2.0")
                        (gpl2 . "GPL-2.0")
                        (gpl3 . "GPL-3.0")
                        (lgpl . "LGPL")
                        (apache . "APACHE-2.0")
                        (boost . "BOOST")
                        (bsd-old . "BSD-old")
                        (bsd-new . "BSD-new")
                        (bsd . "BSD-new")
                        (freebsd . "FREEBSD")
                        (mit . "MIT")
                        ;(tmp . "TMP")
                        )
  "Alist of licenses.  CAR of each item is a symbol represents the license,
CDR of each item is a filename of the license template")

(defvar license-default-summary
  "Description: "
  "Short description of what it does.")

(defvar license-eol-text "!@#$EOL!@#$"
  "Text to mark blank lines -- used internally")

(defun license-file (type)
  "Return the pathname of the given license file"
  (let ((tp (assoc type license-types)))
    (if tp
        (concat (file-name-as-directory license-directory) (cdr tp))
      tp)))

(defvar license-keywords-alist '(("@author@" . user-full-name)
                                 ("@email@" . user-email-address)
                                 ("@year@" . (lambda ()
                                               (substring (current-time-string)
                                                          -4)))
                                 ("@organization@" . 
                                  (lambda ()
                                    (getenv "ORGANIZATION"))))
  "Keywords that need to be substituted by `license-substitute-keywords'.

The CAR of an item is a keyword and CDR is a replacement.  If the
CDR of an item is a function, the return value(string) is used as
a replacement.  If the returned value is nil, no substitution for
that keyword.")


(defun license-substitute-keywords (&optional record)
  "Substitute all occurences of keywords to their replacement and returns 
the replacement positions in markers."
  (let (markers)
    (dolist (i license-keywords-alist)
      (let ((keyword (regexp-quote (car i)))
            (what (if (functionp (cdr i)) (funcall (cdr i)) (cdr i))))
        (if what
            (progn
              (goto-char (point-min))
              (while (re-search-forward keyword nil t)
                (if record
                    (setq markers (cons (point-marker) markers)))
                (replace-match what))))))
    markers))

(defun license-fill-paragraphs (lst)
  "Fill paragraphs at markers in LST."
  (dolist (i lst)
    (goto-char i)
    (fill-paragraph)))


(defun create-license (type &optional comments summary author)
  "Create a license paragraphs according to current buffer's major mode.

IF COMMENTS is non-nil, comment the license text.
If SUMMARY is non-nil, it is inserted as a header of the comment.
If AUTHOR is non-nil, all occurrence of the author keyword are
replaced to AUTHOR.

See `license-keywords-alist' for keywords and their meaning."
  (let (;(buffer (get-buffer-create "*LICENSE*"))
        (desc (or (and summary (> (length summary) 0))
                  license-default-summary))
        (auth (or author (user-full-name)))
        (lfile (license-file type))
        (mode major-mode)
        (fill-points nil))
    (with-temp-buffer
      ;; BEGIN Common
      (insert "\n")
      (insert (format "Author:: %s" auth))
      (if user-mail-address
          (insert (format " <%s>" user-mail-address)))
      (insert "\n")
      (insert (format "Copyright:: Copyright (c) %d, %s" (nth 5 (decode-time)) auth))
      (insert "\n")
      ;; END Common
      (insert-file-contents lfile)

      (goto-char (point-min))
      (while (re-search-forward "^$" nil t)
        (replace-match license-eol-text))

      (let ((case-fold-search t)
            (markers (license-substitute-keywords t)))
        (funcall mode)
        (if (and comments comment-start)
            (let ((comment-style 'extra-line))
              (comment-region (point-min) (point-max))))

        (goto-char (point-min))

        (let ((re-eol (concat (regexp-quote license-eol-text) "$")))
          (while (re-search-forward re-eol nil t)
            (replace-match "")))

        (license-fill-paragraphs markers)

        ;;(print markers)
        ;;(pop-marker)
        (goto-char (point-max))
        (insert "\n"))
      (buffer-substring-no-properties (point-min) (point-max)))))


(defun insert-license (&optional type)
  "Insert a license template into the current buffer." 
  (interactive)
  (let ((text (create-license
               (or type (intern (completing-read "Choose a license type: "
                                                 license-types nil t))) t)))
    (if (called-interactively-p 'any)
        (insert text)
      text)))


(define-skeleton license-skeleton
  "Insert a license template into the current buffer."
  ""
  (insert-license)
  "\n"
  _)


(define-skeleton gpl-interactive-skeleton
  "Insert an Interactive GPL banner."
  ""
  \n > "static const char *gpl_banner[] = {" \n
  > "\"" (file-name-nondirectory (file-name-sans-extension buffer-file-name))
  > " version XXX, Copyright (C) "
  (substring (current-time-string) -4) " " (user-full-name) "\"," \n
  > "\"" (file-name-nondirectory (file-name-sans-extension buffer-file-name))
  "comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\"," \n
  "\"This is free software, and you are welcome to redistribute it\"," \n
  "\"under certain conditions; type `show c' for details.\"," \n
  > > "};" \n
  > _)


(provide 'xlicense)
;;; license.el ends here