Mercurial > emacs
comparison lisp/emacs-lisp/lisp-mnt.el @ 2352:8c8fe9da1f5e
(lm-last-modified-date) Fixed return bug.
(lm-uthor, lm-maintainer) These now return cons pairs, not strings.
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Thu, 25 Mar 1993 01:57:43 +0000 |
parents | 6dc5b7273a07 |
children | df68ddbcc2f1 |
comparison
equal
deleted
inserted
replaced
2351:bb1ff4e31fb6 | 2352:8c8fe9da1f5e |
---|---|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1992 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | 5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> |
6 ;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com> | 6 ;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com> |
7 ;; Created: 14 Jul 1992 | 7 ;; Created: 14 Jul 1992 |
8 ;; Version: 1.2 | 8 ;; Version: $Id: lisp-mnt.el,v 1.3 1993/03/24 23:46:52 esr Exp $ |
9 ;; Keywords: docs | 9 ;; Keywords: docs |
10 ;; Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! | 10 ;; Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! |
11 | 11 |
12 ;; This file is part of GNU Emacs. | 12 ;; This file is part of GNU Emacs. |
13 | 13 |
49 ;; three dashes, followed by the summary. All fields space-separated. | 49 ;; three dashes, followed by the summary. All fields space-separated. |
50 ;; | 50 ;; |
51 ;; * Author line --- contains the name and net address of at least | 51 ;; * Author line --- contains the name and net address of at least |
52 ;; the principal author. | 52 ;; the principal author. |
53 ;; | 53 ;; |
54 ;; If there are multible authors, they should be listed on continuation | 54 ;; If there are multiple authors, they should be listed on continuation |
55 ;; lines led by ;;<TAB>, like this: | 55 ;; lines led by ;;<TAB>, like this: |
56 ;; | 56 ;; |
57 ;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu> | 57 ;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu> |
58 ;; ;; Dave Sill <de5@ornl.gov> | 58 ;; ;; Dave Sill <de5@ornl.gov> |
59 ;; ;; David Lawrence <tale@pawl.rpi.edu> | 59 ;; ;; David Lawrence <tale@pawl.rpi.edu> |
76 ;; | 76 ;; |
77 ;; * Created line --- optional, gives the original creation date of the | 77 ;; * Created line --- optional, gives the original creation date of the |
78 ;; file. For historical interest, basically. | 78 ;; file. For historical interest, basically. |
79 ;; | 79 ;; |
80 ;; * Version line --- intended to give the reader a clue if they're looking | 80 ;; * Version line --- intended to give the reader a clue if they're looking |
81 ;; at a different version of the file than the one they're accustomed to. Not | 81 ;; at a different version of the file than the one they're accustomed to. This |
82 ;; needed if you have an RCS or SCCS header. | 82 ;; may be an RCS or SCCS header. |
83 ;; | 83 ;; |
84 ;; * Adapted-By line --- this is for FSF's internal use. The person named | 84 ;; * Adapted-By line --- this is for FSF's internal use. The person named |
85 ;; in this field was the one responsible for installing and adapting the | 85 ;; in this field was the one responsible for installing and adapting the |
86 ;; package for the distribution. (This file doesn't have one because the | 86 ;; package for the distribution. (This file doesn't have one because the |
87 ;; author *is* one of the maintainers.) | 87 ;; author *is* one of the maintainers.) |
111 ;; * Created. | 111 ;; * Created. |
112 | 112 |
113 ;;; Code: | 113 ;;; Code: |
114 | 114 |
115 (require 'picture) ; provides move-to-column-force | 115 (require 'picture) ; provides move-to-column-force |
116 (require 'emacsbug) | |
116 | 117 |
117 ;; These functions all parse the headers of the current buffer | 118 ;; These functions all parse the headers of the current buffer |
118 | 119 |
119 (defun lm-section-mark (hd) | 120 (defun lm-section-mark (hd) |
120 ;; Return the buffer location of a given section start marker | 121 ;; Return the buffer location of a given section start marker |
172 (buffer-substring (match-beginning 1) (match-end 1))) | 173 (buffer-substring (match-beginning 1) (match-end 1))) |
173 (if file | 174 (if file |
174 (kill-buffer (current-buffer))) | 175 (kill-buffer (current-buffer))) |
175 ))) | 176 ))) |
176 | 177 |
178 | |
179 (defun lm-crack-address (x) | |
180 ;; Given a string containing a human and email address, parse it | |
181 ;; into a cons pair (name . address). | |
182 (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) | |
183 (cons (substring x (match-beginning 1) (match-end 1)) | |
184 (substring x (match-beginning 2) (match-end 2)))) | |
185 ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) | |
186 (cons (substring x (match-beginning 2) (match-end 2)) | |
187 (substring x (match-beginning 1) (match-end 1)))) | |
188 ((string-match "\\S-+@\\S-+" x) | |
189 (cons nil x)) | |
190 (t | |
191 (cons x nil)))) | |
192 | |
177 (defun lm-authors (&optional file) | 193 (defun lm-authors (&optional file) |
178 ;; Return the buffer's or FILE's author list. | 194 ;; Return the buffer's or FILE's author list. Each element of the |
179 (save-excursion | 195 ;; list is a cons; the car is a name-aming-humans, the cdr an email |
180 (if file | 196 ;; address. |
181 (find-file file)) | 197 (save-excursion |
182 (prog1 | 198 (if file |
183 (lm-header-multiline "author") | 199 (find-file file)) |
184 (if file | 200 (let ((authorlist (lm-header-multiline "author"))) |
185 (kill-buffer (current-buffer))) | 201 (prog1 |
186 ))) | 202 (mapcar 'lm-crack-address authorlist) |
203 (if file | |
204 (kill-buffer (current-buffer))) | |
205 )))) | |
187 | 206 |
188 (defun lm-maintainer (&optional file) | 207 (defun lm-maintainer (&optional file) |
189 ;; Get a package's bug-report & maintenance address. Parse it out of FILE, | 208 ;; Get a package's bug-report & maintenance address. Parse it out of FILE, |
190 ;; or the current buffer if FILE is nil. | 209 ;; or the current buffer if FILE is nil. |
191 ;; This may be a name-address pair, or an address by itself, | 210 ;; The return value is a (name . address) cons. |
192 (save-excursion | 211 (save-excursion |
193 (if file | 212 (if file |
194 (find-file file)) | 213 (find-file file)) |
195 (prog1 | 214 (prog1 |
196 (let ((raw-address | 215 (let ((maint (lm-header "maintainer"))) |
197 (or | 216 (if maint |
198 (save-excursion (lm-header "maintainer")) | 217 (lm-crack-address maint) |
199 (car (lm-authors))))) | 218 (car (lm-authors)))) |
200 (cond ((string-match "[^<]<\\([^>]+\\)>" raw-address) | |
201 (substring raw-address (match-beginning 1) (match-end 1))) | |
202 (t raw-address)) | |
203 ) | |
204 (if file | 219 (if file |
205 (kill-buffer (current-buffer))) | 220 (kill-buffer (current-buffer))) |
206 ))) | 221 ))) |
207 | 222 |
208 (defun lm-creation-date (&optional file) | 223 (defun lm-creation-date (&optional file) |
222 ;; Return a package's last-modified date, if you can find one. | 237 ;; Return a package's last-modified date, if you can find one. |
223 (save-excursion | 238 (save-excursion |
224 (if file | 239 (if file |
225 (find-file file)) | 240 (find-file file)) |
226 (prog1 | 241 (prog1 |
227 (if (progn | 242 (if (progn |
228 (goto-char (point-min)) | 243 (goto-char (point-min)) |
229 (re-search-forward | 244 (re-search-forward |
230 "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " | 245 "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " |
231 (lm-code-mark) t)) | 246 (lm-code-mark) t)) |
232 (format "%s %s %s" | 247 (format "%s %s %s" |
233 (buffer-substring (match-beginning 3) (match-end 3)) | 248 (buffer-substring (match-beginning 3) (match-end 3)) |
234 (nth (string-to-int | 249 (nth (string-to-int |
235 (buffer-substring (match-beginning 2) (match-end 2))) | 250 (buffer-substring (match-beginning 2) (match-end 2))) |
236 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" | 251 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" |
237 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) | 252 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) |
238 (buffer-substring (match-beginning 1) (match-end 1)) | 253 (buffer-substring (match-beginning 1) (match-end 1)) |
239 ))) | 254 )) |
240 (if file | 255 (if file |
241 (kill-buffer (current-buffer))) | 256 (kill-buffer (current-buffer))) |
242 )) | 257 ))) |
243 | 258 |
244 (defun lm-version (&optional file) | 259 (defun lm-version (&optional file) |
245 ;; Return the package's version field. | 260 ;; Return the package's version field. |
246 ;; If none, look for an RCS or SCCS header to crack it out of. | 261 ;; If none, look for an RCS or SCCS header to crack it out of. |
247 (save-excursion | 262 (save-excursion |
398 )))) | 413 )))) |
399 | 414 |
400 (defun lm-report-bug (topic) | 415 (defun lm-report-bug (topic) |
401 "Report a bug in the package currently being visited to its maintainer. | 416 "Report a bug in the package currently being visited to its maintainer. |
402 Prompts for bug subject. Leaves you in a mail buffer." | 417 Prompts for bug subject. Leaves you in a mail buffer." |
418 (interactive "sBug Subject: ") | |
403 (let ((package (buffer-name)) | 419 (let ((package (buffer-name)) |
404 (addr (lm-maintainer)) | 420 (addr (lm-maintainer)) |
405 (version (lm-version))) | 421 (version (lm-version))) |
406 ;; We do this in order to avoid duplicating the general bug address here | 422 (mail nil (or addr bug-gnu-emacs) topic) |
407 (if (or (not addr) (string= "FSF")) | |
408 (progn | |
409 (load-library "emacsbug.el") | |
410 (emacsbug (format "%s --- %s" package topic)))) | |
411 (interactive "sBug Subject: ") | |
412 (mail nil addr topic) | |
413 (goto-char (point-max)) | 423 (goto-char (point-max)) |
414 (insert "\nIn " | 424 (insert "\nIn " |
415 package | 425 package |
416 (and version (concat " version " version)) | 426 (and version (concat " version " version)) |
417 "\n\n") | 427 "\n\n") |