home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / upd-copyr.el < prev    next >
Encoding:
Text File  |  1993-01-11  |  4.8 KB  |  134 lines
  1. ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs elisp file
  2.  
  3. ;;; Copyright (C) 1991-1993 Free Software Foundation, Inc.
  4. ;;; Written by Roland McGrath; hacked on by Jamie Zawinski.
  5. ;;;
  6. ;;; This program is free software; you can redistribute it and/or modify
  7. ;;; it under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10. ;;;
  11. ;;; This program is distributed in the hope that it will be useful,
  12. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; A copy of the GNU General Public License can be obtained from this
  17. ;;; program's author (send electronic mail to roland@ai.mit.edu) or from
  18. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  19. ;;; 02139, USA.
  20.  
  21. (defconst current-year (substring (current-time-string) -4)
  22.   "String representing the current year.")
  23.  
  24. (defvar current-gpl-version "2"
  25.   "String representing the current version of the GPL.")
  26.  
  27. ;;;###autoload
  28. (defvar replace-copying-with nil
  29.   "*If non-nil, replace copying notices with this file.")
  30.  
  31. ;;;###autoload
  32. (defun update-copyright (&optional replace ask-upd ask-year)
  33.   "Update the copyright notice at the beginning of the buffer
  34. to indicate the current year.  If optional arg REPLACE is given
  35. \(interactively, with prefix arg\) replace the years in the notice
  36. rather than adding the current year after them.
  37. If `replace-copying-with' is set, the copying permissions following the
  38. copyright are replaced as well.
  39.  
  40. If optional third argument ASK is non-nil, the user is prompted for whether
  41. or not to update the copyright.  If optional third argument ASK-YEAR is
  42. non-nil, the user is prompted for whether or not to replace the year rather
  43. than adding to it."
  44.   (interactive "*P")
  45.   (save-excursion
  46.     (save-restriction
  47.       (widen)
  48.       (goto-char (point-min))
  49.       (if (search-forward current-year nil t)
  50.       (or ask-upd
  51.           (message "Copyright notice already includes %s." current-year))
  52.     (goto-char (point-min))
  53.     (if (and (or (not ask-upd)
  54.              ;; If implicit, narrow it down to things that
  55.              ;; look like GPL notices.
  56.              (prog1
  57.              (search-forward "is free software" nil t)
  58.                (goto-char (point-min))))
  59.          (and (re-search-forward
  60.                "[Cc]opyright[^0-9]*\\(\\([-, \t]*\\([0-9]+\\)\\)\\)+.*Free Software Foundation"
  61.                nil t)
  62.               (goto-char (match-end 1)))
  63.          (or (not ask-upd)
  64.              (save-window-excursion
  65.                (pop-to-buffer (current-buffer))
  66.                (save-excursion
  67.              ;; Show the user the copyright.
  68.              (goto-char (point-min))
  69.              (sit-for 0)
  70.              (y-or-n-p "Update copyright? ")))))
  71.         (let ((s (match-beginning 1))
  72.           (e (match-end 1)))
  73.           (goto-char s)
  74.           (cond ((looking-at "[0-9][0-9][0-9][0-9]-")
  75.              (goto-char e)
  76.              (delete-region (match-end 0) e))
  77.             ((looking-at "\\([0-9][0-9][0-9][0-9]\\), *")
  78.              (goto-char (match-end 1))
  79.              (delete-region (match-end 1) e)
  80.              (insert "-"))
  81.             (t
  82.              (goto-char e)
  83.              (insert "-")))
  84.           (insert current-year)
  85.           (message "Copyright updated to %s." current-year)
  86.           (if replace-copying-with
  87.           (let ((case-fold-search t)
  88.             beg)
  89.             (goto-char (point-min))
  90.             ;; Find the beginning of the copyright.
  91.             (if (search-forward "copyright" nil t)
  92.             (progn
  93.               ;; Look for a blank line or a line
  94.               ;; containing only comment chars.
  95.               (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t)
  96.                   (forward-line 1)
  97.                 (with-output-to-temp-buffer "*Help*"
  98.                   (princ (substitute-command-keys "\
  99. I don't know where the copying notice begins.
  100. Put point there and hit \\[exit-recursive-edit]."))
  101.                   (recursive-edit)))
  102.               (setq beg (point))
  103.               (or (search-forward "02139, USA." nil t)
  104.                   (with-output-to-temp-buffer "*Help*"
  105.                 (princ (substitute-command-keys "\
  106. I don't know where the copying notice ends.
  107. Put point there and hit \\[exit-recursive-edit]."))
  108.                 (recursive-edit)))
  109.               (delete-region beg (point))))
  110.             (insert-file replace-copying-with))
  111.         (if (re-search-forward
  112.              "; either version \\(.+\\), or (at your option)"
  113.              nil t)
  114.             (progn
  115.               (goto-char (match-beginning 1))
  116.               (delete-region (point) (match-end 1))
  117.               (insert current-gpl-version)))))
  118.       (or ask-upd
  119.           (error "This buffer contains no copyright notice!")))))))
  120.  
  121. ;;;###autoload
  122. (defun ask-to-update-copyright ()
  123.   "If the current buffer contains a copyright notice that is out of date,
  124. ask the user if it should be updated with `update-copyright' (which see).
  125. Put this on write-file-hooks."
  126.   (update-copyright nil t t)
  127.   ;; Be sure return nil; if a write-file-hook return non-nil,
  128.   ;; the file is presumed to be already written.
  129.   nil)
  130.  
  131. (provide 'upd-copyr)
  132.  
  133. ;;; upd-copyr.el ends here
  134.