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