|
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
|
|
|
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
|
