Mercurial > hg > xemacs-beta
annotate lisp/lisp-mnt.el @ 5560:58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
src/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* alloc.c:
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT_1):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (cons_print_preprocess):
* alloc.c (vector_print_preprocess):
* alloc.c (vector_nsubst_structures_descend):
* alloc.c (Fmake_symbol):
* alloc.c (UNMARK_symbol):
* alloc.c (sweep_symbols):
* alloc.c (reinit_alloc_objects_early):
* alloc.c (reinit_alloc_early):
* bytecode.c:
* bytecode.c (compiled_function_print_preprocess):
* bytecode.c (compiled_function_nsubst_structures_descend):
* bytecode.c (set_compiled_function_arglist):
* bytecode.c (set_compiled_function_interactive):
* bytecode.c (bytecode_objects_create):
* chartab.c:
* chartab.c (print_preprocess_mapper):
* chartab.c (nsubst_structures_mapper):
* chartab.c (char_table_nsubst_structures_descend):
* chartab.c (chartab_objects_create):
* elhash.c:
* elhash.c (nsubst_structures_map_hash_table):
* elhash.c (hash_table_nsubst_structures_descend):
* elhash.c (print_preprocess_mapper):
* elhash.c (hash_table_print_preprocess):
* elhash.c (inchash_eq):
* elhash.c (hash_table_objects_create):
* elhash.c (syms_of_elhash):
* elhash.h:
* emacs.c (main_1):
* fns.c:
* fns.c (check_eq_nokey):
* fns.c (Fnsubst):
* fns.c (syms_of_fns):
* lisp.h:
* lisp.h (struct Lisp_Symbol):
* lisp.h (IN_OBARRAY):
* lisp.h (struct):
* lisp.h (PRINT_PREPROCESS):
* lread.c (read1):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* print.c:
* print.c (PRINT_CIRCLE_LIMIT):
* print.c (print_continuous_numbering_changed):
* print.c (print_prepare):
* print.c (print_finish):
* print.c (Fprin1_to_string):
* print.c (print_cons):
* print.c (print_preprocess_inchash_eq):
* print.c (print_preprocess):
* print.c (print_sort_get_numbers):
* print.c (print_sort_compare_ordinals):
* print.c (print_gensym_or_circle):
* print.c (nsubst_structures_descend):
* print.c (nsubst_structures):
* print.c (print_internal):
* print.c (print_symbol):
* print.c (vars_of_print):
* rangetab.c:
* rangetab.c (range_table_print_preprocess):
* rangetab.c (range_table_nsubst_structures_descend):
* rangetab.c (rangetab_objects_create):
* rangetab.c (syms_of_rangetab):
* symbols.c:
* symbols.c (symbol_print_preprocess):
* symbols.c (Fintern):
* symbols.c (Funintern):
* symbols.c (reinit_symbol_objects_early):
* symbols.c (init_symbols_once_early):
* symsinit.h:
Implement print-circle, printing circular structures in a readable
fashion, and treating them appropriately on read. This is by means
of two new object methods, print_preprocess (detecting
circularities), and nsubst_structures_descend (replacing
placeholders with the read objects).
Expose the substitution to Lisp via #'nsubst and its new
:descend-structures keyword.
Store information as to whether symbols are interned in obarray or
not in their header, making checking for keywords and uninterned
symbols (and thus printing) cheaper.
Default print_gensym to t, as Common Lisp does, and as a
more-than-decade old comment suggests.
lisp/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-output-file-form):
* bytecomp.el (byte-compile-output-docform):
Bind print-circle, print-continuous-numbering in these functions,
now those variables are available.
* lisp.el (forward-sexp):
* lisp.el (backward-sexp):
Recognise leading #N= as being part of an expression.
tests/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-reader-tests.el:
* automated/lisp-tests.el (literal-with-uninterned):
* automated/symbol-tests.el (foo):
Test print-circle, for printing (mutually-)recursive and circular
structures.
Bind print-continuous-numbering where appropriate.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 04 Sep 2011 19:51:35 +0100 |
| parents | 91b3aa59f49b |
| children | bbe4146603db |
| rev | line source |
|---|---|
| 428 | 1 ;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers |
| 2 | |
| 3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
| 6 ;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com> | |
| 7 ;; Created: 14 Jul 1992 | |
| 8 ;; Keywords: docs, maint | |
| 9 ;; X-Modified-by: Bob Weiner <weiner@beopen.com>, 4/14/95, to support | |
| 10 ;; InfoDock headers. | |
| 11 ;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! | |
| 12 | |
| 13 ;; This file is part of XEmacs. | |
| 14 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
15 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
16 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
17 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
18 ;; option) any later version. |
| 428 | 19 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
20 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
21 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
22 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
23 ;; for more details. |
| 428 | 24 |
| 25 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4633
diff
changeset
|
26 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 27 |
| 28 ;;; Synched up with: FSF 20.2. | |
| 29 | |
| 30 ;;; Commentary: | |
| 31 | |
| 32 ;; This minor mode adds some services to Emacs-Lisp editing mode. | |
| 33 ;; | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
34 ;; It provides knowledge about the header conventions for library packages. |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
35 ;; `lm-synopsis' supports generating synopses from a library directory. |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
36 ;; `lm-verify' can be used to check for missing headers in library files. |
| 428 | 37 ;; |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
38 ;; `lm-report-bug' automatically addresses bug mail to a package's |
| 428 | 39 ;; maintainer or author. |
| 40 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
41 ;; This file can be loaded by your lisp-mode-hook with `(require 'lisp-mnt)'. |
| 428 | 42 |
| 43 ;; This file is an example of the header conventions. Note the following | |
| 44 ;; features: | |
| 45 ;; | |
| 46 ;; * Header line --- makes it possible to extract a one-line summary of | |
| 47 ;; the package's uses automatically for use in library synopses, KWIC | |
| 48 ;; indexes and the like. | |
| 49 ;; | |
| 50 ;; Format is three semicolons, followed by the filename, followed by | |
| 51 ;; three dashes, followed by the summary. All fields space-separated. | |
| 52 ;; | |
| 53 ;; * Author line --- contains the name and net address of at least | |
| 54 ;; the principal author. | |
| 55 ;; | |
| 56 ;; If there are multiple authors, they should be listed on continuation | |
| 57 ;; lines led by ;;<TAB><TAB> (or multiple blanks), like this: | |
| 58 ;; | |
| 59 ;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu> | |
| 60 ;; ;; Dave Sill <de5@ornl.gov> | |
| 61 ;; ;; David Lawrence <tale@pawl.rpi.edu> | |
| 62 ;; ;; Noah Friedman <friedman@ai.mit.edu> | |
| 63 ;; ;; Joe Wells <jbw@maverick.uswest.com> | |
| 64 ;; ;; Dave Brennan <brennan@hal.com> | |
| 65 ;; ;; Eric Raymond <esr@snark.thyrsus.com> | |
| 66 ;; | |
| 67 ;; This field may have some special values; notably "FSF", meaning | |
| 68 ;; "Free Software Foundation". | |
| 69 ;; | |
| 70 ;; * Maintainer line --- should be a single name/address as in the Author | |
| 71 ;; line, or an address only, or the string "FSF". If there is no maintainer | |
| 72 ;; line, the person(s) in the Author field are presumed to be it. The example | |
| 73 ;; in this file is mildly bogus because the maintainer line is redundant. | |
| 74 ;; The idea behind these two fields is to be able to write a Lisp function | |
| 75 ;; that does "send mail to the author" without having to mine the name out by | |
| 76 ;; hand. Please be careful about surrounding the network address with <> if | |
| 77 ;; there's also a name in the field. | |
| 78 ;; | |
| 79 ;; * Created line --- optional, gives the original creation date of the | |
| 80 ;; file. For historical interest, basically. | |
| 81 ;; | |
| 82 ;; * Version line --- intended to give the reader a clue if they're looking | |
| 83 ;; at a different version of the file than the one they're accustomed to. This | |
| 84 ;; may be an RCS or SCCS header. | |
| 85 ;; | |
| 86 ;; * Adapted-By line --- this is for FSF's internal use. The person named | |
| 87 ;; in this field was the one responsible for installing and adapting the | |
| 88 ;; package for the distribution. (This file doesn't have one because the | |
| 89 ;; author *is* one of the maintainers.) | |
| 90 ;; | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
91 ;; * Keywords line --- used by the finder code (now direly bit-rotted) |
| 428 | 92 ;; for finding Emacs Lisp code related to a topic. |
| 93 ;; | |
| 94 ;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example | |
| 95 ;; of a comment header. Headers starting with `X-' should never be used | |
| 96 ;; for any real purpose; this is the way to safely add random headers | |
| 97 ;; without invoking the wrath of any program. | |
| 98 ;; | |
| 99 ;; * Commentary line --- enables Lisp code to find the developer's and | |
| 100 ;; maintainers' explanations of the package internals. | |
| 101 ;; | |
| 102 ;; * Change log line --- optional, exists to terminate the commentary | |
| 103 ;; section and start a change-log part, if one exists. | |
| 104 ;; | |
| 105 ;; * Code line --- exists so Lisp can know where commentary and/or | |
| 106 ;; change-log sections end. | |
| 107 ;; | |
| 108 ;; * Footer line --- marks end-of-file so it can be distinguished from | |
| 109 ;; an expanded formfeed or the results of truncation. | |
| 110 | |
| 111 ;;; Change Log: | |
| 112 | |
| 113 ;; Tue Jul 14 23:44:17 1992 ESR | |
| 114 ;; * Created. | |
| 115 | |
| 116 ;;; Code: | |
| 117 | |
| 118 (require 'picture) ; provides move-to-column-force | |
| 119 | |
| 120 ;;; Variables: | |
| 121 | |
| 122 (defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?" | |
| 123 "Prefix that is ignored before the tag. | |
| 124 For example, you can write the 1st line synopsis string and headers like this | |
| 125 in your Lisp package: | |
| 126 | |
| 127 ;; @(#) package.el -- package description | |
| 128 ;; | |
| 129 ;; @(#) $Maintainer: Person Foo Bar $ | |
| 130 | |
| 131 The @(#) construct is used by unix what(1) and | |
| 132 then $identifier: doc string $ is used by GNU ident(1)") | |
| 133 | |
| 134 (defvar lm-comment-column 16 | |
| 135 "Column used for placing formatted output.") | |
| 136 | |
| 137 (defvar lm-commentary-header "Commentary\\|Documentation" | |
| 138 "Regexp which matches start of documentation section.") | |
| 139 | |
| 140 (defvar lm-history-header "Change Log\\|History" | |
| 141 "Regexp which matches the start of code log section.") | |
| 142 | |
| 143 ;;; Functions: | |
| 144 | |
| 145 ;; These functions all parse the headers of the current buffer | |
| 146 | |
| 147 (defsubst lm-get-header-re (header &optional mode) | |
| 148 "Returns regexp for matching HEADER. | |
| 149 If called with optional MODE and with value `section', | |
| 150 return section regexp instead." | |
| 151 (cond ((eq mode 'section) | |
| 152 (concat "^;;;;* " header ":[ \t]*$")) | |
| 153 (t | |
| 154 (concat lm-header-prefix header ":[ \t]*")))) | |
| 155 | |
| 156 (defsubst lm-get-package-name () | |
| 157 "Returns package name by looking at the first line." | |
| 158 (save-excursion | |
| 159 (goto-char (point-min)) | |
| 160 (if (and (looking-at (concat lm-header-prefix)) | |
| 161 (progn (goto-char (match-end 0)) | |
| 162 (looking-at "\\([^\t ]+\\)") | |
| 163 (match-end 1))) | |
| 164 (buffer-substring (match-beginning 1) (match-end 1)) | |
| 165 ))) | |
| 166 | |
| 167 (defun lm-section-mark (header &optional after) | |
| 168 "Return the buffer location of a given section start marker. | |
| 169 The HEADER is the section mark string to search for. | |
| 170 If AFTER is non-nil, return the location of the next line." | |
| 171 (save-excursion | |
| 172 (let ((case-fold-search t)) | |
| 173 (goto-char (point-min)) | |
| 174 (if (re-search-forward (lm-get-header-re header 'section) nil t) | |
| 175 (progn | |
| 176 (beginning-of-line) | |
| 177 (if after (forward-line 1)) | |
| 178 (point)) | |
| 179 nil)))) | |
| 180 | |
| 181 (defsubst lm-code-mark () | |
| 182 "Return the buffer location of the `Code' start marker." | |
| 183 (lm-section-mark "Code")) | |
| 184 | |
| 185 (defsubst lm-commentary-mark () | |
| 186 "Return the buffer location of the `Commentary' start marker." | |
| 187 (lm-section-mark lm-commentary-header)) | |
| 188 | |
| 189 (defsubst lm-history-mark () | |
| 190 "Return the buffer location of the `History' start marker." | |
| 191 (lm-section-mark lm-history-header)) | |
| 192 | |
| 193 (defun lm-header (header) | |
| 194 "Return the contents of the header named HEADER." | |
| 195 (goto-char (point-min)) | |
| 196 (let ((case-fold-search t)) | |
| 197 (if (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t) | |
| 198 ;; RCS ident likes format "$identifier: data$" | |
| 199 (looking-at "\\([^$\n]+\\)") | |
| 200 (match-end 1)) | |
| 201 (buffer-substring (match-beginning 1) (match-end 1)) | |
| 202 nil))) | |
| 203 | |
| 204 (defun lm-header-multiline (header) | |
| 205 "Return the contents of the header named HEADER, with continuation lines. | |
| 206 The returned value is a list of strings, one per line." | |
| 207 (save-excursion | |
| 208 (goto-char (point-min)) | |
| 209 (let ((res (lm-header header))) | |
| 210 (cond | |
| 211 (res | |
| 212 (setq res (list res)) | |
| 213 (forward-line 1) | |
| 214 | |
| 215 (while (and (looking-at (concat lm-header-prefix "[\t ]+")) | |
| 216 (progn | |
| 217 (goto-char (match-end 0)) | |
| 218 (looking-at "\\(.*\\)")) | |
| 219 (match-end 1)) | |
| 220 (setq res (cons (buffer-substring | |
| 221 (match-beginning 1) | |
| 222 (match-end 1)) | |
| 223 res)) | |
| 224 (forward-line 1)) | |
| 225 )) | |
| 226 res | |
| 227 ))) | |
| 228 | |
| 229 ;; These give us smart access to the header fields and commentary | |
| 230 | |
| 231 (defun lm-summary (&optional file) | |
| 232 "Return the one-line summary of file FILE, or current buffer if FILE is nil." | |
| 233 (save-excursion | |
| 234 (if file | |
| 235 (find-file file)) | |
| 236 (goto-char (point-min)) | |
| 237 (prog1 | |
| 238 (if (and | |
| 239 (looking-at lm-header-prefix) | |
| 240 (progn (goto-char (match-end 0)) | |
| 241 (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)"))) | |
| 242 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 243 (if file | |
| 244 (kill-buffer (current-buffer))) | |
| 245 ))) | |
| 246 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
247 ;; #### This should be replaced by a call into mail-lib. |
| 428 | 248 (defun lm-crack-address (x) |
| 249 "Split up an email address into full name and real email address. | |
| 250 The value is a cons of the form (FULLNAME . ADDRESS)." | |
| 251 (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) | |
| 252 (cons (substring x (match-beginning 1) (match-end 1)) | |
| 253 (substring x (match-beginning 2) (match-end 2)))) | |
| 254 ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) | |
| 255 (cons (substring x (match-beginning 2) (match-end 2)) | |
| 256 (substring x (match-beginning 1) (match-end 1)))) | |
| 257 ((string-match "\\S-+@\\S-+" x) | |
| 258 (cons nil x)) | |
| 259 (t | |
| 260 (cons x nil)))) | |
| 261 | |
| 262 (defun lm-authors (&optional file) | |
| 263 "Return the author list of file FILE, or current buffer if FILE is nil. | |
| 264 Each element of the list is a cons; the car is the full name, | |
| 265 the cdr is an email address." | |
| 266 (save-excursion | |
| 267 (if file | |
| 268 (find-file file)) | |
| 269 ;; XEmacs change (Is E-MAIL an infodock header? -sb) | |
| 270 (let* ((authorlist (lm-header-multiline "author")) | |
| 271 (email-list (lm-header-multiline "E-MAIL")) | |
| 272 (authors authorlist)) | |
| 273 (prog1 | |
| 274 (if (null email-list) | |
| 275 (mapcar 'lm-crack-address authorlist) | |
| 276 (while (and email-list authors) | |
| 277 (setcar authors (cons (car authors) (car email-list))) | |
| 278 (setq email-list (cdr email-list) | |
| 279 authors (cdr authors))) | |
| 280 authorlist) | |
| 281 (if file | |
| 282 (kill-buffer (current-buffer)))) | |
| 283 ))) | |
| 284 | |
| 285 (defun lm-maintainer (&optional file) | |
| 286 "Return the maintainer of file FILE, or current buffer if FILE is nil. | |
| 287 The return value has the form (NAME . ADDRESS)." | |
| 288 (save-excursion | |
| 289 (if file | |
| 290 (find-file file)) | |
| 291 (prog1 | |
| 292 (let ((maint (lm-header "maintainer"))) | |
| 293 (if maint | |
| 294 (lm-crack-address maint) | |
| 295 (car (lm-authors)))) | |
| 296 (if file | |
| 297 (kill-buffer (current-buffer)))))) | |
| 298 | |
| 299 (defun lm-creation-date (&optional file) | |
| 300 "Return the created date given in file FILE, or current buffer if FILE is nil." | |
| 301 (save-excursion | |
| 302 (if file | |
| 303 (find-file file)) | |
| 304 (prog1 | |
| 305 ;; XEmacs change (Is ORIG-DATE an Infodock header? -sb) | |
| 306 (or (lm-header "created") | |
| 307 (let ((date-and-time (lm-header "ORIG-DATE"))) | |
| 308 (if date-and-time | |
| 309 (substring date-and-time 0 | |
| 310 (string-match " " date-and-time))))) | |
| 311 (if file | |
| 312 (kill-buffer (current-buffer))) | |
| 313 ))) | |
| 314 | |
| 315 (defun lm-last-modified-date (&optional file) | |
| 316 "Return the modify-date given in file FILE, or current buffer if FILE is nil." | |
| 317 (save-excursion | |
| 318 (if file | |
| 319 (find-file file)) | |
| 320 (prog1 | |
| 321 (if (progn | |
| 322 (goto-char (point-min)) | |
| 323 (re-search-forward | |
| 324 "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " | |
| 325 (lm-code-mark) t)) | |
| 326 (format "%s %s %s" | |
| 327 (buffer-substring (match-beginning 3) (match-end 3)) | |
| 328 (nth (string-to-int | |
| 329 (buffer-substring (match-beginning 2) (match-end 2))) | |
| 330 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" | |
| 331 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) | |
| 332 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 333 ;; XEmacs change (Infodock change? -sb) | |
| 334 (let ((date-and-time (lm-header "LAST-MOD"))) | |
| 335 (if date-and-time | |
| 336 (substring date-and-time 0 | |
| 337 (string-match " " date-and-time))))) | |
| 338 (if file | |
| 339 (kill-buffer (current-buffer))) | |
| 340 ))) | |
| 341 | |
| 342 (defun lm-version (&optional file) | |
| 343 "Return the version listed in file FILE, or current buffer if FILE is nil. | |
| 448 | 344 This can be found in an RCS or SCCS header to crack it out of." |
| 428 | 345 (save-excursion |
| 346 (if file | |
| 347 (find-file file)) | |
| 348 (prog1 | |
| 349 (or | |
| 350 (lm-header "version") | |
| 351 (let ((header-max (lm-code-mark))) | |
| 352 (goto-char (point-min)) | |
| 353 (cond | |
| 354 ;; Look for an RCS header | |
| 355 ((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t) | |
| 356 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 357 | |
| 358 ;; Look for an SCCS header | |
| 359 ((re-search-forward | |
| 360 (concat | |
| 361 (regexp-quote "@(#)") | |
| 362 (regexp-quote (file-name-nondirectory (buffer-file-name))) | |
| 363 "\t\\([012345679.]*\\)") | |
| 364 header-max t) | |
| 365 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 366 | |
| 367 (t nil)))) | |
| 368 (if file | |
| 369 (kill-buffer (current-buffer))) | |
| 370 ))) | |
| 371 | |
| 372 (defun lm-keywords (&optional file) | |
| 373 "Return the keywords given in file FILE, or current buffer if FILE is nil." | |
| 374 (save-excursion | |
| 375 (if file | |
| 376 (find-file file)) | |
| 377 (prog1 | |
| 378 (let ((keywords (lm-header "keywords"))) | |
| 379 (and keywords (downcase keywords))) | |
| 380 (if file | |
| 381 (kill-buffer (current-buffer))) | |
| 382 ))) | |
| 383 | |
| 384 (defun lm-adapted-by (&optional file) | |
| 385 "Return the adapted-by names in file FILE, or current buffer if FILE is nil. | |
| 386 This is the name of the person who cleaned up this package for | |
| 387 distribution." | |
| 388 (save-excursion | |
| 389 (if file | |
| 390 (find-file file)) | |
| 391 (prog1 | |
| 392 (lm-header "adapted-by") | |
| 393 (if file | |
| 394 (kill-buffer (current-buffer))) | |
| 395 ))) | |
| 396 | |
| 397 (defun lm-commentary (&optional file) | |
| 398 "Return the commentary in file FILE, or current buffer if FILE is nil. | |
| 399 The value is returned as a string. In the text, the commentary starts | |
| 400 with tag `Commentary' and ends with tag `Change Log' or `History'." | |
| 401 (save-excursion | |
| 402 (if file | |
| 403 (find-file file)) | |
| 404 (prog1 | |
| 405 (let ((commentary (lm-commentary-mark)) | |
| 406 (change-log (lm-history-mark)) | |
| 407 (code (lm-code-mark)) | |
| 408 end) | |
| 409 (cond | |
| 410 ((and commentary change-log) | |
| 411 (buffer-substring commentary change-log)) | |
| 412 ((and commentary code) | |
| 413 (buffer-substring commentary code)) | |
| 414 (t | |
| 415 ;; XEmacs change (Infodock headers? -sb) | |
| 416 (setq commentary (lm-section-mark "DESCRIPTION" t)) | |
| 417 (setq end (lm-section-mark "DESCRIP-END")) | |
| 418 (and commentary end (buffer-substring commentary end))))) | |
| 419 (if file | |
| 420 (kill-buffer (current-buffer))) | |
| 421 ))) | |
| 422 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
423 ;;; Utilities |
| 428 | 424 |
| 425 (defun lm-insert-at-column (col &rest strings) | |
| 426 "Insert list of STRINGS, at column COL." | |
| 427 (if (> (current-column) col) (insert "\n")) | |
| 428 (move-to-column-force col) | |
| 429 (apply 'insert strings)) | |
| 430 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
431 ;;; Entry points: verification, synopses, and bug reporting |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
432 |
| 428 | 433 (defun lm-verify (&optional file showok &optional verb) |
| 434 "Check that the current buffer (or FILE if given) is in proper format. | |
| 435 If FILE is a directory, recurse on its files and generate a report in | |
| 436 a temporary buffer." | |
| 437 (interactive) | |
| 438 (let* ((verb (or verb (interactive-p))) | |
| 439 ret | |
| 440 name | |
| 441 ) | |
| 442 (if verb | |
| 443 (setq ret "Ok.")) ;init value | |
| 444 | |
| 445 (if (and file (file-directory-p file)) | |
| 446 (setq | |
| 447 ret | |
| 448 (progn | |
| 449 (switch-to-buffer (get-buffer-create "*lm-verify*")) | |
| 450 (erase-buffer) | |
| 451 (mapcar | |
| 452 #'(lambda (f) | |
| 453 (if (string-match ".*\\.el$" f) | |
| 454 (let ((status (lm-verify f))) | |
| 455 (if status | |
| 456 (progn | |
| 457 (insert f ":") | |
| 458 (lm-insert-at-column lm-comment-column status "\n")) | |
| 459 (and showok | |
| 460 (progn | |
| 461 (insert f ":") | |
| 462 (lm-insert-at-column lm-comment-column "OK\n"))))))) | |
| 463 (directory-files file)) | |
| 464 )) | |
| 465 (save-excursion | |
| 466 (if file | |
| 467 (find-file file)) | |
| 468 (setq name (lm-get-package-name)) | |
| 469 | |
| 470 (setq | |
| 471 ret | |
| 472 (prog1 | |
| 473 (cond | |
| 474 ((null name) | |
| 475 "Can't find a package NAME") | |
| 476 | |
| 477 ((not (lm-authors)) | |
| 478 "Author: tag missing.") | |
| 479 | |
| 480 ((not (lm-maintainer)) | |
| 481 "Maintainer: tag missing.") | |
| 482 | |
| 483 ((not (lm-summary)) | |
| 484 "Can't find a one-line 'Summary' description") | |
| 485 | |
| 486 ((not (lm-keywords)) | |
| 487 "Keywords: tag missing.") | |
| 488 | |
| 489 ((not (lm-commentary-mark)) | |
| 490 "Can't find a 'Commentary' section marker.") | |
| 491 | |
| 492 ((not (lm-history-mark)) | |
| 493 "Can't find a 'History' section marker.") | |
| 494 | |
| 495 ((not (lm-code-mark)) | |
| 496 "Can't find a 'Code' section marker") | |
| 497 | |
| 498 ((progn | |
| 499 (goto-char (point-max)) | |
| 500 (not | |
| 501 (re-search-backward | |
| 502 (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$" | |
| 503 "\\|^;;;[ \t]+ End of file[ \t]+" name) | |
| 504 nil t | |
| 505 ))) | |
| 506 (format "Can't find a footer line for [%s]" name)) | |
| 507 (t | |
| 508 ret)) | |
| 509 (if file | |
| 510 (kill-buffer (current-buffer))) | |
| 511 )))) | |
| 512 (if verb | |
| 513 (message ret)) | |
| 514 ret | |
| 515 )) | |
| 516 | |
| 517 (defun lm-synopsis (&optional file showall) | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
518 "Generate a synopsis listing for FILE, defaulting to the visited file. |
| 428 | 519 If FILE is a directory, recurse on its files and generate a report in |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
520 a temporary buffer. If optional SHOWALL is non-nil, also generate a line |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
521 for files which do not include a recognizable synopsis. Interactively, |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
522 to specify the current directory, remove the trailing slash from the default |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
523 string. Interactively, SHOWALL is taken from the prefix argument." |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
524 (interactive "FSynopsis for (file or dir): \nP") |
| 428 | 525 |
| 526 (if (and file (file-directory-p file)) | |
| 527 (progn | |
| 528 (switch-to-buffer (get-buffer-create "*lm-verify*")) | |
| 529 (erase-buffer) | |
| 530 (mapcar | |
| 531 (lambda (f) ; XEmacs - dequote | |
| 532 (if (string-match ".*\\.el$" f) | |
| 533 (let ((syn (lm-synopsis f))) | |
| 534 (if syn | |
| 535 (progn | |
| 536 (insert f ":") | |
| 537 (lm-insert-at-column lm-comment-column syn "\n")) | |
| 538 (and showall | |
| 539 (progn | |
| 540 (insert f ":") | |
| 541 (lm-insert-at-column lm-comment-column "NA\n"))))))) | |
| 542 (directory-files file)) | |
| 543 ) | |
| 544 (save-excursion | |
| 545 (if file | |
| 546 (find-file file)) | |
| 547 (prog1 | |
| 548 (lm-summary) | |
| 549 (if file | |
| 550 (kill-buffer (current-buffer))) | |
| 551 )))) | |
| 552 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
553 ;; #### This should call out to `report-xemacs-bug'. |
| 428 | 554 (defun lm-report-bug (topic) |
| 555 "Report a bug in the package currently being visited to its maintainer. | |
| 556 Prompts for bug subject. Leaves you in a mail buffer." | |
| 557 (interactive "sBug Subject: ") | |
| 558 (let ((package (lm-get-package-name)) | |
| 559 (addr (lm-maintainer)) | |
| 560 (version (lm-version))) | |
| 776 | 561 (if-fboundp 'mail |
| 562 (mail nil | |
| 563 (if addr | |
| 564 (concat (car addr) " <" (cdr addr) ">") | |
| 565 (or (and-boundp 'report-xemacs-bug-beta-address | |
| 566 report-xemacs-bug-beta-address) | |
| 567 "<xemacs-beta@xemacs.org>")) | |
| 568 topic) | |
| 569 (error 'unimplemented "No mail package available")) | |
| 428 | 570 (goto-char (point-max)) |
| 571 (insert "\nIn " | |
| 572 package | |
| 573 (if version (concat " version " version) "") | |
| 574 "\n\n") | |
| 575 (message | |
| 576 (substitute-command-keys "Type \\[mail-send] to send bug report.")))) | |
| 577 | |
|
4633
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
578 ;;; Entry point: insert boilerplate |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
579 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
580 (defconst lm-standard-permission |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
581 "\n;; This file is part of XEmacs. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
582 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
583 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
584 ;; under the terms of the GNU General Public License as published by the |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
585 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
586 ;; option) any later version. |
|
4633
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
587 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
588 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
589 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
590 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
591 ;; for more details. |
|
4633
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
592 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
593 ;; You should have received a copy of the GNU General Public License |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
594 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.\n" |
|
4633
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
595 "Standard permissions notice for Lisp files that are part of XEmacs. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
596 License version and FSF address are current as of 2009-04-01.") |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
597 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
598 (defconst lm-change-log |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
599 "\n;;; Change Log: |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
600 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
601 ;; %s %s <%s> |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
602 ;; |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
603 ;; * Created.\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
604 "GNU standard change-log template.") |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
605 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
606 (defconst lm-boilerplate |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
607 ";;; %s --- %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
608 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
609 ;; Copyright (C) %s %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
610 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
611 ;; Author: %s <%s> |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
612 ;; Created: %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
613 ;; Keywords: %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
614 %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
615 ;;; Synched up with: Not in GNU. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
616 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
617 ;;; Commentary: |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
618 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
619 ;; PLACE YOUR COMMENTARY (DESCRIPTION OF THE LIBRARY'S CONTENTS AND FUNCTION) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
620 ;; IN THIS SECTION. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
621 %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
622 ;;; Code:\n\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
623 "lisp-mnt standard boilerplate.") |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
624 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
625 ;; #### Need to improve the interactive declaration. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
626 ;; #### Need to check for existing boilerplate. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
627 (defun lm-insert-boilerplate (file synopsis permission author email keys log) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
628 "Insert lisp-mnt standard header and footer. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
629 FILE is the file name of the library. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
630 SYNOPSIS is a one line description of the file. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
631 Total length of FILE and SYNOPSIS should be less than 70 characters. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
632 PERMISSION, if non-nil, means to use a simple \"All Rights Reserved.\" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
633 Otherwise, the standard boilerplate for XEmacs sources is inserted. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
634 AUTHOR is the name of the author, defaulting to `user-full-name'. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
635 EMAIL is the contact email address, defaulting to `user-mail-address'. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
636 KEYS is a comma-separated list of finder keywords. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
637 LOG, if non-nil, means to insert a Change Log section. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
638 Otherwise, it will be omitted." |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
639 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
640 (interactive "FName of file: \nsSynopsis: \nP\nsAuthor: \nsEmail: |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
641 sKeywords: \ncInsert a Change Log section? (y/n)") |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
642 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
643 (save-restriction |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
644 (widen) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
645 (let ((file (file-name-nondirectory file)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
646 (year (format-time-string "%Y")) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
647 (date (format-time-string "%Y-%m-%d")) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
648 (author (if (> (length author) 0) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
649 author |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
650 user-full-name)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
651 (email (if (> (length email) 0) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
652 email |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
653 user-mail-address)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
654 (log (eql (upcase log) ?Y))) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
655 (goto-char (point-min)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
656 (insert (format lm-boilerplate |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
657 file synopsis |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
658 year author |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
659 author email |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
660 date |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
661 keys |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
662 (if permission |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
663 "\n;; All Rights Reserved.\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
664 lm-standard-permission) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
665 (if log |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
666 (format lm-change-log date author email) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
667 ""))) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
668 (goto-char (point-max)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
669 (insert (format "\n;;; %s ends here\n" file))))) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
670 |
| 428 | 671 (provide 'lisp-mnt) |
| 672 | |
| 673 ;;; lisp-mnt.el ends here |