| 1 | ;;; copyright.el --- update the copyright notice in current buffer |
| 2 | |
| 3 | ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1998, 2001, 2002, 2003, |
| 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Daniel Pfeiffer <occitan@esperanto.org> |
| 7 | ;; Keywords: maint, tools |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; Allows updating the copyright year and above mentioned GPL version manually |
| 27 | ;; or when saving a file. |
| 28 | ;; Do (add-hook 'before-save-hook 'copyright-update), or use |
| 29 | ;; M-x customize-variable RET before-save-hook RET. |
| 30 | |
| 31 | ;;; Code: |
| 32 | |
| 33 | (defgroup copyright nil |
| 34 | "Update the copyright notice in current buffer." |
| 35 | :group 'tools) |
| 36 | |
| 37 | (defcustom copyright-limit 2000 |
| 38 | "Don't try to update copyright beyond this position unless interactive. |
| 39 | A value of nil means to search whole buffer." |
| 40 | :group 'copyright |
| 41 | :type '(choice (integer :tag "Limit") |
| 42 | (const :tag "No limit"))) |
| 43 | |
| 44 | (defcustom copyright-at-end-flag nil |
| 45 | "Non-nil means to search backwards from the end of the buffer for copyright. |
| 46 | This is useful for ChangeLogs." |
| 47 | :group 'copyright |
| 48 | :type 'boolean |
| 49 | :version "23.1") |
| 50 | |
| 51 | (defcustom copyright-regexp |
| 52 | "\\(©\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\ |
| 53 | \\|[Cc]opyright\\s *:?\\s *©\\)\ |
| 54 | \\s *\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" |
| 55 | "What your copyright notice looks like. |
| 56 | The second \\( \\) construct must match the years." |
| 57 | :group 'copyright |
| 58 | :type 'regexp) |
| 59 | |
| 60 | (defcustom copyright-names-regexp "" |
| 61 | "Regexp matching the names which correspond to the user. |
| 62 | Only copyright lines where the name matches this regexp will be updated. |
| 63 | This allows you to avoid adding years to a copyright notice belonging to |
| 64 | someone else or to a group for which you do not work." |
| 65 | :group 'copyright |
| 66 | :type 'regexp) |
| 67 | |
| 68 | (defcustom copyright-years-regexp |
| 69 | "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" |
| 70 | "Match additional copyright notice years. |
| 71 | The second \\( \\) construct must match the years." |
| 72 | :group 'copyright |
| 73 | :type 'regexp) |
| 74 | |
| 75 | |
| 76 | (defcustom copyright-query 'function |
| 77 | "If non-nil, ask user before changing copyright. |
| 78 | When this is `function', only ask when called non-interactively." |
| 79 | :group 'copyright |
| 80 | :type '(choice (const :tag "Do not ask") |
| 81 | (const :tag "Ask unless interactive" function) |
| 82 | (other :tag "Ask" t))) |
| 83 | |
| 84 | |
| 85 | ;; when modifying this, also modify the comment generated by autoinsert.el |
| 86 | (defconst copyright-current-gpl-version "3" |
| 87 | "String representing the current version of the GPL or nil.") |
| 88 | |
| 89 | (defvar copyright-update t |
| 90 | "The function `copyright-update' sets this to nil after updating a buffer.") |
| 91 | |
| 92 | ;; This is a defvar rather than a defconst, because the year can |
| 93 | ;; change during the Emacs session. |
| 94 | (defvar copyright-current-year (substring (current-time-string) -4) |
| 95 | "String representing the current year.") |
| 96 | |
| 97 | (defsubst copyright-limit () ; re-search-forward BOUND |
| 98 | (and copyright-limit |
| 99 | (if copyright-at-end-flag |
| 100 | (- (point) copyright-limit) |
| 101 | (+ (point) copyright-limit)))) |
| 102 | |
| 103 | (defun copyright-re-search (regexp &optional bound noerror count) |
| 104 | "Re-search forward or backward depending on `copyright-at-end-flag'." |
| 105 | (if copyright-at-end-flag |
| 106 | (re-search-backward regexp bound noerror count) |
| 107 | (re-search-forward regexp bound noerror count))) |
| 108 | |
| 109 | (defun copyright-start-point () |
| 110 | "Return point-min or point-max, depending on `copyright-at-end-flag'." |
| 111 | (if copyright-at-end-flag |
| 112 | (point-max) |
| 113 | (point-min))) |
| 114 | |
| 115 | (defun copyright-offset-too-large-p () |
| 116 | "Return non-nil if point is too far from the edge of the buffer." |
| 117 | (when copyright-limit |
| 118 | (if copyright-at-end-flag |
| 119 | (< (point) (- (point-max) copyright-limit)) |
| 120 | (> (point) (+ (point-min) copyright-limit))))) |
| 121 | |
| 122 | (defun copyright-update-year (replace noquery) |
| 123 | (when |
| 124 | (condition-case err |
| 125 | ;; (1) Need the extra \\( \\) around copyright-regexp because we |
| 126 | ;; goto (match-end 1) below. See note (2) below. |
| 127 | (copyright-re-search (concat "\\(" copyright-regexp |
| 128 | "\\)\\([ \t]*\n\\)?.*\\(?:" |
| 129 | copyright-names-regexp "\\)") |
| 130 | (copyright-limit) |
| 131 | t) |
| 132 | ;; In case the regexp is rejected. This is useful because |
| 133 | ;; copyright-update is typically called from before-save-hook where |
| 134 | ;; such an error is very inconvenient for the user. |
| 135 | (error (message "Can't update copyright: %s" err) nil)) |
| 136 | (goto-char (match-end 1)) |
| 137 | ;; If the years are continued onto multiple lines |
| 138 | ;; that are marked as comments, skip to the end of the years anyway. |
| 139 | (while (save-excursion |
| 140 | (and (eq (following-char) ?,) |
| 141 | (progn (forward-char 1) t) |
| 142 | (progn (skip-chars-forward " \t") (eolp)) |
| 143 | comment-start-skip |
| 144 | (save-match-data |
| 145 | (forward-line 1) |
| 146 | (and (looking-at comment-start-skip) |
| 147 | (goto-char (match-end 0)))) |
| 148 | (looking-at-p copyright-years-regexp))) |
| 149 | (forward-line 1) |
| 150 | (re-search-forward comment-start-skip) |
| 151 | ;; (2) Need the extra \\( \\) so that the years are subexp 3, as |
| 152 | ;; they are at note (1) above. |
| 153 | (re-search-forward (format "\\(%s\\)" copyright-years-regexp))) |
| 154 | |
| 155 | ;; Note that `current-time-string' isn't locale-sensitive. |
| 156 | (setq copyright-current-year (substring (current-time-string) -4)) |
| 157 | (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3)) |
| 158 | (substring copyright-current-year -2)) |
| 159 | (if (or noquery |
| 160 | (y-or-n-p (if replace |
| 161 | (concat "Replace copyright year(s) by " |
| 162 | copyright-current-year "? ") |
| 163 | (concat "Add " copyright-current-year |
| 164 | " to copyright? ")))) |
| 165 | (if replace |
| 166 | (replace-match copyright-current-year t t nil 3) |
| 167 | (let ((size (save-excursion (skip-chars-backward "0-9")))) |
| 168 | (if (and (eq (% (- (string-to-number copyright-current-year) |
| 169 | (string-to-number (buffer-substring |
| 170 | (+ (point) size) |
| 171 | (point)))) |
| 172 | 100) |
| 173 | 1) |
| 174 | (or (eq (char-after (+ (point) size -1)) ?-) |
| 175 | (eq (char-after (+ (point) size -2)) ?-))) |
| 176 | ;; This is a range so just replace the end part. |
| 177 | (delete-char size) |
| 178 | ;; Insert a comma with the preferred number of spaces. |
| 179 | (insert |
| 180 | (save-excursion |
| 181 | (if (re-search-backward "[0-9]\\( *, *\\)[0-9]" |
| 182 | (line-beginning-position) t) |
| 183 | (match-string 1) |
| 184 | ", "))) |
| 185 | ;; If people use the '91 '92 '93 scheme, do that as well. |
| 186 | (if (eq (char-after (+ (point) size -3)) ?') |
| 187 | (insert ?'))) |
| 188 | ;; Finally insert the new year. |
| 189 | (insert (substring copyright-current-year size)))))))) |
| 190 | |
| 191 | ;;;###autoload |
| 192 | (defun copyright-update (&optional arg interactivep) |
| 193 | "Update copyright notice at beginning of buffer to indicate the current year. |
| 194 | With prefix ARG, replace the years in the notice rather than adding |
| 195 | the current year after them. If necessary, and |
| 196 | `copyright-current-gpl-version' is set, any copying permissions |
| 197 | following the copyright are updated as well. |
| 198 | If non-nil, INTERACTIVEP tells the function to behave as when it's called |
| 199 | interactively." |
| 200 | (interactive "*P\nd") |
| 201 | (when (or copyright-update interactivep) |
| 202 | (let ((noquery (or (not copyright-query) |
| 203 | (and (eq copyright-query 'function) interactivep)))) |
| 204 | (save-excursion |
| 205 | (save-restriction |
| 206 | (widen) |
| 207 | (goto-char (copyright-start-point)) |
| 208 | (copyright-update-year arg noquery) |
| 209 | (goto-char (copyright-start-point)) |
| 210 | (and copyright-current-gpl-version |
| 211 | ;; match the GPL version comment in .el files, including the |
| 212 | ;; bilingual Esperanto one in two-column, and in texinfo.tex |
| 213 | (copyright-re-search |
| 214 | "\\(the Free Software Foundation;\ |
| 215 | either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\ |
| 216 | version \\([0-9]+\\), or (at" |
| 217 | (copyright-limit) t) |
| 218 | ;; Don't update if the file is already using a more recent |
| 219 | ;; version than the "current" one. |
| 220 | (< (string-to-number (match-string 3)) |
| 221 | (string-to-number copyright-current-gpl-version)) |
| 222 | (or noquery |
| 223 | (y-or-n-p (format "Replace GPL version by %s? " |
| 224 | copyright-current-gpl-version))) |
| 225 | (progn |
| 226 | (if (match-end 2) |
| 227 | ;; Esperanto bilingual comment in two-column.el |
| 228 | (replace-match copyright-current-gpl-version t t nil 2)) |
| 229 | (replace-match copyright-current-gpl-version t t nil 3)))) |
| 230 | (set (make-local-variable 'copyright-update) nil))) |
| 231 | ;; If a write-file-hook returns non-nil, the file is presumed to be written. |
| 232 | nil)) |
| 233 | |
| 234 | |
| 235 | ;; FIXME should be within 50 years of present (cf calendar). |
| 236 | ;;;###autoload |
| 237 | (defun copyright-fix-years () |
| 238 | "Convert 2 digit years to 4 digit years. |
| 239 | Uses heuristic: year >= 50 means 19xx, < 50 means 20xx." |
| 240 | (interactive) |
| 241 | (widen) |
| 242 | (goto-char (copyright-start-point)) |
| 243 | (if (copyright-re-search copyright-regexp (copyright-limit) t) |
| 244 | (let ((s (match-beginning 2)) |
| 245 | (e (copy-marker (1+ (match-end 2)))) |
| 246 | (p (make-marker)) |
| 247 | last) |
| 248 | (goto-char s) |
| 249 | (while (re-search-forward "[0-9]+" e t) |
| 250 | (set-marker p (point)) |
| 251 | (goto-char (match-beginning 0)) |
| 252 | (let ((sep (char-before)) |
| 253 | (year (string-to-number (match-string 0)))) |
| 254 | (when (and sep |
| 255 | (/= (char-syntax sep) ?\s) |
| 256 | (/= sep ?-)) |
| 257 | (insert " ")) |
| 258 | (when (< year 100) |
| 259 | (insert (if (>= year 50) "19" "20")))) |
| 260 | (goto-char p) |
| 261 | (setq last p)) |
| 262 | (when last |
| 263 | (goto-char last) |
| 264 | ;; Don't mess up whitespace after the years. |
| 265 | (skip-chars-backward " \t") |
| 266 | (save-restriction |
| 267 | (narrow-to-region (copyright-start-point) (point)) |
| 268 | (let ((fill-prefix " ")) |
| 269 | (fill-region s last)))) |
| 270 | (set-marker e nil) |
| 271 | (set-marker p nil) |
| 272 | (copyright-update nil t)) |
| 273 | (message "No copyright message"))) |
| 274 | |
| 275 | ;;;###autoload |
| 276 | (define-skeleton copyright |
| 277 | "Insert a copyright by $ORGANIZATION notice at cursor." |
| 278 | "Company: " |
| 279 | comment-start |
| 280 | "Copyright (C) " `(substring (current-time-string) -4) " by " |
| 281 | (or (getenv "ORGANIZATION") |
| 282 | str) |
| 283 | '(if (copyright-offset-too-large-p) |
| 284 | (message "Copyright extends beyond `copyright-limit' and won't be updated automatically.")) |
| 285 | comment-end \n) |
| 286 | |
| 287 | ;;;###autoload |
| 288 | (defun copyright-update-directory (directory match) |
| 289 | "Update copyright notice for all files in DIRECTORY matching MATCH." |
| 290 | (interactive "DDirectory: \nMFilenames matching (regexp): ") |
| 291 | (dolist (file (directory-files directory t match nil)) |
| 292 | (message "Updating file `%s'" file) |
| 293 | (find-file file) |
| 294 | (let ((copyright-query nil)) |
| 295 | (copyright-update)) |
| 296 | (save-buffer) |
| 297 | (kill-buffer (current-buffer)))) |
| 298 | |
| 299 | (provide 'copyright) |
| 300 | |
| 301 | ;; For the copyright sign: |
| 302 | ;; Local Variables: |
| 303 | ;; coding: utf-8 |
| 304 | ;; End: |
| 305 | |
| 306 | ;; arch-tag: b4991afb-b6b1-4590-bebe-e076d9d4aee8 |
| 307 | ;;; copyright.el ends here |