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