Mercurial > hg > xemacs-beta
annotate lisp/lisp-mnt.el @ 5882:bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
lisp/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
When calling #'string-match with a REGEXP without regular
expression special characters, call #'search, #'mismatch, #'find,
etc. instead, making our code less likely to side-effect other
functions' match data and a little faster.
* apropos.el (apropos-command):
* apropos.el (apropos):
Call (position ?\n ...) rather than (string-match "\n" ...) here.
* buff-menu.el:
* buff-menu.el (buffers-menu-omit-invisible-buffers):
Don't fire up the regexp engine just to check if a string starts
with a space.
* buff-menu.el (select-buffers-tab-buffers-by-mode):
Don't fire up the regexp engine just to compare mode basenames.
* buff-menu.el (format-buffers-tab-line):
* buff-menu.el (build-buffers-tab-internal): Moved to being a
label within the following.
* buff-menu.el (buffers-tab-items): Use the label.
* bytecomp.el (byte-compile-log-1):
Don't fire up the regexp engine just to look for a newline.
* cus-edit.el (get):
Ditto.
* cus-edit.el (custom-variable-value-create):
Ditto, but for a colon.
* descr-text.el (describe-text-sexp):
Ditto.
* descr-text.el (describe-char-unicode-data):
Use #'split-string-by-char given that we're just looking for a
semicolon.
* descr-text.el (describe-char):
Don't fire up the regexp engine just to look for a newline.
* disass.el (disassemble-internal):
Ditto.
* files.el (file-name-sans-extension):
Implement this using #'position.
* files.el (file-name-extension):
Correct this function's docstring, implement it in terms of
#'position.
* files.el (insert-directory):
Don't fire up the regexp engine to split a string by space; don't
reverse the list of switches, this is actually a longstand bug as
far as I can see.
* gnuserv.el (gnuserv-process-filter):
Use #'position here, instead of consing inside #'split-string
needlessly.
* gtk-file-dialog.el (gtk-file-dialog-update-dropdown):
Use #'split-string-by-char here, don't fire up #'split-string for
directory-sep-char.
* gtk-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* hyper-apropos.el (hyper-apropos-grok-functions):
* hyper-apropos.el (hyper-apropos-grok-variables):
Look for a newline using #'position rather than #'string-match in
these functions.
* info.el (Info-insert-dir):
* info.el (Info-insert-file-contents):
* info.el (Info-follow-reference):
* info.el (Info-extract-menu-node-name):
* info.el (Info-menu):
Look for fixed strings using #'position or #'search as appropriate
in this file.
* ldap.el (ldap-decode-string):
* ldap.el (ldap-encode-string):
#'encode-coding-string, #'decode-coding-string are always
available, don't check if they're fboundp.
* ldap.el (ldap-decode-address):
* ldap.el (ldap-encode-address):
Use #'split-string-by-char in these functions.
* lisp-mnt.el (lm-creation-date):
* lisp-mnt.el (lm-last-modified-date):
Don't fire up the regexp engine just to look for spaces in this file.
* menubar-items.el (default-menubar):
Use (not (mismatch ...)) rather than #'string-match here, for
simple regexp.
Use (search "beta" ...) rather than (string-match "beta" ...)
* menubar-items.el (sort-buffers-menu-alphabetically):
* menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically):
* menubar-items.el (group-buffers-menu-by-mode-then-alphabetically):
Don't fire up the regexp engine to check if a string starts with
a space or an asterisk.
Use the more fine-grained results of #'compare-strings; compare
case-insensitively for the buffer menu.
* menubar-items.el (list-all-buffers):
* menubar-items.el (tutorials-menu-filter):
Use #'equal rather than #'string-equal, which, in this context,
has the drawback of not having a bytecode, and no redeeming
features.
* minibuf.el:
* minibuf.el (un-substitute-in-file-name):
Use #'count, rather than counting the occurences of $ using the
regexp engine.
* minibuf.el (read-file-name-internal-1):
Don't fire up the regexp engine to search for ?=.
* mouse.el (mouse-eval-sexp):
Check for newline with #'find.
* msw-font-menu.el (mswindows-reset-device-font-menus):
Split a string by newline with #'split-string-by-char.
* mule/japanese.el:
* mule/japanese.el ("Japanese"):
Use #'search rather than #'string-match; canoncase before
comparing; fix a bug I had introduced where I had been making case
insensitive comparisons where the case mattered.
* mule/korea-util.el (default-korean-keyboard):
Look for ?3 using #'find, not #'string-march.
* mule/korea-util.el (quail-hangul-switch-hanja):
Search for a fixed string using #'search.
* mule/mule-cmds.el (set-locale-for-language-environment):
#'position, #'substitute rather than #'string-match,
#'replace-in-string.
* newcomment.el (comment-make-extra-lines):
Use #'search rather than #'string-match for a simple string.
* package-get.el (package-get-remote-filename):
Use #'position when looking for ?@
* process.el (setenv):
* process.el (read-envvar-name):
Use #'position when looking for ?=.
* replace.el (map-query-replace-regexp):
Use #'split-string-by-char instead of using an inline
implementation of it.
* select.el (select-convert-from-cf-text):
* select.el (select-convert-from-cf-unicodetext):
Use #'position rather than #'string-match in these functions.
* setup-paths.el (paths-emacs-data-root-p):
Use #'search when looking for simple string.
* sound.el (load-sound-file):
Use #'split-string-by-char rather than an inline reimplementation
of same.
* startup.el (splash-screen-window-body):
* startup.el (splash-screen-tty-body):
Search for simple strings using #'search.
* version.el (emacs-version):
Ditto.
* x-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* x-font-menu.el (x-reset-device-font-menus-core):
Use #'split-string-by-char here.
* x-init.el (x-initialize-keyboard):
Search for a simple string using #'search.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 01 Apr 2015 14:28:20 +0100 |
| parents | 91b3aa59f49b |
| children |
| 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 | |
|
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
309 (subseq date-and-time 0 (position ?\ date-and-time))))) |
| 428 | 310 (if file |
|
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
311 (kill-buffer (current-buffer)))))) |
| 428 | 312 |
| 313 (defun lm-last-modified-date (&optional file) | |
| 314 "Return the modify-date given in file FILE, or current buffer if FILE is nil." | |
| 315 (save-excursion | |
| 316 (if file | |
| 317 (find-file file)) | |
| 318 (prog1 | |
| 319 (if (progn | |
| 320 (goto-char (point-min)) | |
| 321 (re-search-forward | |
| 322 "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " | |
| 323 (lm-code-mark) t)) | |
| 324 (format "%s %s %s" | |
| 325 (buffer-substring (match-beginning 3) (match-end 3)) | |
| 326 (nth (string-to-int | |
| 327 (buffer-substring (match-beginning 2) (match-end 2))) | |
| 328 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" | |
| 329 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) | |
| 330 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 331 ;; XEmacs change (Infodock change? -sb) | |
| 332 (let ((date-and-time (lm-header "LAST-MOD"))) | |
| 333 (if date-and-time | |
|
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
334 (subseq date-and-time 0 (position ?\ date-and-time))))) |
| 428 | 335 (if file |
|
5882
bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
336 (kill-buffer (current-buffer)))))) |
| 428 | 337 |
| 338 (defun lm-version (&optional file) | |
| 339 "Return the version listed in file FILE, or current buffer if FILE is nil. | |
| 448 | 340 This can be found in an RCS or SCCS header to crack it out of." |
| 428 | 341 (save-excursion |
| 342 (if file | |
| 343 (find-file file)) | |
| 344 (prog1 | |
| 345 (or | |
| 346 (lm-header "version") | |
| 347 (let ((header-max (lm-code-mark))) | |
| 348 (goto-char (point-min)) | |
| 349 (cond | |
| 350 ;; Look for an RCS header | |
| 351 ((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t) | |
| 352 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 353 | |
| 354 ;; Look for an SCCS header | |
| 355 ((re-search-forward | |
| 356 (concat | |
| 357 (regexp-quote "@(#)") | |
| 358 (regexp-quote (file-name-nondirectory (buffer-file-name))) | |
| 359 "\t\\([012345679.]*\\)") | |
| 360 header-max t) | |
| 361 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 362 | |
| 363 (t nil)))) | |
| 364 (if file | |
| 365 (kill-buffer (current-buffer))) | |
| 366 ))) | |
| 367 | |
| 368 (defun lm-keywords (&optional file) | |
| 369 "Return the keywords given in file FILE, or current buffer if FILE is nil." | |
| 370 (save-excursion | |
| 371 (if file | |
| 372 (find-file file)) | |
| 373 (prog1 | |
| 374 (let ((keywords (lm-header "keywords"))) | |
| 375 (and keywords (downcase keywords))) | |
| 376 (if file | |
| 377 (kill-buffer (current-buffer))) | |
| 378 ))) | |
| 379 | |
| 380 (defun lm-adapted-by (&optional file) | |
| 381 "Return the adapted-by names in file FILE, or current buffer if FILE is nil. | |
| 382 This is the name of the person who cleaned up this package for | |
| 383 distribution." | |
| 384 (save-excursion | |
| 385 (if file | |
| 386 (find-file file)) | |
| 387 (prog1 | |
| 388 (lm-header "adapted-by") | |
| 389 (if file | |
| 390 (kill-buffer (current-buffer))) | |
| 391 ))) | |
| 392 | |
| 393 (defun lm-commentary (&optional file) | |
| 394 "Return the commentary in file FILE, or current buffer if FILE is nil. | |
| 395 The value is returned as a string. In the text, the commentary starts | |
| 396 with tag `Commentary' and ends with tag `Change Log' or `History'." | |
| 397 (save-excursion | |
| 398 (if file | |
| 399 (find-file file)) | |
| 400 (prog1 | |
| 401 (let ((commentary (lm-commentary-mark)) | |
| 402 (change-log (lm-history-mark)) | |
| 403 (code (lm-code-mark)) | |
| 404 end) | |
| 405 (cond | |
| 406 ((and commentary change-log) | |
| 407 (buffer-substring commentary change-log)) | |
| 408 ((and commentary code) | |
| 409 (buffer-substring commentary code)) | |
| 410 (t | |
| 411 ;; XEmacs change (Infodock headers? -sb) | |
| 412 (setq commentary (lm-section-mark "DESCRIPTION" t)) | |
| 413 (setq end (lm-section-mark "DESCRIP-END")) | |
| 414 (and commentary end (buffer-substring commentary end))))) | |
| 415 (if file | |
| 416 (kill-buffer (current-buffer))) | |
| 417 ))) | |
| 418 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
419 ;;; Utilities |
| 428 | 420 |
| 421 (defun lm-insert-at-column (col &rest strings) | |
| 422 "Insert list of STRINGS, at column COL." | |
| 423 (if (> (current-column) col) (insert "\n")) | |
| 424 (move-to-column-force col) | |
| 425 (apply 'insert strings)) | |
| 426 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
427 ;;; Entry points: verification, synopses, and bug reporting |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
428 |
| 428 | 429 (defun lm-verify (&optional file showok &optional verb) |
| 430 "Check that the current buffer (or FILE if given) is in proper format. | |
| 431 If FILE is a directory, recurse on its files and generate a report in | |
| 432 a temporary buffer." | |
| 433 (interactive) | |
| 434 (let* ((verb (or verb (interactive-p))) | |
| 435 ret | |
| 436 name | |
| 437 ) | |
| 438 (if verb | |
| 439 (setq ret "Ok.")) ;init value | |
| 440 | |
| 441 (if (and file (file-directory-p file)) | |
| 442 (setq | |
| 443 ret | |
| 444 (progn | |
| 445 (switch-to-buffer (get-buffer-create "*lm-verify*")) | |
| 446 (erase-buffer) | |
| 447 (mapcar | |
| 448 #'(lambda (f) | |
| 449 (if (string-match ".*\\.el$" f) | |
| 450 (let ((status (lm-verify f))) | |
| 451 (if status | |
| 452 (progn | |
| 453 (insert f ":") | |
| 454 (lm-insert-at-column lm-comment-column status "\n")) | |
| 455 (and showok | |
| 456 (progn | |
| 457 (insert f ":") | |
| 458 (lm-insert-at-column lm-comment-column "OK\n"))))))) | |
| 459 (directory-files file)) | |
| 460 )) | |
| 461 (save-excursion | |
| 462 (if file | |
| 463 (find-file file)) | |
| 464 (setq name (lm-get-package-name)) | |
| 465 | |
| 466 (setq | |
| 467 ret | |
| 468 (prog1 | |
| 469 (cond | |
| 470 ((null name) | |
| 471 "Can't find a package NAME") | |
| 472 | |
| 473 ((not (lm-authors)) | |
| 474 "Author: tag missing.") | |
| 475 | |
| 476 ((not (lm-maintainer)) | |
| 477 "Maintainer: tag missing.") | |
| 478 | |
| 479 ((not (lm-summary)) | |
| 480 "Can't find a one-line 'Summary' description") | |
| 481 | |
| 482 ((not (lm-keywords)) | |
| 483 "Keywords: tag missing.") | |
| 484 | |
| 485 ((not (lm-commentary-mark)) | |
| 486 "Can't find a 'Commentary' section marker.") | |
| 487 | |
| 488 ((not (lm-history-mark)) | |
| 489 "Can't find a 'History' section marker.") | |
| 490 | |
| 491 ((not (lm-code-mark)) | |
| 492 "Can't find a 'Code' section marker") | |
| 493 | |
| 494 ((progn | |
| 495 (goto-char (point-max)) | |
| 496 (not | |
| 497 (re-search-backward | |
| 498 (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$" | |
| 499 "\\|^;;;[ \t]+ End of file[ \t]+" name) | |
| 500 nil t | |
| 501 ))) | |
| 502 (format "Can't find a footer line for [%s]" name)) | |
| 503 (t | |
| 504 ret)) | |
| 505 (if file | |
| 506 (kill-buffer (current-buffer))) | |
| 507 )))) | |
| 508 (if verb | |
| 509 (message ret)) | |
| 510 ret | |
| 511 )) | |
| 512 | |
| 513 (defun lm-synopsis (&optional file showall) | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
514 "Generate a synopsis listing for FILE, defaulting to the visited file. |
| 428 | 515 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
|
516 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
|
517 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
|
518 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
|
519 string. Interactively, SHOWALL is taken from the prefix argument." |
|
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
520 (interactive "FSynopsis for (file or dir): \nP") |
| 428 | 521 |
| 522 (if (and file (file-directory-p file)) | |
| 523 (progn | |
| 524 (switch-to-buffer (get-buffer-create "*lm-verify*")) | |
| 525 (erase-buffer) | |
| 526 (mapcar | |
| 527 (lambda (f) ; XEmacs - dequote | |
| 528 (if (string-match ".*\\.el$" f) | |
| 529 (let ((syn (lm-synopsis f))) | |
| 530 (if syn | |
| 531 (progn | |
| 532 (insert f ":") | |
| 533 (lm-insert-at-column lm-comment-column syn "\n")) | |
| 534 (and showall | |
| 535 (progn | |
| 536 (insert f ":") | |
| 537 (lm-insert-at-column lm-comment-column "NA\n"))))))) | |
| 538 (directory-files file)) | |
| 539 ) | |
| 540 (save-excursion | |
| 541 (if file | |
| 542 (find-file file)) | |
| 543 (prog1 | |
| 544 (lm-summary) | |
| 545 (if file | |
| 546 (kill-buffer (current-buffer))) | |
| 547 )))) | |
| 548 | |
|
4631
866681a74bd9
Improve lisp-mnt documentation.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4630
diff
changeset
|
549 ;; #### This should call out to `report-xemacs-bug'. |
| 428 | 550 (defun lm-report-bug (topic) |
| 551 "Report a bug in the package currently being visited to its maintainer. | |
| 552 Prompts for bug subject. Leaves you in a mail buffer." | |
| 553 (interactive "sBug Subject: ") | |
| 554 (let ((package (lm-get-package-name)) | |
| 555 (addr (lm-maintainer)) | |
| 556 (version (lm-version))) | |
| 776 | 557 (if-fboundp 'mail |
| 558 (mail nil | |
| 559 (if addr | |
| 560 (concat (car addr) " <" (cdr addr) ">") | |
| 561 (or (and-boundp 'report-xemacs-bug-beta-address | |
| 562 report-xemacs-bug-beta-address) | |
| 563 "<xemacs-beta@xemacs.org>")) | |
| 564 topic) | |
| 565 (error 'unimplemented "No mail package available")) | |
| 428 | 566 (goto-char (point-max)) |
| 567 (insert "\nIn " | |
| 568 package | |
| 569 (if version (concat " version " version) "") | |
| 570 "\n\n") | |
| 571 (message | |
| 572 (substitute-command-keys "Type \\[mail-send] to send bug report.")))) | |
| 573 | |
|
4633
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
574 ;;; 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
|
575 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
576 (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
|
577 "\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
|
578 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
579 ;; 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
|
580 ;; 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
|
581 ;; 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
|
582 ;; 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
|
583 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
584 ;; 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
|
585 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5402
diff
changeset
|
586 ;; 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
|
587 ;; 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
|
588 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
589 ;; 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
|
590 ;; 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
|
591 "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
|
592 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
|
593 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
594 (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
|
595 "\n;;; Change Log: |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
596 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
597 ;; %s %s <%s> |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
598 ;; |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
599 ;; * Created.\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
600 "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
|
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-boilerplate |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
603 ";;; %s --- %s |
|
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 ;; 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
|
606 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
607 ;; Author: %s <%s> |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
608 ;; Created: %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
609 ;; Keywords: %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
610 %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
611 ;;; 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
|
612 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
613 ;;; Commentary: |
|
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 ;; 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
|
616 ;; IN THIS SECTION. |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
617 %s |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
618 ;;; Code:\n\n" |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
619 "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
|
620 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
621 ;; #### 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
|
622 ;; #### 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
|
623 (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
|
624 "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
|
625 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
|
626 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
|
627 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
|
628 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
|
629 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
|
630 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
|
631 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
|
632 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
|
633 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
|
634 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
|
635 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
636 (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
|
637 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
|
638 |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
639 (save-restriction |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
640 (widen) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
641 (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
|
642 (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
|
643 (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
|
644 (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
|
645 author |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
646 user-full-name)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
647 (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
|
648 email |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
649 user-mail-address)) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
650 (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
|
651 (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
|
652 (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
|
653 file synopsis |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
654 year author |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
655 author email |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
656 date |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
657 keys |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
658 (if permission |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
659 "\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
|
660 lm-standard-permission) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
661 (if log |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
662 (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
|
663 ""))) |
|
199ecf2503c8
Add standard section headers in preparation for 21.5.29.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4631
diff
changeset
|
664 (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
|
665 (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
|
666 |
| 428 | 667 (provide 'lisp-mnt) |
| 668 | |
| 669 ;;; lisp-mnt.el ends here |