lisp/emacs-lisp/copyright.el

   1 ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
   2
   3 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
   4 ;; Last-Modified: 03 Jun 1991
   5 ;; Keywords: maint
   6
   7 ;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc.
   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
  24 ;;; Code:
  25
  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
  32 ;;;###autoload
  33 (defvar replace-copying-with nil
  34   "*If non-nil, replace copying notices with this file.")
  35
  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
  40 ;;;###autoload
  41 (defun update-copyright (&optional replace ask-upd ask-year)
  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
  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."
  53   (interactive "*P")
  54   (save-excursion
  55     (save-restriction
  56       (widen)
  57       (goto-char (point-min))
  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)
  63           (or ask-upd
  64               (message "Copyright notice already includes %s." current-year))
  65         (goto-char (point-min))
  66         (if (and (not inhibit-update-copyright)
  67                  (or (not ask-upd)
  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))))
  73                  (re-search-forward
  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)
  83                          (or (y-or-n-p "Update copyright? ")
  84                              (progn
  85                                (set (make-local-variable
  86                                      'inhibit-update-copyright) t)
  87                                nil))))))
  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)
 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 "\
 118 I don't know where the copying notice begins.
 119 Put point there and hit \\[exit-recursive-edit]."))
 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 "\
 125 I don't know where the copying notice ends.
 126 Put point there and hit \\[exit-recursive-edit]."))
 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))))
 137           (or ask-upd
 138               (error "This buffer contains no copyright notice!"))))))))
 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)
 149
 150 (provide 'upd-copyr)
 151
 152 ;;; upd-copyr.el ends here