Mercurial > emacs
annotate lisp/emacs-lisp/copyright.el @ 782:a6d00bdb2b60
*** empty log message ***
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 15 Jul 1992 17:54:00 +0000 |
parents | 9c89fd7ddd41 |
children | 45d748a65f24 |
rev | line source |
---|---|
657
fec3f9a1e3e5
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
611
diff
changeset
|
1 ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs elisp file |
fec3f9a1e3e5
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
611
diff
changeset
|
2 |
773
9c89fd7ddd41
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
718
diff
changeset
|
3 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu> |
9c89fd7ddd41
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
718
diff
changeset
|
4 ;; Last-Modified: 03 Jun 1991 |
9c89fd7ddd41
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
718
diff
changeset
|
5 |
581 | 6 ;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc. |
288 | 7 ;;; |
8 ;;; This program is free software; you can redistribute it and/or modify | |
9 ;;; it under the terms of the GNU General Public License as published by | |
10 ;;; the Free Software Foundation; either version 2, or (at your option) | |
11 ;;; any later version. | |
12 ;;; | |
13 ;;; This program is distributed in the hope that it will be useful, | |
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 ;;; GNU General Public License for more details. | |
17 ;;; | |
18 ;;; A copy of the GNU General Public License can be obtained from this | |
19 ;;; program's author (send electronic mail to roland@ai.mit.edu) or from | |
20 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA | |
21 ;;; 02139, USA. | |
22 | |
773
9c89fd7ddd41
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
718
diff
changeset
|
23 ;;; Code: |
9c89fd7ddd41
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
718
diff
changeset
|
24 |
288 | 25 (defconst current-year (substring (current-time-string) -4) |
26 "String representing the current year.") | |
27 | |
28 (defvar current-gpl-version "2" | |
29 "String representing the current version of the GPL.") | |
30 | |
290 | 31 ;;;###autoload |
288 | 32 (defvar replace-copying-with nil |
33 "*If non-nil, replace copying notices with this file.") | |
34 | |
718 | 35 (defvar inhibit-update-copyright nil |
36 "If nil, ask the user whether or not to update the copyright notice. | |
37 If the user has said no, we set this to t locally.") | |
38 | |
288 | 39 ;;;###autoload |
581 | 40 (defun update-copyright (&optional replace ask-upd ask-year) |
288 | 41 "Update the copyright notice at the beginning of the buffer |
42 to indicate the current year. If optional arg REPLACE is given | |
43 \(interactively, with prefix arg\) replace the years in the notice | |
44 rather than adding the current year after them. | |
45 If `replace-copying-with' is set, the copying permissions following the | |
581 | 46 copyright are replaced as well. |
47 | |
48 If optional third argument ASK is non-nil, the user is prompted for whether | |
49 or not to update the copyright. If optional third argument ASK-YEAR is | |
50 non-nil, the user is prompted for whether or not to replace the year rather | |
51 than adding to it." | |
288 | 52 (interactive "*P") |
53 (save-excursion | |
54 (save-restriction | |
55 (widen) | |
56 (goto-char (point-min)) | |
718 | 57 ;; Handle abbreviated year lists like "1800, 01, 02, 03". |
58 (if (re-search-forward (concat (substring current-year 0 2) | |
59 "\\([0-9][0-9]\\(,\\s \\)+\\)*" | |
60 (substring current-year 2)) | |
61 nil t) | |
581 | 62 (or ask-upd |
63 (message "Copyright notice already includes %s." current-year)) | |
288 | 64 (goto-char (point-min)) |
718 | 65 (if (and (not inhibit-update-copyright) |
66 (or (not ask-upd) | |
581 | 67 ;; If implicit, narrow it down to things that |
68 ;; look like GPL notices. | |
69 (prog1 | |
70 (search-forward "is free software" nil t) | |
71 (goto-char (point-min)))) | |
718 | 72 (re-search-forward |
581 | 73 "[Cc]opyright[^0-9]*\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+" |
74 nil t) | |
75 (or (not ask-upd) | |
76 (save-window-excursion | |
77 (pop-to-buffer (current-buffer)) | |
78 (save-excursion | |
79 ;; Show the user the copyright. | |
80 (goto-char (point-min)) | |
81 (sit-for 0) | |
718 | 82 (or (y-or-n-p "Update copyright? ") |
83 (progn | |
84 (set (make-local-variable | |
85 'inhibit-update-copyright) t) | |
86 nil)))))) | |
581 | 87 (progn |
88 (setq replace | |
89 (or replace | |
90 (and ask-year | |
91 (save-window-excursion | |
92 (pop-to-buffer (current-buffer)) | |
93 (save-excursion | |
94 ;; Show the user the copyright. | |
95 (goto-char (point-min)) | |
96 (sit-for 0) | |
97 (y-or-n-p "Replace copyright year? ")))))) | |
98 (if replace | |
99 (delete-region (match-beginning 1) (match-end 1)) | |
100 (insert ", ")) | |
101 (insert current-year) | |
102 (message "Copyright updated to %s%s." | |
103 (if replace "" "include ") current-year) | |
611 | 104 (if replace-copying-with |
105 (let ((case-fold-search t) | |
106 beg) | |
107 (goto-char (point-min)) | |
108 ;; Find the beginning of the copyright. | |
109 (if (search-forward "copyright" nil t) | |
110 (progn | |
111 ;; Look for a blank line or a line | |
112 ;; containing only comment chars. | |
113 (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t) | |
114 (forward-line 1) | |
115 (with-output-to-temp-buffer "*Help*" | |
116 (princ (substitute-command-keys "\ | |
288 | 117 I don't know where the copying notice begins. |
118 Put point there and hit \\[exit-recursive-edit].")) | |
611 | 119 (recursive-edit))) |
120 (setq beg (point)) | |
121 (or (search-forward "02139, USA." nil t) | |
122 (with-output-to-temp-buffer "*Help*" | |
123 (princ (substitute-command-keys "\ | |
291 | 124 I don't know where the copying notice ends. |
288 | 125 Put point there and hit \\[exit-recursive-edit].")) |
611 | 126 (recursive-edit))) |
127 (delete-region beg (point)))) | |
128 (insert-file replace-copying-with)) | |
129 (if (re-search-forward | |
130 "; either version \\(.+\\), or (at your option)" | |
131 nil t) | |
132 (progn | |
133 (goto-char (match-beginning 1)) | |
134 (delete-region (point) (match-end 1)) | |
135 (insert current-gpl-version)))) | |
581 | 136 (or ask-upd |
611 | 137 (error "This buffer contains no copyright notice!")))))))) |
581 | 138 |
139 ;;;###autoload | |
140 (defun ask-to-update-copyright () | |
141 "If the current buffer contains a copyright notice that is out of date, | |
142 ask the user if it should be updated with `update-copyright' (which see). | |
143 Put this on write-file-hooks." | |
144 (update-copyright nil t t) | |
145 ;; Be sure return nil; if a write-file-hook return non-nil, | |
146 ;; the file is presumed to be already written. | |
147 nil) | |
288 | 148 |
149 (provide 'upd-copyr) | |
657
fec3f9a1e3e5
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
611
diff
changeset
|
150 |
fec3f9a1e3e5
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
611
diff
changeset
|
151 ;;; upd-copyr.el ends here |