X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2b79d7330d6069a2eb05e2997cd6c30a8ea54528..654359e2e3cbae9727b2bf6a298054bee9e10d41:/lisp/emacs-lisp/copyright.el diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index d7d20af1d7..3d160f5460 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,130 +1,200 @@ -;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc. -;;; Written by Roland McGrath. -;;; -;;; 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. - -(defconst current-year (substring (current-time-string) -4) +;;; copyright.el --- update the copyright notice in current buffer + +;; Copyright (C) 1991, 92, 93, 94, 95, 1998, 2001, 2003, 2004 +;; Free Software Foundation, Inc. + +;; Author: Daniel Pfeiffer +;; 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 'before-save-hook 'copyright-update), or use +;; M-x customize-variable RET before-save-hook RET. + +;;; Code: + +(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. +A value of nil means to search whole buffer." + :group 'copyright + :type '(choice (integer :tag "Limit") + (const :tag "No limit"))) + +;; The character classes have the Latin-1 version and the Latin-9 +;; version, which is probably enough. +(defcustom copyright-regexp + "\\([©Ž©]\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\ +\\|[Cc]opyright\\s *:?\\s *[©Ž©]\\)\ +\\s *\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" + "*What your copyright notice looks like. +The second \\( \\) construct must match the years." + :group 'copyright + :type 'regexp) + +(defcustom copyright-years-regexp + "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" + "*Match additional copyright notice years. +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 unless interactive" function) + (other :tag "Ask" t))) + + +;; 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 copyright-update t) + +;; This is a defvar rather than a defconst, because the year can +;; change during the Emacs session. +(defvar 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.") +(defun copyright-update-year (replace noquery) + (when (re-search-forward copyright-regexp (+ (point) copyright-limit) t) + ;; If the years are continued onto multiple lined + ;; that are marked as comments, skip to the end of the years anyway. + (while (save-excursion + (and (eq (following-char) ?,) + (progn (forward-char 1) t) + (progn (skip-chars-forward " \t") (eolp)) + comment-start-skip + (save-match-data + (forward-line 1) + (and (looking-at comment-start-skip) + (goto-char (match-end 0)))) + (save-match-data + (looking-at copyright-years-regexp)))) + (forward-line 1) + (re-search-forward comment-start-skip) + (re-search-forward copyright-years-regexp)) -;;;###autoload -(defvar replace-copying-with nil - "*If non-nil, replace copying notices with this file.") + ;; Note that `current-time-string' isn't locale-sensitive. + (setq copyright-current-year (substring (current-time-string) -4)) + (unless (string= (buffer-substring (- (match-end 2) 2) (match-end 2)) + (substring copyright-current-year -2)) + (if (or noquery + (y-or-n-p (if replace + (concat "Replace copyright year(s) by " + copyright-current-year "? ") + (concat "Add " copyright-current-year + " to copyright? ")))) + (if replace + (replace-match copyright-current-year t t nil 1) + (let ((size (save-excursion (skip-chars-backward "0-9")))) + (if (and (eq (% (- (string-to-number copyright-current-year) + (string-to-number (buffer-substring + (+ (point) size) + (point)))) + 100) + 1) + (or (eq (char-after (+ (point) size -1)) ?-) + (eq (char-after (+ (point) size -2)) ?-))) + ;; This is a range so just replace the end part. + (delete-char size) + ;; Insert a comma with the preferred number of spaces. + (insert + (save-excursion + (if (re-search-backward "[0-9]\\( *, *\\)[0-9]" + (line-beginning-position) t) + (match-string 1) + ", "))) + ;; If people use the '91 '92 '93 scheme, do that as well. + (if (eq (char-after (+ (point) size -3)) ?') + (insert ?'))) + ;; Finally insert the new year. + (insert (substring copyright-current-year size)))))))) ;;;###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." - (interactive "*P") - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (if (search-forward current-year nil t) - (or ask-upd - (message "Copyright notice already includes %s." current-year)) - (goto-char (point-min)) - (if (and (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) - (y-or-n-p "Update copyright? "))))) - (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!")))))))) +(defun copyright-update (&optional arg interactivep) + "Update copyright notice at beginning of buffer to indicate the current year. +With prefix ARG, replace the years in the notice rather than adding +the current year after them. If necessary, and +`copyright-current-gpl-version' is set, any copying permissions +following the copyright are updated as well. +If non-nil, INTERACTIVEP tells the function to behave as when it's called +interactively." + (interactive "*P\nd") + (when (or copyright-update interactivep) + (let ((noquery (or (not copyright-query) + (and (eq copyright-query 'function) interactivep)))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (copyright-update-year arg noquery) + (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" + (+ (point) copyright-limit) t) + (not (string= (match-string 3) copyright-current-gpl-version)) + (or noquery + (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 + (replace-match copyright-current-gpl-version t t nil 2)) + (replace-match copyright-current-gpl-version t t nil 3)))) + (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) - -(provide 'upd-copyr) +(define-skeleton copyright + "Insert a copyright by $ORGANIZATION notice at cursor." + "Company: " + comment-start + "Copyright (C) " `(substring (current-time-string) -4) " by " + (or (getenv "ORGANIZATION") + str) + '(if (> (point) (+ (point-min) copyright-limit)) + (message "Copyright extends beyond `copyright-limit' and won't be updated automatically.")) + comment-end \n) + +(provide 'copyright) + +;; For the copyright sign: +;; Local Variables: +;; coding: emacs-mule +;; End: + +;;; arch-tag: b4991afb-b6b1-4590-bebe-e076d9d4aee8 +;;; copyright.el ends here