[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 (length expanded-prefix))))

	(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"
    ""))

(defun skelrc-generic-gpl (&rest params)
  (setq skel-alist (append params skel-alist))
  (skelrc-prefix-and-reflow "[[cont-comment]] "
"[[Short-name]] is free software: you can redistribute it and/or
modify it under the terms of the GNU \[[gpl-qualifiers]]General
Public License as published by the Free Software Foundation;
either version [[gpl-version]] of the License, or (at your
option) any later version.

\[[Short-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
\[[gpl-qualifiers]]General Public License for more details.

You should have received a copy of the GNU
\[[gpl-qualifiers]]General Public License along with
\[[short-name]].  If not, [[gpl-find-licence]]"))

(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]]")
	 (fill-column . "70")
	 (Short-name . (or (skelrc-assq 'Library skel-alist)
			   (skelrc-assq 'library skel-alist)
			   (skelrc-assq 'Program skel-alist)
			   (skelrc-assq 'program skel-alist)
			   "This [[thing]]"))
	 (short-name . (or (skelrc-assq 'library skel-alist)
			   (skelrc-assq 'program skel-alist)
			   "this [[thing]]"))
	 (generic-gpl . (skelrc-generic-gpl))
	 (gnu-temple-place . (concat "write to the "
				     "Free Software Foundation, Inc., "
				     "59 Temple Place - Suite 330, "
				     "Boston, MA 02111-1307, USA."))
	 (gnu-website . "see <https://www.gnu.org/licenses/>.")
	 (gpl-2 . (skelrc-generic-gpl '(gpl-version . "2")
				      '(gpl-qualifiers . "")
				      '(gpl-find-licence
					. "[[gnu-temple-place]]")
				      '(thing . "program")))
	 (gpl-3 . (skelrc-generic-gpl '(gpl-version . "3")
				      '(gpl-qualifiers . "")
				      '(gpl-find-licence
					. "[[gnu-website]]")
				      '(thing . "program")))
	 (lgpl-2 . (skelrc-generic-gpl '(gpl-version . "2")
				       '(gpl-qualifiers . "Library ")
				       '(gpl-find-licence
					 . "[[gnu-temple-place]]")
				       '(thing . "library")))
	 (lgpl-2.1 . (skelrc-generic-gpl '(gpl-version . "2.1")
					 '(gpl-qualifiers . "Lesser ")
					 '(gpl-find-licence
					   . "[[gnu-temple-place]]")
					 '(thing . "library")))
	 (lgpl-3 . (skelrc-generic-gpl '(gpl-version . "3")
				       '(gpl-qualifiers . "Lesser ")
				       '(gpl-find-licence
					 . "[[gnu-website]]")
				       '(thing . "library")))
	 (agpl-3 . (skelrc-generic-gpl '(gpl-version . "3")
				       '(gpl-qualifiers . "Affero ")
				       '(gpl-find-licence
					 . "[[gnu-website]]")
				       '(thing . "program")))
	 (gpl . "[[gpl-2]]")
	 (wide-gpl . "[[gpl-2]]")
	 (lgpl . "[[lgpl-2]]")
	 (agpl . "[[agpl-3]]")
	 (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))
Commit	Line	Data
7fb0878b	1	;;; --emacs-lisp--
7fb0878b	2
da3134ee MW	3	(defun skelrc-dribble (msg &rest args)
	4	"Write MSG (a `format'-style string, with ARGS) to the debug buffer."
	5	(let ((buffer (get-buffer "skel-debug")))
	6	(and buffer
	7	(with-current-buffer buffer
	8	(goto-char (point-max))
	9	(insert (apply #'format msg args) "\n")))))
	10
7e2d1edc	11	(defun skelrc-strip-trailing-whitespace (string)
70a2db6b MW	12	"Return STRING, but with trailing whitespace removed.
	13
	14	Whitespace characters are those with space syntax."
7e2d1edc MW	15	(let ((i (1- (length string))))
	16	(while (and (>= i 0) (= (char-syntax (aref string i)) ? ))
	17	(setq i (1- i)))
	18	(substring string 0 (1+ i))))
	19
7fb0878b	20	(defun skelrc-banner (title &optional block)
70a2db6b	21	"Return a comment banner with the given TITLE, and maybe a BLOCK of text."
7fb0878b	22	(let* ((start (skel-lookup 'block-start))
	23	(end (skel-lookup (if block 'block-banner-knob 'block-banner-end)))
	24	(barlen (- 77 (length (concat start end " ----- " title)))))
7e2d1edc MW	25	(skelrc-strip-trailing-whitespace (concat start
	26	"----- "
	27	title
	28	" "
	29	(make-string barlen ?-)
	30	end))))
7fb0878b	31
70a2db6b MW	32	(defvar skelrc-forced-major-mode 0
70a2db6b MW	33	"The priority of the currently forced major mode")
7fb0878b	34
7fb0878b	35	(defun skelrc-force-mode (new-mode &optional priority)
70a2db6b MW	36	"Force the use of major mode NEW-MODE.
	37
	38	If the PRIORITY (defaults to 1) is strictly greater than
	39	`skelrc-forced-major-mode' then the NEW-MODE takes precedence. A `skelrc'
	40	file which wants to delegate settings to another file should therefore force
	41	its chosen major-mode before calling `skel-include'."
7fb0878b	42	(or priority (setq priority 1))
	43	(if (> priority skelrc-forced-major-mode)
	44	(progn
	45	(or (eq new-mode major-mode)
	46	(let ((old-skel-alist skel-alist))
	47	(funcall new-mode)
	48	(make-variable-buffer-local 'skel-alist)
	49	(setq skel-alist old-skel-alist)))
	50	(make-variable-buffer-local 'skelrc-forced-major-mode)
	51	(setq skelrc-forced-major-mode priority))))
	52
	53	(defun skelrc-decode-major-mode ()
70a2db6b	54	"Return the mode dropping to put in a local-variables line."
7fb0878b	55	(let* ((name (symbol-name major-mode))
	56	(endind (string-match "-mode$" name)))
	57	(if endind (substring name 0 endind)
	58	(name))))
	59
70a2db6b MW	60	(defun skelrc-assq (key alist)
	61	"Pick out the value associated with KEY in ALIST (rather than the cons)."
	62	(let ((val (assq key alist)))
441c920b	63	(and val (cdr val))))
441c920b	64
ece2c8b7 MW	65	(defun skelrc-expand-text (text)
	66	"Return the result of expanding TEXT in the current context.
	67
	68	The context is extended with any new associations formed during
	69	the expansion."
	70	(let* ((alist skel-alist)
	71	(expanded (with-temp-buffer
	72	(let ((skel-alist alist))
	73	(insert text)
	74	(goto-char (point-min))
	75	(skelrc-dribble "before: alist = `%s'" skel-alist)
	76	(skel-do-fill-in)
	77	(setq alist skel-alist)
	78	(buffer-string)))))
	79	(setq skel-alist alist)
	80	expanded))
	81
6d349e29 MW	82	(defun skelrc-prefix-lines (prefix lines)
	83	"Return LINES, each with PREFIX prepended to the beginning.
	84
	85	If the LINES end with a newline character, there is not considered to be a
	86	final empty line. When prepended to an empty line, trailing whitespace in
	87	the PREFIX is removed."
	88	(with-temp-buffer
	89	(insert lines)
	90	(goto-char (point-min))
	91	(while (< (point) (point-max))
	92	(insert prefix)
	93	(and (looking-at "\n")
	94	(delete-horizontal-space t))
	95	(forward-line))
	96	(buffer-string)))
	97
e37dd246 MW	98	(defun skelrc-prefix-and-reflow (prefix text)
	99	"Return LINES, reflowed to `fill-column', with PREFIX at the start."
	100	(let ((expanded-prefix (skelrc-expand-text prefix))
	101	(expanded-text (skelrc-expand-text text))
	102	(col (string-to-number (skel-lookup 'fill-column))))
	103	(with-temp-buffer
	104	(let* ((fill-prefix expanded-prefix)
	105	(paragraph-start (concat (skelrc-strip-trailing-whitespace
	106	(regexp-quote expanded-prefix))
	107	"[ \t\f]*$"))
	108	(paragraph-separate paragraph-start)
fb0894ef	109	(fill-column (+ col (length expanded-prefix))))
e37dd246 MW	110
	111	(insert (skelrc-prefix-lines expanded-prefix expanded-text))
	112
	113	(goto-char (point-min))
	114	(while (< (point) (point-max))
	115	(fill-paragraph)
	116	(forward-paragraph))
	117
	118	(buffer-string)))))
	119
441c920b	120	(defun skelrc-component ()
6d349e29	121	"Return a suitable a `This file is part of ...' line."
441c920b	122	(if (assq 'full-title skel-alist)
7fb0878b	123	"[[cont-comment]] This file is part of [[full-title]].
6d349e29	124	\[[cont-comment]]\n"
441c920b	125	""))
441c920b	126
52e478a2 MW	127	(defun skelrc-generic-gpl (&rest params)
	128	(setq skel-alist (append params skel-alist))
	129	(skelrc-prefix-and-reflow "[[cont-comment]] "
	130	"[[Short-name]] is free software: you can redistribute it and/or
	131	modify it under the terms of the GNU \[[gpl-qualifiers]]General
	132	Public License as published by the Free Software Foundation;
	133	either version [[gpl-version]] of the License, or (at your
	134	option) any later version.
	135
	136	\[[Short-name]] is distributed in the hope that it will be useful,
d18fb0e7	137	but WITHOUT ANY WARRANTY; without even the implied warranty of
52e478a2 MW	138	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
52e478a2 MW	139	\[[gpl-qualifiers]]General Public License for more details.
d18fb0e7	140
52e478a2 MW	141	You should have received a copy of the GNU
	142	\[[gpl-qualifiers]]General Public License along with
	143	\[[short-name]]. If not, [[gpl-find-licence]]"))
d18fb0e7	144
6d349e29 MW	145	(setq skelrc-bsd (skelrc-prefix-lines "[[cont-comment]] "
	146	"Copyright (c) [[year]] [[author]]
	147	All rights reserved.
	148
	149	Redistribution and use in source and binary forms, with or without
	150	modification, are permitted provided that the following conditions are
	151	met:
	152
	153	1. Redistributions of source code must retain the above copyright
	154	notice, this list of conditions and the following disclaimer.
	155
	156	2, Redistributions in binary form must reproduce the above copyright
	157	notice, this list of conditions and the following disclaimer in the
	158	documentation and/or other materials provided with the distribution.
	159
	160	3. The name of the authors may not be used to endorse or promote
	161	products derived from this software without specific prior written
	162	permission.
	163
	164	THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
	165	WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
	166	MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
	167	NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
	168	INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
	169	\(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
	170	SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
	171	HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
	172	STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	173	ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	174	POSSIBILITY OF SUCH DAMAGE.
	175
	176	Instead of accepting the above terms, you may redistribute and/or modify
	177	this software under the terms of either the GNU General Public License,
	178	or the GNU Library General Public License, published by the Free
	179	Software Foundation; either version 2 of the License, or (at your
	180	option) any later version."))
0237168a	181
7fb0878b	182	(defun skel-basename ()
	183	(file-name-sans-extension (file-name-nondirectory buffer-file-name)))
	184
	185	(setq skel-alist
	186	(append
aaadf1ff MW	187	`((first-line . "[[new-comment]] --[[emacs-mode]]--")
aaadf1ff MW	188	(emacs-mode . (skelrc-decode-major-mode))
7fb0878b	189	(year . (substring (current-time-string) 20 24))
86ec878d	190	(header . "[[licence]][[preamble]]")
7fb0878b	191	(basename . (skel-basename))
a6ca2716 MW	192	(licence . ,(concat "[[licence-banner]]\n"
	193	"[[cont-comment]]\n"
	194	"[[component]][[licence-text]]"
	195	"[[block-end]]\n\n"))
7fb0878b	196	(licence-banner . (skelrc-banner "Licensing notice" t))
441c920b	197	(component . (skelrc-component))
7fb0878b	198	(licence-text . "[[gpl]]")
fb0894ef	199	(fill-column . "70")
52e478a2 MW	200	(Short-name . (or (skelrc-assq 'Library skel-alist)
	201	(skelrc-assq 'library skel-alist)
	202	(skelrc-assq 'Program skel-alist)
	203	(skelrc-assq 'program skel-alist)
	204	"This [[thing]]"))
	205	(short-name . (or (skelrc-assq 'library skel-alist)
	206	(skelrc-assq 'program skel-alist)
	207	"this [[thing]]"))
	208	(generic-gpl . (skelrc-generic-gpl))
6b737432 MW	209	(gnu-temple-place . (concat "write to the "
	210	"Free Software Foundation, Inc., "
	211	"59 Temple Place - Suite 330, "
52e478a2 MW	212	"Boston, MA 02111-1307, USA."))
	213	(gnu-website . "see <https://www.gnu.org/licenses/>.")
	214	(gpl-2 . (skelrc-generic-gpl '(gpl-version . "2")
	215	'(gpl-qualifiers . "")
	216	'(gpl-find-licence
	217	. "[[gnu-temple-place]]")
	218	'(thing . "program")))
	219	(gpl-3 . (skelrc-generic-gpl '(gpl-version . "3")
	220	'(gpl-qualifiers . "")
	221	'(gpl-find-licence
	222	. "[[gnu-website]]")
	223	'(thing . "program")))
	224	(lgpl-2 . (skelrc-generic-gpl '(gpl-version . "2")
	225	'(gpl-qualifiers . "Library ")
	226	'(gpl-find-licence
	227	. "[[gnu-temple-place]]")
	228	'(thing . "library")))
	229	(lgpl-2.1 . (skelrc-generic-gpl '(gpl-version . "2.1")
	230	'(gpl-qualifiers . "Lesser ")
	231	'(gpl-find-licence
	232	. "[[gnu-temple-place]]")
	233	'(thing . "library")))
	234	(lgpl-3 . (skelrc-generic-gpl '(gpl-version . "3")
	235	'(gpl-qualifiers . "Lesser ")
	236	'(gpl-find-licence
	237	. "[[gnu-website]]")
	238	'(thing . "library")))
	239	(agpl-3 . (skelrc-generic-gpl '(gpl-version . "3")
	240	'(gpl-qualifiers . "Affero ")
	241	'(gpl-find-licence
	242	. "[[gnu-website]]")
	243	'(thing . "program")))
	244	(gpl . "[[gpl-2]]")
	245	(wide-gpl . "[[gpl-2]]")
	246	(lgpl . "[[lgpl-2]]")
	247	(agpl . "[[agpl-3]]")
0237168a	248	(bsd . skelrc-bsd)
a6ca2716 MW	249	(revisions . ,(concat "[[revision-banner]]\n"
	250	"[[cont-comment]]\n"
	251	"[[cont-comment]] $Log$"
	252	"[[block-end]]\n\n"))
7fb0878b	253	(revision-banner . (skelrc-banner "Revision history" t))
7fb0878b	254	(preamble . "")
28330371	255	(trailer . "[[tag-line]]\n[[postamble]]")
7fb0878b	256	(postamble . "")
	257	(tag-line . (skelrc-banner "That's all, folks"))
	258	(block-start . (skel-lookup 'new-comment))
	259	(block-banner-knob . "")
	260	(block-banner-end . "")
	261	(block-end . ""))
	262	skel-alist))