diff lisp/packages/upd-copyr.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 131b0175ea99
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/upd-copyr.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,261 @@
+;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
+
+;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
+;;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
+
+;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
+;; hacked on by Jamie Zawinski.
+;; hacked upon by Jonathan Stigelman <Stig@hackvan.com>
+;; Keywords: maint
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; 02139, USA.
+
+;;; Synched up with: Not synched with FSF.
+;;; Apparently mly synched this file with the version of upd-copyr.el
+;;; supplied with FSF 19.22 or 19.23.  Since then, FSF renamed the
+;;; file to copyright.el and basically rewrote it, and Stig and Jamie
+;;; basically rewrote it, so there's not much in common any more.
+
+;;; Code:
+
+;; #### - this will break if you dump it into emacs
+(defconst copyright-year (substring (current-time-string) -4)
+  "String representing the current year.")
+
+;;;###autoload
+(defvar copyright-do-not-disturb "Free Software Foundation, Inc."
+  "*If non-nil, the existing copyright holder is checked against this regexp.
+If it does not match, then a new copyright line is added with the copyright
+holder set to the value of `copyright-whoami'.") 
+
+;;;###autoload
+(defvar copyright-whoami nil
+  "*A string containing the name of the owner of new copyright notices.")
+
+;;;###autoload
+(defvar copyright-notice-file nil
+  "*If non-nil, replace copying notices with this file.")
+
+(defvar copyright-files-to-ignore-regex "loaddefs.el$"
+  "*Regular expression for files that should be ignored")
+
+(defvar current-gpl-version "2"
+  "String representing the current version of the GPL.")
+
+(defvar copyright-inhibit-update 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-search-limit 2048
+  "Portion of file to search for copyright notices")
+
+;;;###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 `copyright-notice-file' 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 fourth argument ASK-YEAR is
+non-nil, the user is prompted for whether or not to replace the year rather
+than adding to it."
+  (interactive "*P")
+  (or (and ask-upd copyright-inhibit-update)
+      (and buffer-file-truename
+	   (string-match copyright-files-to-ignore-regex buffer-file-truename))
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (goto-char (point-min))
+	  (narrow-to-region (point-min)
+			    (min copyright-search-limit (point-max)))
+	  ;; Handle abbreviated year lists like "1800, 01, 02, 03"
+	  ;; or "1900, '01, '02, '03".
+	  (let ((case-fold-search t)
+		p-string holder add-new
+		mine current
+		cw-current cw-mine last-cw
+		(cw-position '(lambda ()
+				(goto-char (point-min))
+				(cond (cw-mine (goto-char cw-mine))
+				      ((or (and last-cw (goto-char last-cw))
+					   (re-search-forward
+					    "copyright[^0-9\n]*\\([-, \t]*\\([0-9]+\\)\\)+"
+					    nil t))
+				       (and add-new (beginning-of-line 2)))
+				      (t (goto-char (point-min)))))))
+	    ;; scan for all copyrights
+	    (while (re-search-forward
+		    (concat "^\\(.*\\)copyright.*\\(" (substring copyright-year 0 2)
+			    "\\)?" "\\([0-9][0-9]\\(, \t\\)+\\)*'?"
+			    "\\(\\(" (substring copyright-year 2) "\\)\\|[0-9][0-9]\\)\\s *\\(\\S .*\\)$")
+		    nil t)
+	      (buffer-substring (match-beginning 0) (match-end 0))
+	      (setq p-string (buffer-substring (match-beginning 1)
+					       (match-end 1))
+		    last-cw   (match-end 5)
+		    holder    (buffer-substring (match-beginning 7)
+						(match-end 7))
+		    current    (match-beginning 6)
+		    mine	   (string-match copyright-do-not-disturb holder)
+		    cw-current (if mine
+				   current
+				 (or cw-current current))
+		    cw-mine (or cw-mine (and mine last-cw))
+		    ))
+	    ;; ok, now decide if a new copyright is needed...
+	    (setq add-new (not cw-mine))
+	    (or ask-upd add-new
+		(message "Copyright notice already includes %s." copyright-year))
+	    (goto-char (point-min))
+	    (cond ((and cw-current cw-mine)
+		   (or ask-upd (message "The copyright is up to date"))
+		   (copyright-check-notice))
+		  ((and (or add-new (not cw-current))
+			;; #### - doesn't bother to ask about non-GPL sources
+			(or (not ask-upd)
+			    (prog1
+				(search-forward "is free software" nil t)
+			      (goto-char (point-min))))
+			;; adding a new copyright or one exists already...
+			(or add-new last-cw)
+			;; adding a new copyright or the user wants to update...
+			(or (not ask-upd)
+			    (save-window-excursion
+			      (pop-to-buffer (current-buffer))
+			      ;; Show user the copyright.
+			      (funcall cw-position)
+			      (sit-for 0)
+			      (or (y-or-n-p "Update copyright? ")
+				  (progn
+				    (set (make-local-variable
+					  'copyright-inhibit-update) t)
+				    nil)))))
+		   ;; The "XEmacs change" below effectively disabled this
+		   ;; already, so I'm gonna comment it out entirely...  --Stig
+		   ;; (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))
+		   ;;                    ;;XEmacs change
+		   ;;                    ;; (sit-for 0)
+		   ;;                    ;; (y-or-n-p "Replace copyright year? ")
+		   ;;                    nil
+		   ;;                    )))))
+		   (cond (add-new
+			  ;; the cursor should already be at the beginning of a
+			  ;; line here...
+			  (funcall cw-position)
+			  (setq holder (or copyright-whoami
+					   (read-string "New copyright holder: ")))
+			  (if p-string (insert p-string) (indent-for-comment))
+			  (insert "Copyright (C) ")
+			  (save-excursion
+			    (insert " " holder "\n"))
+			  )
+			 (replace
+			  ;; #### - check this...
+			  (beginning-of-line)
+			  (re-search-forward "copyright\\([^0-9]*\\([-, \t]*\\([0-9]+\\)\\)+\\)"
+					     (save-excursion (end-of-line)
+							     (point)))
+			  (delete-region (match-beginning 1) (match-end 1)))
+			 (t (insert ", ")
+			    ;; This did the wrong thing:  "1990-1992" -> "1990, 1992"
+			    ;; Perhaps "1990, 1991, 1992" would be an appropriate 
+			    ;; substitution, but "1990-1992" is satisfactory.  --Stig
+			    ;;
+			    ;; XEmacs addition
+			    ;; (save-excursion
+			    ;;   (goto-char (match-beginning 1))
+			    ;;   (if (looking-at "[0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9]")
+			    ;;       (progn (forward-char 4)
+			    ;; 	     (delete-char 1)
+			    ;; 	     (insert ", "))))
+			    ))
+		   (insert copyright-year)
+		   ;; XEmacs addition
+		   ;; #### - this assumes lisp and shouldn't
+		   (if (save-excursion
+			 (end-of-line)
+			 (>= (current-column) fill-column))
+		       (if (= (char-syntax ?\;) ?<)
+			   (insert "\n;;;")
+			 (insert "\n  ")))
+		   (message "Copyright updated to %s%s."
+			    (if replace "" "include ") copyright-year)
+		   (copyright-check-notice)
+		   ;; show the newly-munged copyright.
+		   (message "The copyright has been updated")
+		   (sit-for 1))
+		  ((not ask-upd)
+		   (error "This buffer does not contain a copyright notice!"))
+		  ))))))
+
+(defun copyright-check-notice ()
+  (if copyright-notice-file
+      (let (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 with 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 copyright-notice-file))
+    (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)))))
+
+;;;###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)
+
+(provide 'upd-copyr)
+
+;;; upd-copyr.el ends here