Mercurial > hg > xemacs-beta

comparison lisp/packages/upd-copyr.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 131b0175ea99
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
2
3 ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
4 ;;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
5
6 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
7 ;; hacked on by Jamie Zawinski.
8 ;; hacked upon by Jonathan Stigelman <Stig@hackvan.com>
9 ;; Keywords: maint
10
11 ;; This file is part of XEmacs.
12
13 ;; XEmacs is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version.
17
18 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING. If not, write to the Free
25 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;; 02139, USA.
27
28 ;;; Synched up with: Not synched with FSF.
29 ;;; Apparently mly synched this file with the version of upd-copyr.el
30 ;;; supplied with FSF 19.22 or 19.23. Since then, FSF renamed the
31 ;;; file to copyright.el and basically rewrote it, and Stig and Jamie
32 ;;; basically rewrote it, so there's not much in common any more.
33
34 ;;; Code:
35
36 ;; #### - this will break if you dump it into emacs
37 (defconst copyright-year (substring (current-time-string) -4)
38 "String representing the current year.")
39
40 ;;;###autoload
41 (defvar copyright-do-not-disturb "Free Software Foundation, Inc."
42 "*If non-nil, the existing copyright holder is checked against this regexp.
43 If it does not match, then a new copyright line is added with the copyright
44 holder set to the value of `copyright-whoami'.")
45
46 ;;;###autoload
47 (defvar copyright-whoami nil
48 "*A string containing the name of the owner of new copyright notices.")
49
50 ;;;###autoload
51 (defvar copyright-notice-file nil
52 "*If non-nil, replace copying notices with this file.")
53
54 (defvar copyright-files-to-ignore-regex "loaddefs.el$"
55 "*Regular expression for files that should be ignored")
56
57 (defvar current-gpl-version "2"
58 "String representing the current version of the GPL.")
59
60 (defvar copyright-inhibit-update nil
61 "If nil, ask the user whether or not to update the copyright notice.
62 If the user has said no, we set this to t locally.")
63
64 (defvar copyright-search-limit 2048
65 "Portion of file to search for copyright notices")
66
67 ;;;###autoload
68 (defun update-copyright (&optional replace ask-upd ask-year)
69 "Update the copyright notice at the beginning of the buffer
70 to indicate the current year. If optional arg REPLACE is given
71 \(interactively, with prefix arg\) replace the years in the notice
72 rather than adding the current year after them.
73 If `copyright-notice-file' is set, the copying permissions following the
74 copyright are replaced as well.
75
76 If optional third argument ASK is non-nil, the user is prompted for whether
77 or not to update the copyright. If optional fourth argument ASK-YEAR is
78 non-nil, the user is prompted for whether or not to replace the year rather
79 than adding to it."
80 (interactive "*P")
81 (or (and ask-upd copyright-inhibit-update)
82 (and buffer-file-truename
83 (string-match copyright-files-to-ignore-regex buffer-file-truename))
84 (save-excursion
85 (save-restriction
86 (widen)
87 (goto-char (point-min))
88 (narrow-to-region (point-min)
89 (min copyright-search-limit (point-max)))
90 ;; Handle abbreviated year lists like "1800, 01, 02, 03"
91 ;; or "1900, '01, '02, '03".
92 (let ((case-fold-search t)
93 p-string holder add-new
94 mine current
95 cw-current cw-mine last-cw
96 (cw-position '(lambda ()
97 (goto-char (point-min))
98 (cond (cw-mine (goto-char cw-mine))
99 ((or (and last-cw (goto-char last-cw))
100 (re-search-forward
101 "copyright[^0-9\n]*\\([-, \t]*\\([0-9]+\\)\\)+"
102 nil t))
103 (and add-new (beginning-of-line 2)))
104 (t (goto-char (point-min)))))))
105 ;; scan for all copyrights
106 (while (re-search-forward
107 (concat "^\\(.*\\)copyright.*\\(" (substring copyright-year 0 2)
108 "\\)?" "\\([0-9][0-9]\\(, \t\\)+\\)*'?"
109 "\\(\\(" (substring copyright-year 2) "\\)\\|[0-9][0-9]\\)\\s *\\(\\S .*\\)$")
110 nil t)
111 (buffer-substring (match-beginning 0) (match-end 0))
112 (setq p-string (buffer-substring (match-beginning 1)
113 (match-end 1))
114 last-cw (match-end 5)
115 holder (buffer-substring (match-beginning 7)
116 (match-end 7))
117 current (match-beginning 6)
118 mine (string-match copyright-do-not-disturb holder)
119 cw-current (if mine
120 current
121 (or cw-current current))
122 cw-mine (or cw-mine (and mine last-cw))
123 ))
124 ;; ok, now decide if a new copyright is needed...
125 (setq add-new (not cw-mine))
126 (or ask-upd add-new
127 (message "Copyright notice already includes %s." copyright-year))
128 (goto-char (point-min))
129 (cond ((and cw-current cw-mine)
130 (or ask-upd (message "The copyright is up to date"))
131 (copyright-check-notice))
132 ((and (or add-new (not cw-current))
133 ;; #### - doesn't bother to ask about non-GPL sources
134 (or (not ask-upd)
135 (prog1
136 (search-forward "is free software" nil t)
137 (goto-char (point-min))))
138 ;; adding a new copyright or one exists already...
139 (or add-new last-cw)
140 ;; adding a new copyright or the user wants to update...
141 (or (not ask-upd)
142 (save-window-excursion
143 (pop-to-buffer (current-buffer))
144 ;; Show user the copyright.
145 (funcall cw-position)
146 (sit-for 0)
147 (or (y-or-n-p "Update copyright? ")
148 (progn
149 (set (make-local-variable
150 'copyright-inhibit-update) t)
151 nil)))))
152 ;; The "XEmacs change" below effectively disabled this
153 ;; already, so I'm gonna comment it out entirely... --Stig
154 ;; (setq replace
155 ;; (or replace
156 ;; (and ask-year
157 ;; (save-window-excursion
158 ;; (pop-to-buffer (current-buffer))
159 ;; (save-excursion
160 ;; ;; Show the user the copyright.
161 ;; (goto-char (point-min))
162 ;; ;;XEmacs change
163 ;; ;; (sit-for 0)
164 ;; ;; (y-or-n-p "Replace copyright year? ")
165 ;; nil
166 ;; )))))
167 (cond (add-new
168 ;; the cursor should already be at the beginning of a
169 ;; line here...
170 (funcall cw-position)
171 (setq holder (or copyright-whoami
172 (read-string "New copyright holder: ")))
173 (if p-string (insert p-string) (indent-for-comment))
174 (insert "Copyright (C) ")
175 (save-excursion
176 (insert " " holder "\n"))
177 )
178 (replace
179 ;; #### - check this...
180 (beginning-of-line)
181 (re-search-forward "copyright\\([^0-9]*\\([-, \t]*\\([0-9]+\\)\\)+\\)"
182 (save-excursion (end-of-line)
183 (point)))
184 (delete-region (match-beginning 1) (match-end 1)))
185 (t (insert ", ")
186 ;; This did the wrong thing: "1990-1992" -> "1990, 1992"
187 ;; Perhaps "1990, 1991, 1992" would be an appropriate
188 ;; substitution, but "1990-1992" is satisfactory. --Stig
189 ;;
190 ;; XEmacs addition
191 ;; (save-excursion
192 ;; (goto-char (match-beginning 1))
193 ;; (if (looking-at "[0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9]")
194 ;; (progn (forward-char 4)
195 ;; (delete-char 1)
196 ;; (insert ", "))))
197 ))
198 (insert copyright-year)
199 ;; XEmacs addition
200 ;; #### - this assumes lisp and shouldn't
201 (if (save-excursion
202 (end-of-line)
203 (>= (current-column) fill-column))
204 (if (= (char-syntax ?\;) ?<)
205 (insert "\n;;;")
206 (insert "\n ")))
207 (message "Copyright updated to %s%s."
208 (if replace "" "include ") copyright-year)
209 (copyright-check-notice)
210 ;; show the newly-munged copyright.
211 (message "The copyright has been updated")
212 (sit-for 1))
213 ((not ask-upd)
214 (error "This buffer does not contain a copyright notice!"))
215 ))))))
216
217 (defun copyright-check-notice ()
218 (if copyright-notice-file
219 (let (beg)
220 (goto-char (point-min))
221 ;; Find the beginning of the copyright.
222 (if (search-forward "copyright" nil t)
223 (progn
224 ;; Look for a blank line or a line with only comment chars.
225 (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t)
226 (forward-line 1)
227 (with-output-to-temp-buffer "*Help*"
228 (princ (substitute-command-keys "\
229 I don't know where the copying notice begins.
230 Put point there and hit \\[exit-recursive-edit]."))
231 (recursive-edit)))
232 (setq beg (point))
233 (or (search-forward "02139, USA." nil t)
234 (with-output-to-temp-buffer "*Help*"
235 (princ (substitute-command-keys "\
236 I don't know where the copying notice ends.
237 Put point there and hit \\[exit-recursive-edit]."))
238 (recursive-edit)))
239 (delete-region beg (point))))
240 (insert-file copyright-notice-file))
241 (if (re-search-forward
242 "; either version \\(.+\\), or (at your option)"
243 nil t)
244 (progn
245 (goto-char (match-beginning 1))
246 (delete-region (point) (match-end 1))
247 (insert current-gpl-version)))))
248
249 ;;;###autoload
250 (defun ask-to-update-copyright ()
251 "If the current buffer contains a copyright notice that is out of date,
252 ask the user if it should be updated with `update-copyright' (which see).
253 Put this on write-file-hooks."
254 (update-copyright nil t t)
255 ;; Be sure return nil; if a write-file-hook return non-nil,
256 ;; the file is presumed to be already written.
257 nil)
258
259 (provide 'upd-copyr)
260
261 ;;; upd-copyr.el ends here