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