Merge from trunk.
[bpt/emacs.git] / lisp / emacs-lisp / copyright.el
1 ;;; copyright.el --- update the copyright notice in current buffer
2
3 ;; Copyright (C) 1991-1995, 1998, 2001-2012 Free Software Foundation, Inc.
4
5 ;; Author: Daniel Pfeiffer <occitan@esperanto.org>
6 ;; Keywords: maint, tools
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; Allows updating the copyright year and above mentioned GPL version manually
26 ;; or when saving a file.
27 ;; Do (add-hook 'before-save-hook 'copyright-update), or use
28 ;; M-x customize-variable RET before-save-hook RET.
29
30 ;;; Code:
31
32 (defgroup copyright nil
33 "Update the copyright notice in current buffer."
34 :group 'tools)
35
36 (defcustom copyright-limit 2000
37 "Don't try to update copyright beyond this position unless interactive.
38 A value of nil means to search whole buffer."
39 :group 'copyright
40 :type '(choice (integer :tag "Limit")
41 (const :tag "No limit")))
42
43 (defcustom copyright-at-end-flag nil
44 "Non-nil means to search backwards from the end of the buffer for copyright.
45 This is useful for ChangeLogs."
46 :group 'copyright
47 :type 'boolean
48 :version "23.1")
49 ;;;###autoload(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
50
51 (defcustom copyright-regexp
52 "\\\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
53 \\|[Cc]opyright\\s *:?\\s *©\\)\
54 \\s *\\(?:[^0-9\n]*\\s *\\)?\
55 \\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
56 "What your copyright notice looks like.
57 The second \\( \\) construct must match the years."
58 :group 'copyright
59 :type 'regexp)
60
61 (defcustom copyright-names-regexp ""
62 "Regexp matching the names which correspond to the user.
63 Only copyright lines where the name matches this regexp will be updated.
64 This allows you to avoid adding years to a copyright notice belonging to
65 someone else or to a group for which you do not work."
66 :group 'copyright
67 :type 'regexp)
68
69 ;; The worst that can happen is a malicious regexp that overflows in
70 ;; the regexp matcher, a minor nuisance. It's a pain to be always
71 ;; prompted if you want to put this in a dir-locals.el.
72 ;;;###autoload(put 'copyright-names-regexp 'safe-local-variable 'stringp)
73
74 (defcustom copyright-years-regexp
75 "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
76 "Match additional copyright notice years.
77 The second \\( \\) construct must match the years."
78 :group 'copyright
79 :type 'regexp)
80
81 ;; See "Copyright Notices" in maintain.info.
82 ;; TODO? 'end only for ranges at the end, other for all ranges.
83 ;; Minimum limit on the size of a range?
84 (defcustom copyright-year-ranges nil
85 "Non-nil if individual consecutive years should be replaced with a range.
86 For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008.
87 If you use ranges, you should add an explanatory note in a README file.
88 The function `copyright-fix-years' respects this variable."
89 :group 'copyright
90 :type 'boolean
91 :version "24.1")
92
93 ;;;###autoload(put 'copyright-year-ranges 'safe-local-variable 'booleanp)
94
95 (defcustom copyright-query 'function
96 "If non-nil, ask user before changing copyright.
97 When this is `function', only ask when called non-interactively."
98 :group 'copyright
99 :type '(choice (const :tag "Do not ask")
100 (const :tag "Ask unless interactive" function)
101 (other :tag "Ask" t)))
102
103
104 ;; when modifying this, also modify the comment generated by autoinsert.el
105 (defconst copyright-current-gpl-version "3"
106 "String representing the current version of the GPL or nil.")
107
108 (defvar copyright-update t
109 "The function `copyright-update' sets this to nil after updating a buffer.")
110
111 ;; This is a defvar rather than a defconst, because the year can
112 ;; change during the Emacs session.
113 (defvar copyright-current-year (substring (current-time-string) -4)
114 "String representing the current year.")
115
116 (defsubst copyright-limit () ; re-search-forward BOUND
117 (and copyright-limit
118 (if copyright-at-end-flag
119 (- (point) copyright-limit)
120 (+ (point) copyright-limit))))
121
122 (defun copyright-re-search (regexp &optional bound noerror count)
123 "Re-search forward or backward depending on `copyright-at-end-flag'."
124 (if copyright-at-end-flag
125 (re-search-backward regexp bound noerror count)
126 (re-search-forward regexp bound noerror count)))
127
128 (defun copyright-start-point ()
129 "Return point-min or point-max, depending on `copyright-at-end-flag'."
130 (if copyright-at-end-flag
131 (point-max)
132 (point-min)))
133
134 (defun copyright-offset-too-large-p ()
135 "Return non-nil if point is too far from the edge of the buffer."
136 (when copyright-limit
137 (if copyright-at-end-flag
138 (< (point) (- (point-max) copyright-limit))
139 (> (point) (+ (point-min) copyright-limit)))))
140
141 (defun copyright-find-copyright ()
142 "Return non-nil if a copyright header suitable for updating is found.
143 The header must match `copyright-regexp' and `copyright-names-regexp', if set.
144 This function sets the match-data that `copyright-update-year' uses."
145 (widen)
146 (goto-char (copyright-start-point))
147 (condition-case err
148 ;; (1) Need the extra \\( \\) around copyright-regexp because we
149 ;; goto (match-end 1) below. See note (2) below.
150 (copyright-re-search (concat "\\(" copyright-regexp
151 "\\)\\([ \t]*\n\\)?.*\\(?:"
152 copyright-names-regexp "\\)")
153 (copyright-limit)
154 t)
155 ;; In case the regexp is rejected. This is useful because
156 ;; copyright-update is typically called from before-save-hook where
157 ;; such an error is very inconvenient for the user.
158 (error (message "Can't update copyright: %s" err) nil)))
159
160 (defun copyright-find-end ()
161 "Possibly adjust the search performed by `copyright-find-copyright'.
162 If the years continue onto multiple lines that are marked as comments,
163 skips to the end of all the years."
164 (while (save-excursion
165 (and (eq (following-char) ?,)
166 (progn (forward-char 1) t)
167 (progn (skip-chars-forward " \t") (eolp))
168 comment-start-skip
169 (save-match-data
170 (forward-line 1)
171 (and (looking-at comment-start-skip)
172 (goto-char (match-end 0))))
173 (looking-at-p copyright-years-regexp)))
174 (forward-line 1)
175 (re-search-forward comment-start-skip)
176 ;; (2) Need the extra \\( \\) so that the years are subexp 3, as
177 ;; they are at note (1) above.
178 (re-search-forward (format "\\(%s\\)" copyright-years-regexp))))
179
180 (defun copyright-update-year (replace noquery)
181 ;; This uses the match-data from copyright-find-copyright/end.
182 (goto-char (match-end 1))
183 (copyright-find-end)
184 ;; Note that `current-time-string' isn't locale-sensitive.
185 (setq copyright-current-year (substring (current-time-string) -4))
186 (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
187 (substring copyright-current-year -2))
188 (if (or noquery
189 (save-window-excursion
190 (switch-to-buffer (current-buffer))
191 ;; Fixes some point-moving oddness (bug#2209).
192 (save-excursion
193 (y-or-n-p (if replace
194 (concat "Replace copyright year(s) by "
195 copyright-current-year "? ")
196 (concat "Add " copyright-current-year
197 " to copyright? "))))))
198 (if replace
199 (replace-match copyright-current-year t t nil 3)
200 (let ((size (save-excursion (skip-chars-backward "0-9"))))
201 (if (and (eq (% (- (string-to-number copyright-current-year)
202 (string-to-number (buffer-substring
203 (+ (point) size)
204 (point))))
205 100)
206 1)
207 (or (eq (char-after (+ (point) size -1)) ?-)
208 (eq (char-after (+ (point) size -2)) ?-)))
209 ;; This is a range so just replace the end part.
210 (delete-char size)
211 ;; Insert a comma with the preferred number of spaces.
212 (insert
213 (save-excursion
214 (if (re-search-backward "[0-9]\\( *, *\\)[0-9]"
215 (line-beginning-position) t)
216 (match-string 1)
217 ", ")))
218 ;; If people use the '91 '92 '93 scheme, do that as well.
219 (if (eq (char-after (+ (point) size -3)) ?')
220 (insert ?')))
221 ;; Finally insert the new year.
222 (insert (substring copyright-current-year size)))))))
223
224 ;;;###autoload
225 (defun copyright-update (&optional arg interactivep)
226 "Update copyright notice to indicate the current year.
227 With prefix ARG, replace the years in the notice rather than adding
228 the current year after them. If necessary, and
229 `copyright-current-gpl-version' is set, any copying permissions
230 following the copyright are updated as well.
231 If non-nil, INTERACTIVEP tells the function to behave as when it's called
232 interactively."
233 (interactive "*P\nd")
234 (when (or copyright-update interactivep)
235 (let ((noquery (or (not copyright-query)
236 (and (eq copyright-query 'function) interactivep))))
237 (save-excursion
238 (save-restriction
239 ;; If names-regexp doesn't match, we should not mess with
240 ;; the years _or_ the GPL version.
241 ;; TODO there may be multiple copyrights we should update.
242 (when (copyright-find-copyright)
243 (copyright-update-year arg noquery)
244 (goto-char (copyright-start-point))
245 (and copyright-current-gpl-version
246 ;; Match the GPL version comment in .el files.
247 ;; This is sensitive to line-breaks. :(
248 (copyright-re-search
249 "the Free Software Foundation[,;\n].*either version \
250 \\([0-9]+\\)\\(?: of the License\\)?, or[ \n].*any later version"
251 (copyright-limit) t)
252 ;; Don't update if the file is already using a more recent
253 ;; version than the "current" one.
254 (< (string-to-number (match-string 1))
255 (string-to-number copyright-current-gpl-version))
256 (or noquery
257 (save-match-data
258 (goto-char (match-end 1))
259 (save-window-excursion
260 (switch-to-buffer (current-buffer))
261 (y-or-n-p
262 (format "Replace GPL version %s with version %s? "
263 (match-string-no-properties 1)
264 copyright-current-gpl-version)))))
265 (replace-match copyright-current-gpl-version t t nil 1))))
266 (set (make-local-variable 'copyright-update) nil)))
267 ;; If a write-file-hook returns non-nil, the file is presumed to be written.
268 nil))
269
270
271 ;; FIXME heuristic should be within 50 years of present (cf calendar).
272 ;;;###autoload
273 (defun copyright-fix-years ()
274 "Convert 2 digit years to 4 digit years.
275 Uses heuristic: year >= 50 means 19xx, < 50 means 20xx.
276 If `copyright-year-ranges' (which see) is non-nil, also
277 independently replaces consecutive years with a range."
278 (interactive)
279 ;; TODO there may be multiple copyrights we should fix.
280 (if (copyright-find-copyright)
281 (let ((s (match-beginning 3))
282 (p (make-marker))
283 ;; Not line-beg-pos, so we don't mess up leading whitespace.
284 (copystart (match-beginning 0))
285 e last sep year prev-year first-year range-start range-end)
286 ;; In case years are continued over multiple, commented lines.
287 (goto-char (match-end 1))
288 (copyright-find-end)
289 (setq e (copy-marker (1+ (match-end 3))))
290 (goto-char s)
291 (while (re-search-forward "[0-9]+" e t)
292 (set-marker p (point))
293 (goto-char (match-beginning 0))
294 (setq year (string-to-number (match-string 0)))
295 (and (setq sep (char-before))
296 (/= (char-syntax sep) ?\s)
297 (/= sep ?-)
298 (insert " "))
299 (when (< year 100)
300 (insert (if (>= year 50) "19" "20"))
301 (setq year (+ year (if (>= year 50) 1900 2000))))
302 (goto-char p)
303 (when copyright-year-ranges
304 ;; If the previous thing was a range, don't try to tack more on.
305 ;; Ie not 2000-2005 -> 2000-2005-2007
306 ;; TODO should merge into existing range if possible.
307 (if (eq sep ?-)
308 (setq prev-year nil
309 year nil)
310 (if (and prev-year (= year (1+ prev-year)))
311 (setq range-end (point))
312 (when (and first-year prev-year
313 (> prev-year first-year))
314 (goto-char range-end)
315 (delete-region range-start range-end)
316 (insert (format "-%d" prev-year))
317 (goto-char p))
318 (setq first-year year
319 range-start (point)))))
320 (setq prev-year year
321 last p))
322 (when last
323 (when (and copyright-year-ranges
324 first-year prev-year
325 (> prev-year first-year))
326 (goto-char range-end)
327 (delete-region range-start range-end)
328 (insert (format "-%d" prev-year)))
329 (goto-char last)
330 ;; Don't mess up whitespace after the years.
331 (skip-chars-backward " \t")
332 (save-restriction
333 (narrow-to-region copystart (point))
334 ;; This is clearly wrong, eg what about comment markers?
335 ;;; (let ((fill-prefix " "))
336 ;; TODO do not break copyright owner over lines.
337 (fill-region (point-min) (point-max))))
338 (set-marker e nil)
339 (set-marker p nil))
340 ;; Simply reformatting the years is not copyrightable, so it does
341 ;; not seem right to call this. Also it messes with ranges.
342 ;;; (copyright-update nil t))
343 (message "No copyright message")))
344
345 ;;;###autoload
346 (define-skeleton copyright
347 "Insert a copyright by $ORGANIZATION notice at cursor."
348 "Company: "
349 comment-start
350 "Copyright (C) " `(substring (current-time-string) -4) " by "
351 (or (getenv "ORGANIZATION")
352 str)
353 '(if (copyright-offset-too-large-p)
354 (message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))
355 comment-end \n)
356
357 ;; TODO: recurse, exclude COPYING etc.
358 ;;;###autoload
359 (defun copyright-update-directory (directory match &optional fix)
360 "Update copyright notice for all files in DIRECTORY matching MATCH.
361 If FIX is non-nil, run `copyright-fix-years' instead."
362 (interactive "DDirectory: \nMFilenames matching (regexp): ")
363 (dolist (file (directory-files directory t match nil))
364 (unless (file-directory-p file)
365 (message "Updating file `%s'" file)
366 (find-file file)
367 (let ((inhibit-read-only t)
368 (enable-local-variables :safe)
369 copyright-query)
370 (if fix
371 (copyright-fix-years)
372 (copyright-update)))
373 (save-buffer)
374 (kill-buffer (current-buffer)))))
375
376 (provide 'copyright)
377
378 ;; For the copyright sign:
379 ;; Local Variables:
380 ;; coding: utf-8
381 ;; End:
382
383 ;;; copyright.el ends here