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