]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/copyright.el
Initial revision
[gnu-emacs] / lisp / emacs-lisp / copyright.el
index 2856e17c26448e451c734bbabe55807303320eda..01dedb7237e987ce92440ba636d1f52f6b89b1fe 100644 (file)
-;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
-
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
-;; Last-Modified: 03 Jun 1991
-
-;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc.
-;;;
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; A copy of the GNU General Public License can be obtained from this
-;;; program's author (send electronic mail to roland@ai.mit.edu) or from
-;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
-;;; 02139, USA.
+;;; copyright.el --- update the copyright notice in current buffer
+
+;; Copyright (C) 1991, 92, 93, 94, 95, 1998 Free Software Foundation, Inc.
+
+;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de
+;;              fax (+49 69) 7588-2389
+;; Keywords: maint, tools
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Allows updating the copyright year and above mentioned GPL version manually
+;; or when saving a file.  Do (add-hook 'write-file-hooks 'copyright-update).
 
 ;;; Code:
 
-(defconst current-year (substring (current-time-string) -4)
+(defgroup copyright nil
+  "Update the copyright notice in current buffer."
+  :group 'tools)
+
+(defcustom copyright-limit 2000
+  "*Don't try to update copyright beyond this position unless interactive.
+`nil' means to search whole buffer."
+  :group 'copyright
+  :type '(choice (integer :tag "Limit")
+                (const :tag "No limit")))
+
+
+(defcustom copyright-regexp
+  "\\([\251\81©]\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *(C)\
+\\|[Cc]opyright\\s *:?\\s *[\251\81©]\\)\
+\\s *\\([1-9][-0-9, ']*[0-9]+\\) "
+  "*What your copyright notice looks like.
+The second \\( \\) construct must match the years."
+  :group 'copyright
+  :type 'regexp)
+
+
+(defcustom copyright-query 'function
+  "*If non-`nil', ask user before changing copyright.
+When this is `function', only ask when called non-interactively."
+  :group 'copyright
+  :type '(choice (const :tag "Do not ask")
+                (const :tag "Ask" t)
+                (const :tag "Ask unless interactive" function)))
+
+
+(defconst copyright-current-year (substring (current-time-string) -4)
   "String representing the current year.")
 
-(defvar current-gpl-version "2"
-  "String representing the current version of the GPL.")
 
-;;;###autoload
-(defvar replace-copying-with nil
-  "*If non-nil, replace copying notices with this file.")
+;; when modifying this, also modify the comment generated by autoinsert.el
+(defconst copyright-current-gpl-version "2"
+  "String representing the current version of the GPL or `nil'.")
 
-(defvar inhibit-update-copyright nil
-  "If nil, ask the user whether or not to update the copyright notice.
-If the user has said no, we set this to t locally.")
+(defvar copyright-update t)
 
 ;;;###autoload
-(defun update-copyright (&optional replace ask-upd ask-year)
-  "Update the copyright notice at the beginning of the buffer
-to indicate the current year.  If optional arg REPLACE is given
-\(interactively, with prefix arg\) replace the years in the notice
-rather than adding the current year after them.
-If `replace-copying-with' is set, the copying permissions following the
-copyright are replaced as well.
-
-If optional third argument ASK is non-nil, the user is prompted for whether
-or not to update the copyright.  If optional third argument ASK-YEAR is
-non-nil, the user is prompted for whether or not to replace the year rather
-than adding to it."
+(defun copyright-update (&optional arg)
+  "Update the copyright notice at the beginning of the buffer to indicate
+the current year.  If optional prefix ARG is given replace the years in the
+notice rather than adding the current year after them.  If necessary and
+`copyright-current-gpl-version' is set, the copying permissions following the
+copyright, if any, are updated as well."
   (interactive "*P")
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      ;; Handle abbreviated year lists like "1800, 01, 02, 03".
-      (if (re-search-forward (concat (substring current-year 0 2)
-                                    "\\([0-9][0-9]\\(,\\s \\)+\\)*"
-                                    (substring current-year 2))
-                            nil t)
-         (or ask-upd
-             (message "Copyright notice already includes %s." current-year))
-       (goto-char (point-min))
-       (if (and (not inhibit-update-copyright)
-                (or (not ask-upd)
-                    ;; If implicit, narrow it down to things that
-                    ;; look like GPL notices.
-                    (prog1
-                        (search-forward "is free software" nil t)
-                      (goto-char (point-min))))
-                (re-search-forward
-                 "[Cc]opyright[^0-9]*\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+"
-                 nil t)
-                (or (not ask-upd)
-                    (save-window-excursion
-                      (pop-to-buffer (current-buffer))
-                      (save-excursion
-                        ;; Show the user the copyright.
-                        (goto-char (point-min))
-                        (sit-for 0)
-                        (or (y-or-n-p "Update copyright? ")
-                            (progn
-                              (set (make-local-variable
-                                    'inhibit-update-copyright) t)
-                              nil))))))
-           (progn
-             (setq replace
-                   (or replace
-                       (and ask-year
-                            (save-window-excursion
-                              (pop-to-buffer (current-buffer))
-                              (save-excursion
-                                ;; Show the user the copyright.
-                                (goto-char (point-min))
-                                (sit-for 0)
-                                (y-or-n-p "Replace copyright year? "))))))
-             (if replace
-                 (delete-region (match-beginning 1) (match-end 1))
-               (insert ", "))
-             (insert current-year)
-             (message "Copyright updated to %s%s."
-                      (if replace "" "include ") current-year)
-         (if replace-copying-with
-             (let ((case-fold-search t)
-                   beg)
-               (goto-char (point-min))
-               ;; Find the beginning of the copyright.
-               (if (search-forward "copyright" nil t)
-                   (progn
-                     ;; Look for a blank line or a line
-                     ;; containing only comment chars.
-                     (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t)
-                         (forward-line 1)
-                       (with-output-to-temp-buffer "*Help*"
-                         (princ (substitute-command-keys "\
-I don't know where the copying notice begins.
-Put point there and hit \\[exit-recursive-edit]."))
-                         (recursive-edit)))
-                     (setq beg (point))
-                     (or (search-forward "02139, USA." nil t)
-                         (with-output-to-temp-buffer "*Help*"
-                           (princ (substitute-command-keys "\
-I don't know where the copying notice ends.
-Put point there and hit \\[exit-recursive-edit]."))
-                           (recursive-edit)))
-                     (delete-region beg (point))))
-               (insert-file replace-copying-with))
-           (if (re-search-forward
-                "; either version \\(.+\\), or (at your option)"
-                nil t)
-               (progn
-                 (goto-char (match-beginning 1))
-                 (delete-region (point) (match-end 1))
-                 (insert current-gpl-version))))
-         (or ask-upd
-             (error "This buffer contains no copyright notice!"))))))))
+  (if copyright-update
+      (save-excursion
+       (save-restriction
+         (widen)
+         (goto-char (point-min))
+         (if (re-search-forward copyright-regexp copyright-limit t)
+             (if (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
+                          (substring copyright-current-year -2))
+                 ()
+               (backward-char 1)
+               (if (or (not copyright-query)
+                       (and (eq copyright-query 'function)
+                            (eq this-command 'copyright-update))
+                       (y-or-n-p (if arg
+                                     (concat "Replace copyright year(s) by "
+                                             copyright-current-year "? ")
+                                   (concat "Add " copyright-current-year
+                                           " to copyright? ")))) 
+                   (if arg
+                       (progn
+                         (delete-region (match-beginning 1) (match-end 1))
+                         (insert copyright-current-year))
+                     (setq arg (save-excursion (skip-chars-backward "0-9")))
+                     (if (and (eq (% (- (string-to-number
+                                         copyright-current-year)
+                                        (string-to-number (buffer-substring
+                                                           (+ (point) arg)
+                                                           (point))))
+                                     100)
+                                  1)
+                              (or (eq (char-after (+ (point) arg -1)) ?-)
+                                  (eq (char-after (+ (point) arg -2)) ?-)))
+                         (delete-char arg)
+                       (insert ", ")
+                       (if (eq (char-after (+ (point) arg -3)) ?')
+                           (insert ?')))
+                     (insert (substring copyright-current-year arg))))))
+         (goto-char (point-min))
+         (and copyright-current-gpl-version
+              ;; match the GPL version comment in .el files, including the
+              ;; bilingual Esperanto one in two-column, and in texinfo.tex
+              (re-search-forward "\\(the Free Software Foundation; either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via  \\)version \\([0-9]+\\), or (at"
+                                 copyright-limit t)
+              (not (string= (buffer-substring (match-beginning 3) (match-end 3))
+                            copyright-current-gpl-version))
+              (or (not copyright-query)
+                  (and (eq copyright-query 'function)
+                       (eq this-command 'copyright-update))
+                  (y-or-n-p (concat "Replace GPL version by "
+                                    copyright-current-gpl-version "? ")))
+              (progn
+                (if (match-end 2)
+                    ;; Esperanto bilingual comment in two-column.el
+                    (progn
+                      (delete-region (match-beginning 2) (match-end 2))
+                      (goto-char (match-beginning 2))
+                      (insert copyright-current-gpl-version)))
+                (delete-region (match-beginning 3) (match-end 3))
+                (goto-char (match-beginning 3))
+                (insert copyright-current-gpl-version))))
+       (set (make-local-variable 'copyright-update) nil)))
+  ;; If a write-file-hook returns non-nil, the file is presumed to be written.
+  nil)
+
 
 ;;;###autoload
-(defun ask-to-update-copyright ()
-  "If the current buffer contains a copyright notice that is out of date,
-ask the user if it should be updated with `update-copyright' (which see).
-Put this on write-file-hooks."
-  (update-copyright nil t t)
-  ;; Be sure return nil; if a write-file-hook return non-nil,
-  ;; the file is presumed to be already written.
-  nil)
+(define-skeleton copyright
+  "Insert a copyright by $ORGANIZATION notice at cursor."
+  "Company: "
+  comment-start
+  "Copyright (C) " copyright-current-year " by "
+  (or (getenv "ORGANIZATION")
+      str)
+  '(if (> (point) copyright-limit)
+       (message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))
+  comment-end)
 
-(provide 'upd-copyr)
+(provide 'copyright)
 
-;;; upd-copyr.el ends here
+;; copyright.el ends here