Mercurial > hg > xemacs-beta

comparison lisp/lisp-mnt.el @ 239:41f2f0e326e9 r20-5b18

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b18
author cvs
date Mon, 13 Aug 2007 10:15:48 +0200
parents 262b8bb4a523
children 19dcec799385
comparison
equal deleted inserted replaced
238:b5f2e56b938d 239:41f2f0e326e9
3 ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992, 1994 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: $Id: lisp-mnt.el,v 1.2 1997/12/06 22:26:15 steve Exp $ 8 ;; Keywords: docs, maint
9 ;; Keywords: docs 9 ;; X-Modified-by: Bob Weiner <weiner@altrasoft.com>, 4/14/95, to support
10 ;; X-Modified-by: Bob Weiner <weiner@mot.com>, 4/14/95, to support InfoDock 10 ;; InfoDock headers.
11 ;; headers.
12 ;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! 11 ;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
13 12
14 ;; This file is part of XEmacs. 13 ;; This file is part of XEmacs.
15 14
16 ;; XEmacs is free software; you can redistribute it and/or modify it 15 ;; XEmacs is free software; you can redistribute it and/or modify it
26 ;; You should have received a copy of the GNU General Public License 25 ;; You should have received a copy of the GNU General Public License
27 ;; along with XEmacs; see the file COPYING. If not, write to the Free 26 ;; along with XEmacs; see the file COPYING. If not, write to the Free
28 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 27 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
29 ;; 02111-1307, USA. 28 ;; 02111-1307, USA.
30 29
31 ;;; Synched up with: FSF 19.34. 30 ;;; Synched up with: FSF 20.2.
32 31
33 ;;; Commentary: 32 ;;; Commentary:
34 33
35 ;; This minor mode adds some services to Emacs-Lisp editing mode. 34 ;; This minor mode adds some services to Emacs-Lisp editing mode.
36 ;; 35 ;;
55 ;; 54 ;;
56 ;; * Author line --- contains the name and net address of at least 55 ;; * Author line --- contains the name and net address of at least
57 ;; the principal author. 56 ;; the principal author.
58 ;; 57 ;;
59 ;; If there are multiple authors, they should be listed on continuation 58 ;; If there are multiple authors, they should be listed on continuation
60 ;; lines led by ;;<TAB>, like this: 59 ;; lines led by ;;<TAB><TAB> (or multiple blanks), like this:
61 ;; 60 ;;
62 ;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu> 61 ;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
63 ;; ;; Dave Sill <de5@ornl.gov> 62 ;; ;; Dave Sill <de5@ornl.gov>
64 ;; ;; David Lawrence <tale@pawl.rpi.edu> 63 ;; ;; David Lawrence <tale@pawl.rpi.edu>
65 ;; ;; Noah Friedman <friedman@ai.mit.edu> 64 ;; ;; Noah Friedman <friedman@ai.mit.edu>
66 ;; ;; Joe Wells <jbw@maverick.uswest.com> 65 ;; ;; Joe Wells <jbw@maverick.uswest.com>
67 ;; ;; Dave Brennan <brennan@hal.com> 66 ;; ;; Dave Brennan <brennan@hal.com>
68 ;; ;; Eric Raymond <esr@snark.thyrsus.com> 67 ;; ;; Eric Raymond <esr@snark.thyrsus.com>
69 ;; 68 ;;
70 ;; This field may have some special values; notably "FSF", meaning 69 ;; This field may have some special values; notably "FSF", meaning
71 ;; "Free Software Foundation". 70 ;; "Free Software Foundation".
72 ;; 71 ;;
73 ;; * Maintainer line --- should be a single name/address as in the Author 72 ;; * Maintainer line --- should be a single name/address as in the Author
117 ;; * Created. 116 ;; * Created.
118 117
119 ;;; Code: 118 ;;; Code:
120 119
121 (require 'picture) ; provides move-to-column-force 120 (require 'picture) ; provides move-to-column-force
122 ;(require 'emacsbug) 121 ;(require 'emacsbug) ; XEmacs, not needed for bytecompilation
123 122
124 ;;; Variables: 123 ;;; Variables:
125 124
126 (defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?" 125 (defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?"
127 "Prefix that is ignored before the tag. 126 "Prefix that is ignored before the tag.
128 For example, you can write the 1st line synopsis string and headers like this 127 For example, you can write the 1st line synopsis string and headers like this
129 in your Lisp package: 128 in your Lisp package:
130 129
131 ;; @(#) package.el -- pacakge description 130 ;; @(#) package.el -- package description
132 ;; 131 ;;
133 ;; @(#) $Maintainer: Person Foo Bar $ 132 ;; @(#) $Maintainer: Person Foo Bar $
134 133
135 The @(#) construct is used by unix what(1) and 134 The @(#) construct is used by unix what(1) and
136 then $identifier: doc string $ is used by GNU ident(1)") 135 then $identifier: doc string $ is used by GNU ident(1)")
322 (find-file file)) 321 (find-file file))
323 (prog1 322 (prog1
324 (if (progn 323 (if (progn
325 (goto-char (point-min)) 324 (goto-char (point-min))
326 (re-search-forward 325 (re-search-forward
327 "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " 326 "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
328 (lm-code-mark) t)) 327 (lm-code-mark) t))
329 (format "%s %s %s" 328 (format "%s %s %s"
330 (buffer-substring (match-beginning 3) (match-end 3)) 329 (buffer-substring (match-beginning 3) (match-end 3))
331 (nth (string-to-int 330 (nth (string-to-int
332 (buffer-substring (match-beginning 2) (match-end 2))) 331 (buffer-substring (match-beginning 2) (match-end 2)))
353 (lm-header "version") 352 (lm-header "version")
354 (let ((header-max (lm-code-mark))) 353 (let ((header-max (lm-code-mark)))
355 (goto-char (point-min)) 354 (goto-char (point-min))
356 (cond 355 (cond
357 ;; Look for an RCS header 356 ;; Look for an RCS header
358 ((re-search-forward "\\$Id: [^ ]+ \\([^ ]+\\) " header-max t) 357 ((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t)
359 (buffer-substring (match-beginning 1) (match-end 1))) 358 (buffer-substring (match-beginning 1) (match-end 1)))
360 359
361 ;; Look for an SCCS header 360 ;; Look for an SCCS header
362 ((re-search-forward 361 ((re-search-forward
363 (concat 362 (concat
425 424
426 ;;; Verification and synopses 425 ;;; Verification and synopses
427 426
428 (defun lm-insert-at-column (col &rest strings) 427 (defun lm-insert-at-column (col &rest strings)
429 "Insert list of STRINGS, at column COL." 428 "Insert list of STRINGS, at column COL."
430 (if (> (current-column) col) (insert "\n")) 429 (if (> (current-column) col) (insert "\n"))
431 (move-to-column-force col) 430 (move-to-column-force col)
432 (apply 'insert strings)) 431 (apply 'insert strings))
433 432
434 (defun lm-verify (&optional file showok &optional verb) 433 (defun lm-verify (&optional file showok &optional verb)
435 "Check that the current buffer (or FILE if given) is in proper format. 434 "Check that the current buffer (or FILE if given) is in proper format.
436 If FILE is a directory, recurse on its files and generate a report in 435 If FILE is a directory, recurse on its files and generate a report in
437 a temporary buffer." 436 a temporary buffer."
439 (let* ((verb (or verb (interactive-p))) 438 (let* ((verb (or verb (interactive-p)))
440 ret 439 ret
441 name 440 name
442 ) 441 )
443 (if verb 442 (if verb
444 (setq ret "Ok.")) ;init value 443 (setq ret "Ok.")) ;init value
445 444
446 (if (and file (file-directory-p file)) 445 (if (and file (file-directory-p file))
447 (setq 446 (setq
448 ret 447 ret
449 (progn 448 (progn
527 (if (and file (file-directory-p file)) 526 (if (and file (file-directory-p file))
528 (progn 527 (progn
529 (switch-to-buffer (get-buffer-create "*lm-verify*")) 528 (switch-to-buffer (get-buffer-create "*lm-verify*"))
530 (erase-buffer) 529 (erase-buffer)
531 (mapcar 530 (mapcar
532 '(lambda (f) 531 (lambda (f) ; XEmacs - dequote
533 (if (string-match ".*\\.el$" f) 532 (if (string-match ".*\\.el$" f)
534 (let ((syn (lm-synopsis f))) 533 (let ((syn (lm-synopsis f)))
535 (if syn 534 (if syn
536 (progn 535 (progn
537 (insert f ":") 536 (insert f ":")