Mercurial > hg > xemacs-beta
annotate lisp/lisp-mnt.el @ 4906:6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* cl-extra.el:
* cl-extra.el (cl-string-vector-equalp): Removed.
* cl-extra.el (cl-bit-vector-vector-equalp): Removed.
* cl-extra.el (cl-vector-array-equalp): Removed.
* cl-extra.el (cl-hash-table-contents-equalp): Removed.
* cl-extra.el (equalp): Removed.
* cl-extra.el (cl-mapcar-many):
Comment out the whole `equalp' implementation for the moment;
remove once we're sure the C implementation works.
* cl-macs.el:
* cl-macs.el (equalp):
Simplify the compiler-macro for `equalp' -- once it's in C,
we don't need to try so hard to expand it.
src/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* abbrev.c (abbrev_match_mapper):
* buffer.h (CANON_TABLE_OF):
* buffer.h:
* editfns.c (Fchar_equal):
* minibuf.c (scmp_1):
* text.c (qxestrcasecmp_i18n):
* text.c (qxestrncasecmp_i18n):
* text.c (qxetextcasecmp):
* text.c (qxetextcasecmp_matching):
Create new macro CANONCASE that converts to a canonical mapping
and use it to do caseless comparisons instead of DOWNCASE.
* alloc.c:
* alloc.c (cons_equal):
* alloc.c (vector_equal):
* alloc.c (string_equal):
* bytecode.c (compiled_function_equal):
* chartab.c (char_table_entry_equal):
* chartab.c (char_table_equal):
* data.c (weak_list_equal):
* data.c (weak_box_equal):
* data.c (ephemeron_equal):
* device-msw.c (equal_devmode):
* elhash.c (hash_table_equal):
* events.c (event_equal):
* extents.c (properties_equal):
* extents.c (extent_equal):
* faces.c:
* faces.c (face_equal):
* faces.c (face_hash):
* floatfns.c (float_equal):
* fns.c:
* fns.c (bit_vector_equal):
* fns.c (plists_differ):
* fns.c (Fplists_eq):
* fns.c (Fplists_equal):
* fns.c (Flax_plists_eq):
* fns.c (Flax_plists_equal):
* fns.c (internal_equal):
* fns.c (internal_equalp):
* fns.c (internal_equal_0):
* fns.c (syms_of_fns):
* glyphs.c (image_instance_equal):
* glyphs.c (glyph_equal):
* glyphs.c (glyph_hash):
* gui.c (gui_item_equal):
* lisp.h:
* lrecord.h (struct lrecord_implementation):
* marker.c (marker_equal):
* number.c (bignum_equal):
* number.c (ratio_equal):
* number.c (bigfloat_equal):
* objects.c (color_instance_equal):
* objects.c (font_instance_equal):
* opaque.c (equal_opaque):
* opaque.c (equal_opaque_ptr):
* rangetab.c (range_table_equal):
* specifier.c (specifier_equal):
Add a `foldcase' param to the equal() method and use it to implement
`equalp' comparisons. Also add to plists_differ(), although we
don't currently use it here.
Rewrite internal_equalp(). Implement cross-type vector comparisons.
Don't implement our own handling of numeric promotion -- just use
the `=' primitive.
Add internal_equal_0(), which takes a `foldcase' param and calls
either internal_equal() or internal_equalp().
* buffer.h:
When given a 0 for buffer (which is the norm when functions don't
have a specific buffer available), use the current buffer's table,
not `standard-case-table'; otherwise the current settings are
ignored.
* casetab.c:
* casetab.c (set_case_table):
When handling old-style vectors of 256 in `set-case-table' don't
overwrite the existing table! Instead create a new table and
populate.
* device-msw.c (sync_printer_with_devmode):
* lisp.h:
* text.c (lisp_strcasecmp_ascii):
Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use
lisp_strcasecmp_i18n for caseless comparisons in some places.
* elhash.c:
Delete unused lisp_string_hash and lisp_string_equal().
* events.h:
* keymap-buttons.h:
* keymap.h:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_store):
* keymap.c (FROB):
* keymap.c (key_desc_list_to_event):
* keymap.c (describe_map_mapper):
* keymap.c (INCLUDE_BUTTON_ZERO):
New file keymap-buttons.h; use to handle buttons 1-26 in place of
duplicating code 26 times.
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-msw.c (mswindows_init_frame_1):
Fix some comments about internal_equal() in redisplay that don't
apply any more.
* keymap-slots.h:
* keymap.c:
New file keymap-slots.h. Use it to notate the slots in a keymap
structure, similar to frameslots.h or coding-system-slots.h.
* keymap.c (MARKED_SLOT):
* keymap.c (keymap_equal):
* keymap.c (keymap_hash):
Implement.
tests/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* automated/case-tests.el:
* automated/case-tests.el (uni-mappings):
* automated/search-tests.el:
Delete old pristine-case-table code. Rewrite the Unicode torture
test to take into account whether overlapping mappings exist for
more than one character, and not doing the upcase/downcase
comparisons in such cases.
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (string-variable):
* automated/lisp-tests.el (featurep):
Replace Assert (equal ... with Assert-equal; same for other types
of equality. Replace some awkward equivalents of Assert-equalp
with Assert-equalp. Add lots of equalp tests.
* automated/case-tests.el:
* automated/regexp-tests.el:
* automated/search-tests.el:
Fix up the comments at the top of the files. Move rules about where
to put tests into case-tests.el.
* automated/test-harness.el:
* automated/test-harness.el (test-harness-aborted-summary-template): New.
* automated/test-harness.el (test-harness-from-buffer):
* automated/test-harness.el (batch-test-emacs):
Fix Assert-test-not. Create Assert-not-equal and variants.
Delete the doc strings from all these convenience functions to avoid
excessive repetition; instead use one copy in a comment.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 01 Feb 2010 01:02:40 -0600 |
| parents | 199ecf2503c8 |
| children | 308d34e9f07d |
| 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 | |
| 15 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 16 ;; under the terms of the GNU General Public License as published by | |
| 17 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 18 ;; any later version. | |
| 19 | |
| 20 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 23 ;; General Public License for more details. | |
| 24 | |
| 25 ;; You should have received a copy of the GNU General Public License | |
| 26 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
|
4630
64e5e393f15d
Update FSF address in permissions notice.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
776
diff
changeset
|
27 ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
64e5e393f15d
Update FSF address in permissions notice.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
776
diff
changeset
|
28 ;; Boston, MA 02110-1301, USA. |
| 428 | 29 |
| 30 ;;; Synched up with: FSF 20.2. | |
| 31 | |
| 32 ;;; Commentary: | |
| 33 | |
| 34 ;; This minor mode adds some services to Emacs-Lisp editing mode. | |
| 35 ;; | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
36 ;; 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
|
37 ;; `lm-synopsis' supports generating synopses from a library directory. |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
38 ;; `lm-verify' can be used to check for missing headers in library files. |
| 428 | 39 ;; |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
40 ;; `lm-report-bug' automatically addresses bug mail to a package's |
| 428 | 41 ;; maintainer or author. |
| 42 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
43 ;; This file can be loaded by your lisp-mode-hook with `(require 'lisp-mnt)'. |
| 428 | 44 |
| 45 ;; This file is an example of the header conventions. Note the following | |
| 46 ;; features: | |
| 47 ;; | |
| 48 ;; * Header line --- makes it possible to extract a one-line summary of | |
| 49 ;; the package's uses automatically for use in library synopses, KWIC | |
| 50 ;; indexes and the like. | |
| 51 ;; | |
| 52 ;; Format is three semicolons, followed by the filename, followed by | |
| 53 ;; three dashes, followed by the summary. All fields space-separated. | |
| 54 ;; | |
| 55 ;; * Author line --- contains the name and net address of at least | |
| 56 ;; the principal author. | |
| 57 ;; | |
| 58 ;; If there are multiple authors, they should be listed on continuation | |
| 59 ;; lines led by ;;<TAB><TAB> (or multiple blanks), like this: | |
| 60 ;; | |
| 61 ;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu> | |
| 62 ;; ;; Dave Sill <de5@ornl.gov> | |
| 63 ;; ;; David Lawrence <tale@pawl.rpi.edu> | |
| 64 ;; ;; Noah Friedman <friedman@ai.mit.edu> | |
| 65 ;; ;; Joe Wells <jbw@maverick.uswest.com> | |
| 66 ;; ;; Dave Brennan <brennan@hal.com> | |
| 67 ;; ;; Eric Raymond <esr@snark.thyrsus.com> | |
| 68 ;; | |
| 69 ;; This field may have some special values; notably "FSF", meaning | |
| 70 ;; "Free Software Foundation". | |
| 71 ;; | |
| 72 ;; * Maintainer line --- should be a single name/address as in the Author | |
| 73 ;; line, or an address only, or the string "FSF". If there is no maintainer | |
| 74 ;; line, the person(s) in the Author field are presumed to be it. The example | |
| 75 ;; in this file is mildly bogus because the maintainer line is redundant. | |
| 76 ;; The idea behind these two fields is to be able to write a Lisp function | |
| 77 ;; that does "send mail to the author" without having to mine the name out by | |
| 78 ;; hand. Please be careful about surrounding the network address with <> if | |
| 79 ;; there's also a name in the field. | |
| 80 ;; | |
| 81 ;; * Created line --- optional, gives the original creation date of the | |
| 82 ;; file. For historical interest, basically. | |
| 83 ;; | |
| 84 ;; * Version line --- intended to give the reader a clue if they're looking | |
| 85 ;; at a different version of the file than the one they're accustomed to. This | |
| 86 ;; may be an RCS or SCCS header. | |
| 87 ;; | |
| 88 ;; * Adapted-By line --- this is for FSF's internal use. The person named | |
| 89 ;; in this field was the one responsible for installing and adapting the | |
| 90 ;; package for the distribution. (This file doesn't have one because the | |
| 91 ;; author *is* one of the maintainers.) | |
| 92 ;; | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
93 ;; * Keywords line --- used by the finder code (now direly bit-rotted) |
| 428 | 94 ;; for finding Emacs Lisp code related to a topic. |
| 95 ;; | |
| 96 ;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example | |
| 97 ;; of a comment header. Headers starting with `X-' should never be used | |
| 98 ;; for any real purpose; this is the way to safely add random headers | |
| 99 ;; without invoking the wrath of any program. | |
| 100 ;; | |
| 101 ;; * Commentary line --- enables Lisp code to find the developer's and | |
| 102 ;; maintainers' explanations of the package internals. | |
| 103 ;; | |
| 104 ;; * Change log line --- optional, exists to terminate the commentary | |
| 105 ;; section and start a change-log part, if one exists. | |
| 106 ;; | |
| 107 ;; * Code line --- exists so Lisp can know where commentary and/or | |
| 108 ;; change-log sections end. | |
| 109 ;; | |
| 110 ;; * Footer line --- marks end-of-file so it can be distinguished from | |
| 111 ;; an expanded formfeed or the results of truncation. | |
| 112 | |
| 113 ;;; Change Log: | |
| 114 | |
| 115 ;; Tue Jul 14 23:44:17 1992 ESR | |
| 116 ;; * Created. | |
| 117 | |
| 118 ;;; Code: | |
| 119 | |
| 120 (require 'picture) ; provides move-to-column-force | |
| 121 | |
| 122 ;;; Variables: | |
| 123 | |
| 124 (defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?" | |
| 125 "Prefix that is ignored before the tag. | |
| 126 For example, you can write the 1st line synopsis string and headers like this | |
| 127 in your Lisp package: | |
| 128 | |
| 129 ;; @(#) package.el -- package description | |
| 130 ;; | |
| 131 ;; @(#) $Maintainer: Person Foo Bar $ | |
| 132 | |
| 133 The @(#) construct is used by unix what(1) and | |
| 134 then $identifier: doc string $ is used by GNU ident(1)") | |
| 135 | |
| 136 (defvar lm-comment-column 16 | |
| 137 "Column used for placing formatted output.") | |
| 138 | |
| 139 (defvar lm-commentary-header "Commentary\\|Documentation" | |
| 140 "Regexp which matches start of documentation section.") | |
| 141 | |
| 142 (defvar lm-history-header "Change Log\\|History" | |
| 143 "Regexp which matches the start of code log section.") | |
| 144 | |
| 145 ;;; Functions: | |
| 146 | |
| 147 ;; These functions all parse the headers of the current buffer | |
| 148 | |
| 149 (defsubst lm-get-header-re (header &optional mode) | |
| 150 "Returns regexp for matching HEADER. | |
| 151 If called with optional MODE and with value `section', | |
| 152 return section regexp instead." | |
| 153 (cond ((eq mode 'section) | |
| 154 (concat "^;;;;* " header ":[ \t]*$")) | |
| 155 (t | |
| 156 (concat lm-header-prefix header ":[ \t]*")))) | |
| 157 | |
| 158 (defsubst lm-get-package-name () | |
| 159 "Returns package name by looking at the first line." | |
| 160 (save-excursion | |
| 161 (goto-char (point-min)) | |
| 162 (if (and (looking-at (concat lm-header-prefix)) | |
| 163 (progn (goto-char (match-end 0)) | |
| 164 (looking-at "\\([^\t ]+\\)") | |
| 165 (match-end 1))) | |
| 166 (buffer-substring (match-beginning 1) (match-end 1)) | |
| 167 ))) | |
| 168 | |
| 169 (defun lm-section-mark (header &optional after) | |
| 170 "Return the buffer location of a given section start marker. | |
| 171 The HEADER is the section mark string to search for. | |
| 172 If AFTER is non-nil, return the location of the next line." | |
| 173 (save-excursion | |
| 174 (let ((case-fold-search t)) | |
| 175 (goto-char (point-min)) | |
| 176 (if (re-search-forward (lm-get-header-re header 'section) nil t) | |
| 177 (progn | |
| 178 (beginning-of-line) | |
| 179 (if after (forward-line 1)) | |
| 180 (point)) | |
| 181 nil)))) | |
| 182 | |
| 183 (defsubst lm-code-mark () | |
| 184 "Return the buffer location of the `Code' start marker." | |
| 185 (lm-section-mark "Code")) | |
| 186 | |
| 187 (defsubst lm-commentary-mark () | |
| 188 "Return the buffer location of the `Commentary' start marker." | |
| 189 (lm-section-mark lm-commentary-header)) | |
| 190 | |
| 191 (defsubst lm-history-mark () | |
| 192 "Return the buffer location of the `History' start marker." | |
| 193 (lm-section-mark lm-history-header)) | |
| 194 | |
| 195 (defun lm-header (header) | |
| 196 "Return the contents of the header named HEADER." | |
| 197 (goto-char (point-min)) | |
| 198 (let ((case-fold-search t)) | |
| 199 (if (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t) | |
| 200 ;; RCS ident likes format "$identifier: data$" | |
| 201 (looking-at "\\([^$\n]+\\)") | |
| 202 (match-end 1)) | |
| 203 (buffer-substring (match-beginning 1) (match-end 1)) | |
| 204 nil))) | |
| 205 | |
| 206 (defun lm-header-multiline (header) | |
| 207 "Return the contents of the header named HEADER, with continuation lines. | |
| 208 The returned value is a list of strings, one per line." | |
| 209 (save-excursion | |
| 210 (goto-char (point-min)) | |
| 211 (let ((res (lm-header header))) | |
| 212 (cond | |
| 213 (res | |
| 214 (setq res (list res)) | |
| 215 (forward-line 1) | |
| 216 | |
| 217 (while (and (looking-at (concat lm-header-prefix "[\t ]+")) | |
| 218 (progn | |
| 219 (goto-char (match-end 0)) | |
| 220 (looking-at "\\(.*\\)")) | |
| 221 (match-end 1)) | |
| 222 (setq res (cons (buffer-substring | |
| 223 (match-beginning 1) | |
| 224 (match-end 1)) | |
| 225 res)) | |
| 226 (forward-line 1)) | |
| 227 )) | |
| 228 res | |
| 229 ))) | |
| 230 | |
| 231 ;; These give us smart access to the header fields and commentary | |
| 232 | |
| 233 (defun lm-summary (&optional file) | |
| 234 "Return the one-line summary of file FILE, or current buffer if FILE is nil." | |
| 235 (save-excursion | |
| 236 (if file | |
| 237 (find-file file)) | |
| 238 (goto-char (point-min)) | |
| 239 (prog1 | |
| 240 (if (and | |
| 241 (looking-at lm-header-prefix) | |
| 242 (progn (goto-char (match-end 0)) | |
| 243 (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)"))) | |
| 244 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 245 (if file | |
| 246 (kill-buffer (current-buffer))) | |
| 247 ))) | |
| 248 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
249 ;; #### This should be replaced by a call into mail-lib. |
| 428 | 250 (defun lm-crack-address (x) |
| 251 "Split up an email address into full name and real email address. | |
| 252 The value is a cons of the form (FULLNAME . ADDRESS)." | |
| 253 (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) | |
| 254 (cons (substring x (match-beginning 1) (match-end 1)) | |
| 255 (substring x (match-beginning 2) (match-end 2)))) | |
| 256 ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) | |
| 257 (cons (substring x (match-beginning 2) (match-end 2)) | |
| 258 (substring x (match-beginning 1) (match-end 1)))) | |
| 259 ((string-match "\\S-+@\\S-+" x) | |
| 260 (cons nil x)) | |
| 261 (t | |
| 262 (cons x nil)))) | |
| 263 | |
| 264 (defun lm-authors (&optional file) | |
| 265 "Return the author list of file FILE, or current buffer if FILE is nil. | |
| 266 Each element of the list is a cons; the car is the full name, | |
| 267 the cdr is an email address." | |
| 268 (save-excursion | |
| 269 (if file | |
| 270 (find-file file)) | |
| 271 ;; XEmacs change (Is E-MAIL an infodock header? -sb) | |
| 272 (let* ((authorlist (lm-header-multiline "author")) | |
| 273 (email-list (lm-header-multiline "E-MAIL")) | |
| 274 (authors authorlist)) | |
| 275 (prog1 | |
| 276 (if (null email-list) | |
| 277 (mapcar 'lm-crack-address authorlist) | |
| 278 (while (and email-list authors) | |
| 279 (setcar authors (cons (car authors) (car email-list))) | |
| 280 (setq email-list (cdr email-list) | |
| 281 authors (cdr authors))) | |
| 282 authorlist) | |
| 283 (if file | |
| 284 (kill-buffer (current-buffer)))) | |
| 285 ))) | |
| 286 | |
| 287 (defun lm-maintainer (&optional file) | |
| 288 "Return the maintainer of file FILE, or current buffer if FILE is nil. | |
| 289 The return value has the form (NAME . ADDRESS)." | |
| 290 (save-excursion | |
| 291 (if file | |
| 292 (find-file file)) | |
| 293 (prog1 | |
| 294 (let ((maint (lm-header "maintainer"))) | |
| 295 (if maint | |
| 296 (lm-crack-address maint) | |
| 297 (car (lm-authors)))) | |
| 298 (if file | |
| 299 (kill-buffer (current-buffer)))))) | |
| 300 | |
| 301 (defun lm-creation-date (&optional file) | |
| 302 "Return the created date given in file FILE, or current buffer if FILE is nil." | |
| 303 (save-excursion | |
| 304 (if file | |
| 305 (find-file file)) | |
| 306 (prog1 | |
| 307 ;; XEmacs change (Is ORIG-DATE an Infodock header? -sb) | |
| 308 (or (lm-header "created") | |
| 309 (let ((date-and-time (lm-header "ORIG-DATE"))) | |
| 310 (if date-and-time | |
| 311 (substring date-and-time 0 | |
| 312 (string-match " " date-and-time))))) | |
| 313 (if file | |
| 314 (kill-buffer (current-buffer))) | |
| 315 ))) | |
| 316 | |
| 317 (defun lm-last-modified-date (&optional file) | |
| 318 "Return the modify-date given in file FILE, or current buffer if FILE is nil." | |
| 319 (save-excursion | |
| 320 (if file | |
| 321 (find-file file)) | |
| 322 (prog1 | |
| 323 (if (progn | |
| 324 (goto-char (point-min)) | |
| 325 (re-search-forward | |
| 326 "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " | |
| 327 (lm-code-mark) t)) | |
| 328 (format "%s %s %s" | |
| 329 (buffer-substring (match-beginning 3) (match-end 3)) | |
| 330 (nth (string-to-int | |
| 331 (buffer-substring (match-beginning 2) (match-end 2))) | |
| 332 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" | |
| 333 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) | |
| 334 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 335 ;; XEmacs change (Infodock change? -sb) | |
| 336 (let ((date-and-time (lm-header "LAST-MOD"))) | |
| 337 (if date-and-time | |
| 338 (substring date-and-time 0 | |
| 339 (string-match " " date-and-time))))) | |
| 340 (if file | |
| 341 (kill-buffer (current-buffer))) | |
| 342 ))) | |
| 343 | |
| 344 (defun lm-version (&optional file) | |
| 345 "Return the version listed in file FILE, or current buffer if FILE is nil. | |
| 448 | 346 This can be found in an RCS or SCCS header to crack it out of." |
| 428 | 347 (save-excursion |
| 348 (if file | |
| 349 (find-file file)) | |
| 350 (prog1 | |
| 351 (or | |
| 352 (lm-header "version") | |
| 353 (let ((header-max (lm-code-mark))) | |
| 354 (goto-char (point-min)) | |
| 355 (cond | |
| 356 ;; Look for an RCS header | |
| 357 ((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t) | |
| 358 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 359 | |
| 360 ;; Look for an SCCS header | |
| 361 ((re-search-forward | |
| 362 (concat | |
| 363 (regexp-quote "@(#)") | |
| 364 (regexp-quote (file-name-nondirectory (buffer-file-name))) | |
| 365 "\t\\([012345679.]*\\)") | |
| 366 header-max t) | |
| 367 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 368 | |
| 369 (t nil)))) | |
| 370 (if file | |
| 371 (kill-buffer (current-buffer))) | |
| 372 ))) | |
| 373 | |
| 374 (defun lm-keywords (&optional file) | |
| 375 "Return the keywords given in file FILE, or current buffer if FILE is nil." | |
| 376 (save-excursion | |
| 377 (if file | |
| 378 (find-file file)) | |
| 379 (prog1 | |
| 380 (let ((keywords (lm-header "keywords"))) | |
| 381 (and keywords (downcase keywords))) | |
| 382 (if file | |
| 383 (kill-buffer (current-buffer))) | |
| 384 ))) | |
| 385 | |
| 386 (defun lm-adapted-by (&optional file) | |
| 387 "Return the adapted-by names in file FILE, or current buffer if FILE is nil. | |
| 388 This is the name of the person who cleaned up this package for | |
| 389 distribution." | |
| 390 (save-excursion | |
| 391 (if file | |
| 392 (find-file file)) | |
| 393 (prog1 | |
| 394 (lm-header "adapted-by") | |
| 395 (if file | |
| 396 (kill-buffer (current-buffer))) | |
| 397 ))) | |
| 398 | |
| 399 (defun lm-commentary (&optional file) | |
| 400 "Return the commentary in file FILE, or current buffer if FILE is nil. | |
| 401 The value is returned as a string. In the text, the commentary starts | |
| 402 with tag `Commentary' and ends with tag `Change Log' or `History'." | |
| 403 (save-excursion | |
| 404 (if file | |
| 405 (find-file file)) | |
| 406 (prog1 | |
| 407 (let ((commentary (lm-commentary-mark)) | |
| 408 (change-log (lm-history-mark)) | |
| 409 (code (lm-code-mark)) | |
| 410 end) | |
| 411 (cond | |
| 412 ((and commentary change-log) | |
| 413 (buffer-substring commentary change-log)) | |
| 414 ((and commentary code) | |
| 415 (buffer-substring commentary code)) | |
| 416 (t | |
| 417 ;; XEmacs change (Infodock headers? -sb) | |
| 418 (setq commentary (lm-section-mark "DESCRIPTION" t)) | |
| 419 (setq end (lm-section-mark "DESCRIP-END")) | |
| 420 (and commentary end (buffer-substring commentary end))))) | |
| 421 (if file | |
| 422 (kill-buffer (current-buffer))) | |
| 423 ))) | |
| 424 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
425 ;;; Utilities |
| 428 | 426 |
| 427 (defun lm-insert-at-column (col &rest strings) | |
| 428 "Insert list of STRINGS, at column COL." | |
| 429 (if (> (current-column) col) (insert "\n")) | |
| 430 (move-to-column-force col) | |
| 431 (apply 'insert strings)) | |
| 432 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
433 ;;; Entry points: verification, synopses, and bug reporting |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
434 |
| 428 | 435 (defun lm-verify (&optional file showok &optional verb) |
| 436 "Check that the current buffer (or FILE if given) is in proper format. | |
| 437 If FILE is a directory, recurse on its files and generate a report in | |
| 438 a temporary buffer." | |
| 439 (interactive) | |
| 440 (let* ((verb (or verb (interactive-p))) | |
| 441 ret | |
| 442 name | |
| 443 ) | |
| 444 (if verb | |
| 445 (setq ret "Ok.")) ;init value | |
| 446 | |
| 447 (if (and file (file-directory-p file)) | |
| 448 (setq | |
| 449 ret | |
| 450 (progn | |
| 451 (switch-to-buffer (get-buffer-create "*lm-verify*")) | |
| 452 (erase-buffer) | |
| 453 (mapcar | |
| 454 #'(lambda (f) | |
| 455 (if (string-match ".*\\.el$" f) | |
| 456 (let ((status (lm-verify f))) | |
| 457 (if status | |
| 458 (progn | |
| 459 (insert f ":") | |
| 460 (lm-insert-at-column lm-comment-column status "\n")) | |
| 461 (and showok | |
| 462 (progn | |
| 463 (insert f ":") | |
| 464 (lm-insert-at-column lm-comment-column "OK\n"))))))) | |
| 465 (directory-files file)) | |
| 466 )) | |
| 467 (save-excursion | |
| 468 (if file | |
| 469 (find-file file)) | |
| 470 (setq name (lm-get-package-name)) | |
| 471 | |
| 472 (setq | |
| 473 ret | |
| 474 (prog1 | |
| 475 (cond | |
| 476 ((null name) | |
| 477 "Can't find a package NAME") | |
| 478 | |
| 479 ((not (lm-authors)) | |
| 480 "Author: tag missing.") | |
| 481 | |
| 482 ((not (lm-maintainer)) | |
| 483 "Maintainer: tag missing.") | |
| 484 | |
| 485 ((not (lm-summary)) | |
| 486 "Can't find a one-line 'Summary' description") | |
| 487 | |
| 488 ((not (lm-keywords)) | |
| 489 "Keywords: tag missing.") | |
| 490 | |
| 491 ((not (lm-commentary-mark)) | |
| 492 "Can't find a 'Commentary' section marker.") | |
| 493 | |
| 494 ((not (lm-history-mark)) | |
| 495 "Can't find a 'History' section marker.") | |
| 496 | |
| 497 ((not (lm-code-mark)) | |
| 498 "Can't find a 'Code' section marker") | |
| 499 | |
| 500 ((progn | |
| 501 (goto-char (point-max)) | |
| 502 (not | |
| 503 (re-search-backward | |
| 504 (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$" | |
| 505 "\\|^;;;[ \t]+ End of file[ \t]+" name) | |
| 506 nil t | |
| 507 ))) | |
| 508 (format "Can't find a footer line for [%s]" name)) | |
| 509 (t | |
| 510 ret)) | |
| 511 (if file | |
| 512 (kill-buffer (current-buffer))) | |
| 513 )))) | |
| 514 (if verb | |
| 515 (message ret)) | |
| 516 ret | |
| 517 )) | |
| 518 | |
| 519 (defun lm-synopsis (&optional file showall) | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
520 "Generate a synopsis listing for FILE, defaulting to the visited file. |
| 428 | 521 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
|
522 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
|
523 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
|
524 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
|
525 string. Interactively, SHOWALL is taken from the prefix argument." |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
526 (interactive "FSynopsis for (file or dir): \nP") |
| 428 | 527 |
| 528 (if (and file (file-directory-p file)) | |
| 529 (progn | |
| 530 (switch-to-buffer (get-buffer-create "*lm-verify*")) | |
| 531 (erase-buffer) | |
| 532 (mapcar | |
| 533 (lambda (f) ; XEmacs - dequote | |
| 534 (if (string-match ".*\\.el$" f) | |
| 535 (let ((syn (lm-synopsis f))) | |
| 536 (if syn | |
| 537 (progn | |
| 538 (insert f ":") | |
| 539 (lm-insert-at-column lm-comment-column syn "\n")) | |
| 540 (and showall | |
| 541 (progn | |
| 542 (insert f ":") | |
| 543 (lm-insert-at-column lm-comment-column "NA\n"))))))) | |
| 544 (directory-files file)) | |
| 545 ) | |
| 546 (save-excursion | |
| 547 (if file | |
| 548 (find-file file)) | |
| 549 (prog1 | |
| 550 (lm-summary) | |
| 551 (if file | |
| 552 (kill-buffer (current-buffer))) | |
| 553 )))) | |
| 554 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
555 ;; #### This should call out to `report-xemacs-bug'. |
| 428 | 556 (defun lm-report-bug (topic) |
| 557 "Report a bug in the package currently being visited to its maintainer. | |
| 558 Prompts for bug subject. Leaves you in a mail buffer." | |
| 559 (interactive "sBug Subject: ") | |
| 560 (let ((package (lm-get-package-name)) | |
| 561 (addr (lm-maintainer)) | |
| 562 (version (lm-version))) | |
| 776 | 563 (if-fboundp 'mail |
| 564 (mail nil | |
| 565 (if addr | |
| 566 (concat (car addr) " <" (cdr addr) ">") | |
| 567 (or (and-boundp 'report-xemacs-bug-beta-address | |
| 568 report-xemacs-bug-beta-address) | |
| 569 "<xemacs-beta@xemacs.org>")) | |
| 570 topic) | |
| 571 (error 'unimplemented "No mail package available")) | |
| 428 | 572 (goto-char (point-max)) |
| 573 (insert "\nIn " | |
| 574 package | |
| 575 (if version (concat " version " version) "") | |
| 576 "\n\n") | |
| 577 (message | |
| 578 (substitute-command-keys "Type \\[mail-send] to send bug report.")))) | |
| 579 | |
|
4633
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
580 ;;; 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
|
581 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
582 (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
|
583 "\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
|
584 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
585 ;; XEmacs is free software; you can redistribute it and/or modify it |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
586 ;; under the terms of the GNU General Public License as published by |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
587 ;; the Free Software Foundation; either version 2, or (at your option) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
588 ;; any later version. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
589 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
590 ;; XEmacs is distributed in the hope that it will be useful, but |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
591 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
592 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
593 ;; General Public License for more details. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
594 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
595 ;; You should have received a copy of the GNU General Public License |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
596 ;; along with XEmacs; see the file COPYING. If not, write to the Free |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
597 ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
598 ;; Boston, MA 02110-1301, USA.\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
599 "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
|
600 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
|
601 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
602 (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
|
603 "\n;;; Change Log: |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
604 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
605 ;; %s %s <%s> |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
606 ;; |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
607 ;; * Created.\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
608 "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
|
609 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
610 (defconst lm-boilerplate |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
611 ";;; %s --- %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
612 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
613 ;; 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
|
614 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
615 ;; Author: %s <%s> |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
616 ;; Created: %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
617 ;; Keywords: %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
618 %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
619 ;;; 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
|
620 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
621 ;;; Commentary: |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
622 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
623 ;; 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
|
624 ;; IN THIS SECTION. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
625 %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
626 ;;; Code:\n\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
627 "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
|
628 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
629 ;; #### 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
|
630 ;; #### 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
|
631 (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
|
632 "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
|
633 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
|
634 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
|
635 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
|
636 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
|
637 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
|
638 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
|
639 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
|
640 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
|
641 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
|
642 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
|
643 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
644 (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
|
645 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
|
646 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
647 (save-restriction |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
648 (widen) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
649 (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
|
650 (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
|
651 (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
|
652 (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
|
653 author |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
654 user-full-name)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
655 (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
|
656 email |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
657 user-mail-address)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
658 (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
|
659 (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
|
660 (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
|
661 file synopsis |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
662 year author |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
663 author email |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
664 date |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
665 keys |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
666 (if permission |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
667 "\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
|
668 lm-standard-permission) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
669 (if log |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
670 (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
|
671 ""))) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
672 (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
|
673 (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
|
674 |
| 428 | 675 (provide 'lisp-mnt) |
| 676 | |
| 677 ;;; lisp-mnt.el ends here |