| 1 | ;;; -*-emacs-lisp-*- |
| 2 | |
| 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 | |
| 11 | (defun skelrc-strip-trailing-whitespace (string) |
| 12 | "Return STRING, but with trailing whitespace removed. |
| 13 | |
| 14 | Whitespace characters are those with space syntax." |
| 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 | |
| 20 | (defun skelrc-banner (title &optional block) |
| 21 | "Return a comment banner with the given TITLE, and maybe a BLOCK of text." |
| 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))))) |
| 25 | (skelrc-strip-trailing-whitespace (concat start |
| 26 | "----- " |
| 27 | title |
| 28 | " " |
| 29 | (make-string barlen ?-) |
| 30 | end)))) |
| 31 | |
| 32 | (defvar skelrc-forced-major-mode 0 |
| 33 | "The priority of the currently forced major mode") |
| 34 | |
| 35 | (defun skelrc-force-mode (new-mode &optional priority) |
| 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'." |
| 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 () |
| 54 | "Return the mode dropping to put in a local-variables line." |
| 55 | (let* ((name (symbol-name major-mode)) |
| 56 | (endind (string-match "-mode$" name))) |
| 57 | (if endind (substring name 0 endind) |
| 58 | (name)))) |
| 59 | |
| 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))) |
| 63 | (and val (cdr val)))) |
| 64 | |
| 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 | |
| 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 | |
| 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) |
| 109 | (fill-column (+ col (length expanded-prefix)))) |
| 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 | |
| 120 | (defun skelrc-component () |
| 121 | "Return a suitable a `This file is part of ...' line." |
| 122 | (if (assq 'full-title skel-alist) |
| 123 | "[[cont-comment]] This file is part of [[full-title]]. |
| 124 | \[[cont-comment]]\n" |
| 125 | "")) |
| 126 | |
| 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, |
| 137 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 138 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 139 | \[[gpl-qualifiers]]General Public License for more details. |
| 140 | |
| 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]]")) |
| 144 | |
| 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.")) |
| 181 | |
| 182 | (defun skel-basename () |
| 183 | (file-name-sans-extension (file-name-nondirectory buffer-file-name))) |
| 184 | |
| 185 | (setq skel-alist |
| 186 | (append |
| 187 | `((first-line . "[[new-comment]] -*-[[emacs-mode]]-*-") |
| 188 | (emacs-mode . (skelrc-decode-major-mode)) |
| 189 | (year . (substring (current-time-string) 20 24)) |
| 190 | (header . "[[licence]][[preamble]]") |
| 191 | (basename . (skel-basename)) |
| 192 | (licence . ,(concat "[[licence-banner]]\n" |
| 193 | "[[cont-comment]]\n" |
| 194 | "[[component]][[licence-text]]" |
| 195 | "[[block-end]]\n\n")) |
| 196 | (licence-banner . (skelrc-banner "Licensing notice" t)) |
| 197 | (component . (skelrc-component)) |
| 198 | (licence-text . "[[gpl]]") |
| 199 | (fill-column . "70") |
| 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)) |
| 209 | (gnu-temple-place . (concat "write to the " |
| 210 | "Free Software Foundation, Inc., " |
| 211 | "59 Temple Place - Suite 330, " |
| 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]]") |
| 248 | (bsd . skelrc-bsd) |
| 249 | (revisions . ,(concat "[[revision-banner]]\n" |
| 250 | "[[cont-comment]]\n" |
| 251 | "[[cont-comment]] $Log$" |
| 252 | "[[block-end]]\n\n")) |
| 253 | (revision-banner . (skelrc-banner "Revision history" t)) |
| 254 | (preamble . "") |
| 255 | (trailer . "[[tag-line]]\n[[postamble]]") |
| 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)) |