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 5;; Author: Roland McGrath <roland@gnu.ai.mit.edu> 6;; Keywords: maint 7 8;;; This file is part of GNU Emacs. 9 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 25;;; Code: 26 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 33;;;###autoload 34(defvar replace-copying-with nil 35 "*If non-nil, replace copying notices with this file.") 36 37(defvar inhibit-update-copyright nil 38 "If nil, ask the user whether or not to update the copyright notice. 39If the user has said no, we set this to t locally.") 40 41;;;###autoload 42(defun update-copyright (&optional replace ask-upd ask-year) 43 "Update the copyright notice at the beginning of the buffer 44to indicate the current year. If optional arg REPLACE is given 45\(interactively, with prefix arg\) replace the years in the notice 46rather than adding the current year after them. 47If `replace-copying-with' is set, the copying permissions following the 48copyright are replaced as well. 49 50If optional third argument ASK is non-nil, the user is prompted for whether 51or not to update the copyright. If optional fourth argument ASK-YEAR is 52non-nil, the user is prompted for whether or not to replace the year rather 53than adding to it." 54 (interactive "*P") 55 (save-excursion 56 (save-restriction 57 (widen) 58 (goto-char (point-min)) 59 ;; Handle abbreviated year lists like "1800, 01, 02, 03" 60 ;; or "1900, '01, '02, '03". 61 (if (re-search-forward (concat "\\(" (substring current-year 0 2) 62 "\\)?" 63 "\\([0-9][0-9]\\(,\\s \\)+\\)*'?" 64 (substring current-year 2)) 65 nil t) 66 (or ask-upd 67 (message "Copyright notice already includes %s." current-year)) 68 (goto-char (point-min)) 69 (if (and (not inhibit-update-copyright) 70 (or (not ask-upd) 71 ;; If implicit, narrow it down to things that 72 ;; look like GPL notices. 73 (prog1 74 (search-forward "is free software" nil t) 75 (goto-char (point-min)))) 76 (re-search-forward 77 "[Cc]opyright[^0-9]*\\(\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+\\)" 78 nil t) 79 (or (not ask-upd) 80 (save-window-excursion 81 (pop-to-buffer (current-buffer)) 82 (save-excursion 83 ;; Show the user the copyright. 84 (goto-char (point-min)) 85 (sit-for 0) 86 (or (y-or-n-p "Update copyright? ") 87 (progn 88 (set (make-local-variable 89 'inhibit-update-copyright) t) 90 nil)))))) 91 (progn 92 (setq replace 93 (or replace 94 (and ask-year 95 (save-window-excursion 96 (pop-to-buffer (current-buffer)) 97 (save-excursion 98 ;; Show the user the copyright. 99 (goto-char (point-min)) 100 (sit-for 0) 101 (y-or-n-p "Replace copyright year? ")))))) 102 (if replace 103 (delete-region (match-beginning 1) (match-end 1)) 104 (insert ", ")) 105 (insert current-year) 106 (message "Copyright updated to %s%s." 107 (if replace "" "include ") current-year) 108 (if replace-copying-with 109 (let ((case-fold-search t) 110 beg) 111 (goto-char (point-min)) 112 ;; Find the beginning of the copyright. 113 (if (search-forward "copyright" nil t) 114 (progn 115 ;; Look for a blank line or a line 116 ;; containing only comment chars. 117 (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t) 118 (forward-line 1) 119 (with-output-to-temp-buffer "*Help*" 120 (princ (substitute-command-keys "\ 121I don't know where the copying notice begins. 122Put point there and hit \\[exit-recursive-edit].")) 123 (recursive-edit))) 124 (setq beg (point)) 125 (or (search-forward "02139, USA." nil t) 126 (with-output-to-temp-buffer "*Help*" 127 (princ (substitute-command-keys "\ 128I don't know where the copying notice ends. 129Put point there and hit \\[exit-recursive-edit].")) 130 (recursive-edit))) 131 (delete-region beg (point)))) 132 (insert-file replace-copying-with)) 133 (if (re-search-forward 134 "; either version \\(.+\\), or (at your option)" 135 nil t) 136 (progn 137 (goto-char (match-beginning 1)) 138 (delete-region (point) (match-end 1)) 139 (insert current-gpl-version)))) 140 (or ask-upd 141 (error "This buffer contains no copyright notice!")))))))) 142 143;;;###autoload 144(defun ask-to-update-copyright () 145 "If the current buffer contains a copyright notice that is out of date, 146ask the user if it should be updated with `update-copyright' (which see). 147Put this on write-file-hooks." 148 (update-copyright nil t t) 149 ;; Be sure return nil; if a write-file-hook return non-nil, 150 ;; the file is presumed to be already written. 151 nil) 152 153(provide 'upd-copyr) 154 155;;; upd-copyr.el ends here 156