skelrc: New function to insert flowed paragraphs.

[skel] / skelrc

;;; -*-emacs-lisp-*-

(defun skelrc-dribble (msg &rest args)
  "Write MSG (a `format'-style string, with ARGS) to the debug buffer."
  (let ((buffer (get-buffer "*skel-debug*")))
    (and buffer
	 (with-current-buffer buffer
	   (goto-char (point-max))
	   (insert (apply #'format msg args) "\n")))))

(defun skelrc-strip-trailing-whitespace (string)
  "Return STRING, but with trailing whitespace removed.

Whitespace characters are those with space syntax."
  (let ((i (1- (length string))))
    (while (and (>= i 0) (= (char-syntax (aref string i)) ? ))
      (setq i (1- i)))
    (substring string 0 (1+ i))))

(defun skelrc-banner (title &optional block)
  "Return a comment banner with the given TITLE, and maybe a BLOCK of text."
  (let* ((start (skel-lookup 'block-start))
	 (end (skel-lookup (if block 'block-banner-knob 'block-banner-end)))
	 (barlen (- 77 (length (concat start end " ----- " title)))))
    (skelrc-strip-trailing-whitespace (concat start
					      "----- "
					      title
					      " "
					      (make-string barlen ?-)
					      end))))

(defvar skelrc-forced-major-mode 0
  "The priority of the currently forced major mode")

(defun skelrc-force-mode (new-mode &optional priority)
  "Force the use of major mode NEW-MODE.

If the PRIORITY (defaults to 1) is strictly greater than
`skelrc-forced-major-mode' then the NEW-MODE takes precedence.  A `skelrc'
file which wants to delegate settings to another file should therefore force
its chosen major-mode before calling `skel-include'."
  (or priority (setq priority 1))
  (if (> priority skelrc-forced-major-mode)
      (progn
	(or (eq new-mode major-mode)
	    (let ((old-skel-alist skel-alist))
	      (funcall new-mode)
	      (make-variable-buffer-local 'skel-alist)
	      (setq skel-alist old-skel-alist)))
	(make-variable-buffer-local 'skelrc-forced-major-mode)
	(setq skelrc-forced-major-mode priority))))

(defun skelrc-decode-major-mode ()
  "Return the mode dropping to put in a local-variables line."
  (let* ((name (symbol-name major-mode))
	 (endind (string-match "-mode$" name)))
    (if endind (substring name 0 endind)
      (name))))

(defun skelrc-assq (key alist)
  "Pick out the value associated with KEY in ALIST (rather than the cons)."
  (let ((val (assq key alist)))
    (and val (cdr val))))

(defun skelrc-expand-text (text)
  "Return the result of expanding TEXT in the current context.

The context is extended with any new associations formed during
the expansion."
  (let* ((alist skel-alist)
	 (expanded (with-temp-buffer
		     (let ((skel-alist alist))
		       (insert text)
		       (goto-char (point-min))
		       (skelrc-dribble "before: alist = `%s'" skel-alist)
		       (skel-do-fill-in)
		       (setq alist skel-alist)
		       (buffer-string)))))
    (setq skel-alist alist)
    expanded))

(defun skelrc-prefix-lines (prefix lines)
  "Return LINES, each with PREFIX prepended to the beginning.

If the LINES end with a newline character, there is not considered to be a
final empty line.  When prepended to an empty line, trailing whitespace in
the PREFIX is removed."
  (with-temp-buffer
    (insert lines)
    (goto-char (point-min))
    (while (< (point) (point-max))
      (insert prefix)
      (and (looking-at "\n")
	   (delete-horizontal-space t))
      (forward-line))
    (buffer-string)))

(defun skelrc-prefix-and-reflow (prefix text)
  "Return LINES, reflowed to `fill-column', with PREFIX at the start."
  (let ((expanded-prefix (skelrc-expand-text prefix))
	(expanded-text (skelrc-expand-text text))
	(col (string-to-number (skel-lookup 'fill-column))))
    (with-temp-buffer
      (let* ((fill-prefix expanded-prefix)
	     (paragraph-start (concat (skelrc-strip-trailing-whitespace
				       (regexp-quote expanded-prefix))
				      "[ \t\f]*$"))
	     (paragraph-separate paragraph-start)
	     (fill-column col))

	(insert (skelrc-prefix-lines expanded-prefix expanded-text))

	(goto-char (point-min))
	(while (< (point) (point-max))
	  (fill-paragraph)
	  (forward-paragraph))

	(buffer-string)))))

(defun skelrc-component ()
  "Return a suitable a `This file is part of ...' line."
  (if (assq 'full-title skel-alist)
"[[cont-comment]] This file is part of [[full-title]].
\[[cont-comment]]\n"
    ""))

(setq skelrc-gpl (skelrc-prefix-lines "[[cont-comment]] "
"[[Program-name]] 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 2 of the License, or
\(at your option) any later version.

\[[Program-name]] 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 [[program-name]]; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA."))

(setq skelrc-wide-gpl (skelrc-prefix-lines "[[cont-comment]] "
;;Version for wide program names
"[[Program-name]] 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 2 of the License, or
\(at your option) any later version.

\[[Program-name]] 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 [[program-name]]; if not, write to the Free
Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA."))

(setq skelrc-lgpl (skelrc-prefix-lines "[[cont-comment]] "
"[[Library-name]] is free software; you can redistribute it and/or modify
it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

\[[Library-name]] 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 Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with [[library-name]]; if not, write to the Free
Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA."))

(setq skelrc-agpl (skelrc-prefix-lines "[[cont-comment]] "
"[[Program-name]] is free software; you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation; either version 3 of the
License, or (at your option) any later version.

\[[Program-name]] 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 Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public
License along with [[program-name]]; if not, see
<http://www.gnu.org/licenses/>."))

(setq skelrc-bsd (skelrc-prefix-lines "[[cont-comment]] "
"Copyright (c) [[year]] [[author]]
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

1. Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.

2, Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.

3. The name of the authors may not be used to endorse or promote
   products derived from this software without specific prior written
   permission.

THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN
NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
\(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

Instead of accepting the above terms, you may redistribute and/or modify
this software under the terms of either the GNU General Public License,
or the GNU Library General Public License, published by the Free
Software Foundation; either version 2 of the License, or (at your
option) any later version."))

(defun skel-basename ()
  (file-name-sans-extension (file-name-nondirectory buffer-file-name)))

(setq skel-alist
      (append
       `((first-line . "[[new-comment]] -*-[[emacs-mode]]-*-")
	 (emacs-mode . (skelrc-decode-major-mode))
	 (year . (substring (current-time-string) 20 24))
	 (header . "[[licence]][[preamble]]")
	 (basename . (skel-basename))
	 (licence . ,(concat "[[licence-banner]]\n"
			     "[[cont-comment]]\n"
			     "[[component]][[licence-text]]"
			     "[[block-end]]\n\n"))
	 (licence-banner . (skelrc-banner "Licensing notice" t))
	 (component . (skelrc-component))
	 (licence-text . "[[gpl]]")
	 (Program-name . (or (skelrc-assq 'Program skel-alist)
			     (skelrc-assq 'program skel-alist)
			     "This program"))
	 (program-name . (or (skelrc-assq 'program skel-alist)
			     "this program"))
	 (Library-name . (or (skelrc-assq 'Library skel-alist)
			     (skelrc-assq 'library skel-alist)
			     (skelrc-assq 'Program skel-alist)
			     (skelrc-assq 'program skel-alist)
			     "This library"))
	 (library-name . (or (skelrc-assq 'library skel-alist)
			     (skelrc-assq 'program skel-alist)
			     "this library"))
	 (gpl . skelrc-gpl)
	 (wide-gpl . skelrc-wide-gpl)
	 (lgpl . skelrc-lgpl)
	 (agpl . skelrc-agpl)
	 (bsd . skelrc-bsd)
	 (revisions . ,(concat "[[revision-banner]]\n"
			       "[[cont-comment]]\n"
			       "[[cont-comment]] $Log$"
			       "[[block-end]]\n\n"))
	 (revision-banner . (skelrc-banner "Revision history" t))
	 (preamble . "")
	 (trailer . "[[tag-line]]\n[[postamble]]")
	 (postamble . "")
	 (tag-line . (skelrc-banner "That's all, folks"))
	 (block-start . (skel-lookup 'new-comment))
	 (block-banner-knob . "")
	 (block-banner-end . "")
	 (block-end . ""))
       skel-alist))