mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-24 10:38:38 +00:00
Code Issues Releases Activity

*** empty log message ***

Browse Source
This commit is contained in:
Roland McGrath 1992-03-16 06:13:09 +00:00
parent 9fd54390a8
commit c810ea9018
1 changed files with 86 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
lisp/emacs-lisp/copyright.el
View File

@ -1,5 +1,5 @@
;;; Copyright (C) 1991 Free Software Foundation, Inc.
;;; Written by Roland McGrath
;;; 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
@ -27,60 +27,105 @@
"*If non-nil, replace copying notices with this file.")
;;;###autoload
(defun update-copyright (&optional replace)
(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."
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)
(message "Copyright notice already includes %s." current-year)
(or ask-upd
(message "Copyright notice already includes %s." current-year))
(goto-char (point-min))
(or (re-search-forward
"[Cc]opyright[^0-9]*\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+"
nil t)
(error "This buffer contains no copyright notice!"))
(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.
(or (search-forward "copyright" nil t)
(error "Copyright notice not found!"))
;; 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 "\
(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 "\
(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)))))))
(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!")))))))
;;;###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)