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