add-log.el 51.4 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1
;;; add-log.el --- change log maintenance commands for Emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
2

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2001,
4 5
;;   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
;;   Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
6

7
;; Maintainer: FSF
8
;; Keywords: tools
Eric S. Raymond's avatar
Eric S. Raymond committed
9

Eric S. Raymond's avatar
Eric S. Raymond committed
10 11
;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Eric S. Raymond's avatar
Eric S. Raymond committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Eric S. Raymond's avatar
Eric S. Raymond committed
16 17 18 19 20 21 22

;; 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
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
24

25 26 27 28
;;; Commentary:

;; This facility is documented in the Emacs Manual.

Stefan Monnier's avatar
Stefan Monnier committed
29 30 31 32 33 34 35 36 37
;; Todo:

;; - Find/use/create _MTN/log if there's a _MTN directory.
;; - Find/use/create ++log.* if there's an {arch} directory.
;; - Use an open *VC-Log* or *cvs-commit* buffer if it's related to the
;;   source file.
;; - Don't add TAB indents (and username?) if inserting entries in those
;;   special places.

Eric S. Raymond's avatar
Eric S. Raymond committed
38
;;; Code:
Eric S. Raymond's avatar
Eric S. Raymond committed
39

40
(eval-when-compile
Dave Love's avatar
Dave Love committed
41
  (require 'timezone))
42

43
(defgroup change-log nil
44
  "Change log maintenance."
45
  :group 'tools
46
  :link '(custom-manual "(emacs)Change Log")
47 48
  :prefix "change-log-"
  :prefix "add-log-")
Eric S. Raymond's avatar
Eric S. Raymond committed
49

50 51

(defcustom change-log-default-name nil
Stefan Monnier's avatar
Stefan Monnier committed
52
  "Name of a change log file for \\[add-change-log-entry]."
53 54 55
  :type '(choice (const :tag "default" nil)
		 string)
  :group 'change-log)
56
;;;###autoload
57
(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
58

Dave Love's avatar
Dave Love committed
59 60 61 62 63
(defcustom change-log-mode-hook nil
  "Normal hook run by `change-log-mode'."
  :type 'hook
  :group 'change-log)

64 65
;; Many modes set this variable, so avoid warnings.
;;;###autoload
66
(defcustom add-log-current-defun-function nil
67
  "If non-nil, function to guess name of surrounding function.
Dave Love's avatar
Dave Love committed
68 69
It is used by `add-log-current-defun' in preference to built-in rules.
Returns function's name as a string, or nil if outside a function."
Dave Love's avatar
Dave Love committed
70
  :type '(choice (const nil) function)
71
  :group 'change-log)
72

73
;;;###autoload
74
(defcustom add-log-full-name nil
75
  "Full name of user, for inclusion in ChangeLog daily headers.
Dave Love's avatar
Dave Love committed
76
This defaults to the value returned by the function `user-full-name'."
77 78 79
  :type '(choice (const :tag "Default" nil)
		 string)
  :group 'change-log)
80

81
;;;###autoload
82
(defcustom add-log-mailing-address nil
83
  "Email addresses of user, for inclusion in ChangeLog headers.
84 85 86 87
This defaults to the value of `user-mail-address'.  In addition to
being a simple string, this value can also be a list.  All elements
will be recognized as referring to the same user; when creating a new
ChangeLog entry, one element will be chosen at random."
88
  :type '(choice (const :tag "Default" nil)
89 90
		 (string :tag "String")
		 (repeat :tag "List of Strings" string))
91 92
  :group 'change-log)

93
(defcustom add-log-time-format 'add-log-iso8601-time-string
94
  "Function that defines the time format.
95 96 97 98 99 100 101 102 103
For example, `add-log-iso8601-time-string', which gives the
date in international ISO 8601 format,
and `current-time-string' are two valid values."
  :type '(radio (const :tag "International ISO 8601 format"
		       add-log-iso8601-time-string)
		(const :tag "Old format, as returned by `current-time-string'"
		       current-time-string)
		(function :tag "Other"))
  :group 'change-log)
104

105
(defcustom add-log-keep-changes-together nil
106
  "If non-nil, normally keep day's log entries for one file together.
107 108 109 110 111 112 113 114 115 116

Log entries for a given file made with \\[add-change-log-entry] or
\\[add-change-log-entry-other-window] will only be added to others \
for that file made
today if this variable is non-nil or that file comes first in today's
entries.  Otherwise another entry for that file will be started.  An
original log:

	* foo (...): ...
	* bar (...): change 1
117

118 119
in the latter case, \\[add-change-log-entry-other-window] in a \
buffer visiting `bar', yields:
120

121 122 123
	* bar (...): -!-
	* foo (...): ...
	* bar (...): change 1
124

125
and in the former:
126

127 128 129
	* foo (...): ...
	* bar (...): change 1
	(...): -!-
130

131 132 133
The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
this variable."
  :version "20.3"
134 135 136
  :type 'boolean
  :group 'change-log)

137
(defcustom add-log-always-start-new-record nil
138
  "If non-nil, `add-change-log-entry' will always start a new record."
139
  :version "22.1"
140 141 142
  :type 'boolean
  :group 'change-log)

143
(defcustom add-log-buffer-file-name-function nil
144
  "If non-nil, function to call to identify the full filename of a buffer.
145 146
This function is called with no argument.  If this is nil, the default is to
use `buffer-file-name'."
Dave Love's avatar
Dave Love committed
147
  :type '(choice (const nil) function)
148 149
  :group 'change-log)

150
(defcustom add-log-file-name-function nil
151
  "If non-nil, function to call to identify the filename for a ChangeLog entry.
Dave Love's avatar
Dave Love committed
152 153 154
This function is called with one argument, the value of variable
`buffer-file-name' in that buffer.  If this is nil, the default is to
use the file's name relative to the directory of the change log file."
Dave Love's avatar
Dave Love committed
155
  :type '(choice (const nil) function)
156 157
  :group 'change-log)

158 159

(defcustom change-log-version-info-enabled nil
160
  "If non-nil, enable recording version numbers with the changes."
161 162 163 164 165
  :version "21.1"
  :type 'boolean
  :group 'change-log)

(defcustom change-log-version-number-regexp-list
166
  (let ((re "\\([0-9]+\.[0-9.]+\\)"))
167 168 169 170
    (list
     ;;  (defconst ad-version "2.15"
     (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
     ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp
Dave Love's avatar
Dave Love committed
171
     (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re)))
172
  "List of regexps to search for version number.
Dave Love's avatar
Dave Love committed
173
The version number must be in group 1.
174 175 176 177 178
Note: The search is conducted only within 10%, at the beginning of the file."
  :version "21.1"
  :type '(repeat regexp)
  :group 'change-log)

179
(defface change-log-date
180 181 182 183
  '((t (:inherit font-lock-string-face)))
  "Face used to highlight dates in date lines."
  :version "21.1"
  :group 'change-log)
184
(define-obsolete-face-alias 'change-log-date-face 'change-log-date "22.1")
185

186
(defface change-log-name
187 188 189 190
  '((t (:inherit font-lock-constant-face)))
  "Face for highlighting author names."
  :version "21.1"
  :group 'change-log)
191
(define-obsolete-face-alias 'change-log-name-face 'change-log-name "22.1")
192

193
(defface change-log-email
194 195 196 197
  '((t (:inherit font-lock-variable-name-face)))
  "Face for highlighting author email addresses."
  :version "21.1"
  :group 'change-log)
198
(define-obsolete-face-alias 'change-log-email-face 'change-log-email "22.1")
199

200
(defface change-log-file
201 202 203 204
  '((t (:inherit font-lock-function-name-face)))
  "Face for highlighting file names."
  :version "21.1"
  :group 'change-log)
205
(define-obsolete-face-alias 'change-log-file-face 'change-log-file "22.1")
206

207
(defface change-log-list
208 209 210 211
  '((t (:inherit font-lock-keyword-face)))
  "Face for highlighting parenthesized lists of functions or variables."
  :version "21.1"
  :group 'change-log)
212
(define-obsolete-face-alias 'change-log-list-face 'change-log-list "22.1")
213

214
(defface change-log-conditionals
215 216 217 218
  '((t (:inherit font-lock-variable-name-face)))
  "Face for highlighting conditionals of the form `[...]'."
  :version "21.1"
  :group 'change-log)
219 220
(define-obsolete-face-alias 'change-log-conditionals-face
  'change-log-conditionals "22.1")
221

222
(defface change-log-function
223 224 225 226
  '((t (:inherit font-lock-variable-name-face)))
  "Face for highlighting items of the form `<....>'."
  :version "21.1"
  :group 'change-log)
227 228
(define-obsolete-face-alias 'change-log-function-face
  'change-log-function "22.1")
229

230
(defface change-log-acknowledgement
231 232 233 234
  '((t (:inherit font-lock-comment-face)))
  "Face for highlighting acknowledgments."
  :version "21.1"
  :group 'change-log)
235 236
(define-obsolete-face-alias 'change-log-acknowledgement-face
  'change-log-acknowledgement "22.1")
237

238
(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
239
(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
240

241
(defvar change-log-font-lock-keywords
242
  `(;;
243 244 245 246 247 248 249
    ;; Date lines, new (2000-01-01) and old (Sat Jan  1 00:00:00 2000) styles.
    ;; Fixme: this regepx is just an approximate one and may match
    ;; wrongly with a non-date line existing as a random note.  In
    ;; addition, using any kind of fixed setting like this doesn't
    ;; work if a user customizes add-log-time-format.
    ("^[0-9-]+ +\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-z][a-z][a-z] [0-9:+ ]+"
     (0 'change-log-date-face)
250
     ;; Name and e-mail; some people put e-mail in parens, not angles.
Juri Linkov's avatar
Juri Linkov committed
251
     ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
252 253
      (1 'change-log-name)
      (2 'change-log-email)))
254 255
    ;;
    ;; File names.
256
    (,change-log-file-names-re
257
     (2 'change-log-file)
258
     ;; Possibly further names in a list:
259
     ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file))
260
     ;; Possibly a parenthesized list of names:
261
     ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
262
      nil nil (1 'change-log-list))
263
     ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
264
      nil nil (1 'change-log-list)))
265 266
    ;;
    ;; Function or variable names.
267
    ("^\\( +\\|\t\\)(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
268
     (2 'change-log-list)
269
     ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil
270
      (1 'change-log-list)))
271 272
    ;;
    ;; Conditionals.
273
    ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals))
274
    ;;
275
    ;; Function of change.
276
    ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function))
277
    ;;
Richard M. Stallman's avatar
Richard M. Stallman committed
278
    ;; Acknowledgements.
279 280
    ;; Don't include plain "From" because that is vague;
    ;; we want to encourage people to say something more specific.
Richard M. Stallman's avatar
Richard M. Stallman committed
281 282 283
    ;; Note that the FSF does not use "Patches by"; our convention
    ;; is to put the name of the author of the changes at the top
    ;; of the change log entry.
284
    ("\\(^\\( +\\|\t\\)\\|  \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
285
     3 'change-log-acknowledgement))
286 287
  "Additional expressions to highlight in Change Log mode.")

288 289 290 291 292
(defun change-log-search-file-name (where)
  "Return the file-name for the change under point."
  (save-excursion
    (goto-char where)
    (beginning-of-line 1)
293 294 295 296 297
    (if (looking-at change-log-start-entry-re)
	;; We are at the start of an entry, search forward for a file
	;; name.
	(progn
	  (re-search-forward change-log-file-names-re nil t)
298
	  (match-string-no-properties 2))
299 300
      (if (looking-at change-log-file-names-re)
	  ;; We found a file name.
301
	  (match-string-no-properties 2)
302 303
	;; Look backwards for either a file name or the log entry start.
	(if (re-search-backward
304
	     (concat "\\(" change-log-start-entry-re
305 306 307 308 309 310 311
		     "\\)\\|\\("
		     change-log-file-names-re "\\)") nil t)
	    (if (match-beginning 1)
		;; We got the start of the entry, look forward for a
		;; file name.
		(progn
		  (re-search-forward change-log-file-names-re nil t)
312 313
		  (match-string-no-properties 2))
	      (match-string-no-properties 4))
314 315
	  ;; We must be before any file name, look forward.
	  (re-search-forward change-log-file-names-re nil t)
316
	  (match-string-no-properties 2))))))
317 318 319 320 321 322 323

(defun change-log-find-file ()
  "Visit the file for the change under point."
  (interactive)
  (let ((file (change-log-search-file-name (point))))
    (if (and file (file-exists-p file))
	(find-file file)
324
      (message "No such file or directory: %s" file))))
325

326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349
(defun change-log-search-tag-name-1 (&optional from)
  "Search for a tag name within subexpression 1 of last match.
Optional argument FROM specifies a buffer position where the tag
name should be located.  Return value is a cons whose car is the
string representing the tag and whose cdr is the position where
the tag was found."
  (save-restriction
    (narrow-to-region (match-beginning 1) (match-end 1))
    (when from (goto-char from))
    ;; The regexp below skips any symbol near `point' (FROM) followed by
    ;; whitespace and another symbol.  This should skip, for example,
    ;; "struct" in a specification like "(struct buffer)" and move to
    ;; "buffer".  A leading paren is ignored.
    (when (looking-at
	   "[(]?\\(?:\\(?:\\sw\\|\\s_\\)+\\(?:[ \t]+\\(\\sw\\|\\s_\\)+\\)\\)")
      (goto-char (match-beginning 1)))
    (cons (find-tag-default) (point))))

(defconst change-log-tag-re
  "(\\(\\(?:\\sw\\|\\s_\\)+\\(?:[, \t]+\\(?:\\sw\\|\\s_\\)+\\)*\\))"
  "Regexp matching a tag name in change log entries.")

(defun change-log-search-tag-name (&optional at)
  "Search for a tag name near `point'.
350 351
Optional argument AT non-nil means search near buffer position AT.
Return value is a cons whose car is the string representing
352 353 354 355 356 357 358 359 360 361 362 363 364
the tag and whose cdr is the position where the tag was found."
  (save-excursion
    (goto-char (setq at (or at (point))))
    (save-restriction
      (widen)
      (or (condition-case nil
	      ;; Within parenthesized list?
	      (save-excursion
		(backward-up-list)
		(when (looking-at change-log-tag-re)
		  (change-log-search-tag-name-1 at)))
	    (error nil))
	  (condition-case nil
Martin Rudalics's avatar
Martin Rudalics committed
365
	      ;; Before parenthesized list on same line?
366 367 368 369 370 371
	      (save-excursion
		(when (and (skip-chars-forward " \t")
			   (looking-at change-log-tag-re))
		  (change-log-search-tag-name-1)))
	    (error nil))
	  (condition-case nil
Martin Rudalics's avatar
Martin Rudalics committed
372
	      ;; Near file name?
373 374 375 376 377 378 379 380 381 382
	      (save-excursion
		(when (and (progn
			     (beginning-of-line)
			     (looking-at change-log-file-names-re))
			   (goto-char (match-end 0))
			   (skip-syntax-forward " ")
			   (looking-at change-log-tag-re))
		  (change-log-search-tag-name-1)))
	    (error nil))
	  (condition-case nil
Martin Rudalics's avatar
Martin Rudalics committed
383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408
	      ;; Anywhere else within current entry?
	      (let ((from
		     (save-excursion
		       (end-of-line)
		       (if (re-search-backward change-log-start-entry-re nil t)
			   (match-beginning 0)
			 (point-min))))
		    (to
		     (save-excursion
		       (end-of-line)
		       (if (re-search-forward change-log-start-entry-re nil t)
			   (match-beginning 0)
			 (point-max)))))
		(when (and (< from to) (<= from at) (<= at to))
		  (save-restriction
		    ;; Narrow to current change log entry.
		    (narrow-to-region from to)
		    (cond
		     ((re-search-backward change-log-tag-re nil t)
		      (narrow-to-region (match-beginning 1) (match-end 1))
		      (goto-char (point-max))
		      (cons (find-tag-default) (point-max)))
		     ((re-search-forward change-log-tag-re nil t)
		      (narrow-to-region (match-beginning 1) (match-end 1))
		      (goto-char (point-min))
		      (cons (find-tag-default) (point-min)))))))
409 410 411 412
	    (error nil))))))

(defvar change-log-find-head nil)
(defvar change-log-find-tail nil)
413
(defvar change-log-find-window nil)
414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455

(defun change-log-goto-source-1 (tag regexp file buffer
				     &optional window first last)
  "Search for tag TAG in buffer BUFFER visiting file FILE.
REGEXP is a regular expression for TAG.  The remaining arguments
are optional: WINDOW denotes the window to display the results of
the search.  FIRST is a position in BUFFER denoting the first
match from previous searches for TAG.  LAST is the position in
BUFFER denoting the last match for TAG in the last search."
  (with-current-buffer buffer
    (save-excursion
      (save-restriction
	(widen)
	(if last
	    (progn
	      ;; When LAST is set make sure we continue from the next
	      ;; line end to not find the same tag again.
	      (goto-char last)
	      (end-of-line)
	      (condition-case nil
		  ;; Try to go to the end of the current defun to avoid
		  ;; false positives within the current defun's body
		  ;; since these would match `add-log-current-defun'.
		  (end-of-defun)
		;; Don't fall behind when `end-of-defun' fails.
		(error (progn (goto-char last) (end-of-line))))
	      (setq last nil))
	  ;; When LAST was not set start at beginning of BUFFER.
	  (goto-char (point-min)))
	(let (current-defun)
	  (while (and (not last) (re-search-forward regexp nil t))
	      ;; Verify that `add-log-current-defun' invoked at the end
	      ;; of the match returns TAG.  This heuristic works well
	      ;; whenever the name of the defun occurs within the first
	      ;; line of the defun.
	      (setq current-defun (add-log-current-defun))
	      (when (and current-defun (string-equal current-defun tag))
		;; Record this as last match.
		(setq last (line-beginning-position))
		;; Record this as first match when there's none.
		(unless first (setq first last)))))))
    (if (or last first)
456 457
	(with-selected-window
	    (setq change-log-find-window (or window (display-buffer buffer)))
458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
	  (if last
	      (progn
		(when (or (< last (point-min)) (> last (point-max)))
		  ;; Widen to show TAG.
		  (widen))
		(push-mark)
		(goto-char last))
	    ;; When there are no more matches go (back) to FIRST.
	    (message "No more matches for tag `%s' in file `%s'" tag file)
	    (setq last first)
	    (goto-char first))
	  ;; Return new "tail".
	  (list (selected-window) first last))
      (message "Source location of tag `%s' not found in file `%s'" tag file)
      nil)))

(defun change-log-goto-source ()
Martin Rudalics's avatar
Martin Rudalics committed
475
  "Go to source location of \"change log tag\" near `point'.
476
A change log tag is a symbol within a parenthesized,
Martin Rudalics's avatar
Martin Rudalics committed
477 478
comma-separated list.  If no suitable tag can be found nearby,
try to visit the file for the change under `point' instead."
479 480 481 482 483 484 485 486 487 488 489 490
  (interactive)
  (if (and (eq last-command 'change-log-goto-source)
	   change-log-find-tail)
      (setq change-log-find-tail
	    (condition-case nil
		(apply 'change-log-goto-source-1
		       (append change-log-find-head change-log-find-tail))
	      (error
	       (format "Cannot find more matches for tag `%s' in file `%s'"
		       (car change-log-find-head)
		       (nth 2 change-log-find-head)))))
    (save-excursion
Martin Rudalics's avatar
Martin Rudalics committed
491 492
      (let* ((at (point))
	     (tag-at (change-log-search-tag-name))
493
	     (tag (car tag-at))
Martin Rudalics's avatar
Martin Rudalics committed
494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511
	     (file (when tag-at (change-log-search-file-name (cdr tag-at))))
	     (file-at (when file (match-beginning 2)))
	     ;; `file-2' is the file `change-log-search-file-name' finds
	     ;; at `point'.  We use `file-2' as a fallback when `tag' or
	     ;; `file' are not suitable for some reason.
	     (file-2 (change-log-search-file-name at))
	     (file-2-at (when file-2 (match-beginning 2))))
	(cond
	 ((and (or (not tag) (not file) (not (file-exists-p file)))
	       (or (not file-2) (not (file-exists-p file-2))))
	  (error "Cannot find tag or file near `point'"))
	 ((and file-2 (file-exists-p file-2)
	       (or (not tag) (not file) (not (file-exists-p file))
		   (and (or (and (< file-at file-2-at) (<= file-2-at at))
			    (and (<= at file-2-at) (< file-2-at file-at))))))
	  ;; We either have not found a suitable file name or `file-2'
	  ;; provides a "better" file name wrt `point'.  Go to the
	  ;; buffer of `file-2' instead.
512 513
	  (setq change-log-find-window
		(display-buffer (find-file-noselect file-2))))
Martin Rudalics's avatar
Martin Rudalics committed
514
	 (t
515 516 517 518 519 520
	  (setq change-log-find-head
		(list tag (concat "\\_<" (regexp-quote tag) "\\_>")
		      file (find-file-noselect file)))
	  (condition-case nil
	      (setq change-log-find-tail
		    (apply 'change-log-goto-source-1 change-log-find-head))
Martin Rudalics's avatar
Martin Rudalics committed
521 522 523
	    (error
	     (format "Cannot find matches for tag `%s' in file `%s'"
		     tag file)))))))))
524

525
(defun change-log-next-error (&optional argp reset)
526
  "Move to the Nth (default 1) next match in a ChangeLog buffer.
527 528 529 530 531 532 533
Compatibility function for \\[next-error] invocations."
  (interactive "p")
  (let* ((argp (or argp 0))
	 (count (abs argp))		; how many cycles
	 (down (< argp 0))		; are we going down? (is argp negative?)
	 (up (not down))
	 (search-function (if up 're-search-forward 're-search-backward)))
Martin Rudalics's avatar
Martin Rudalics committed
534

535 536 537 538 539
    ;; set the starting position
    (goto-char (cond (reset (point-min))
		     (down (line-beginning-position))
		     (up (line-end-position))
		     ((point))))
Martin Rudalics's avatar
Martin Rudalics committed
540

541
    (funcall search-function change-log-file-names-re nil t count))
Martin Rudalics's avatar
Martin Rudalics committed
542

543 544 545
  (beginning-of-line)
  ;; if we found a place to visit...
  (when (looking-at change-log-file-names-re)
546 547 548 549 550
    (let (change-log-find-window)
      (change-log-goto-source)
      (when change-log-find-window
	;; Select window displaying source file.
	(select-window change-log-find-window)))))
551

552
(defvar change-log-mode-map
553 554
  (let ((map (make-sparse-keymap))
	(menu-map (make-sparse-keymap)))
555 556
    (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
    (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
557
    (define-key map [?\C-c ?\C-f] 'change-log-find-file)
558
    (define-key map [?\C-c ?\C-c] 'change-log-goto-source)
559 560 561 562 563 564 565 566 567 568 569 570 571 572
    (define-key map [menu-bar changelog] (cons "ChangeLog" menu-map))
    (define-key menu-map [gs]
      '(menu-item "Go To Source" change-log-goto-source
		  :help "Go to source location of ChangeLog tag near point"))
    (define-key menu-map [ff]
      '(menu-item "Find File" change-log-find-file
		  :help "Visit the file for the change under point"))
    (define-key menu-map [sep] '("--"))
    (define-key menu-map [nx]
      '(menu-item "Next Log-Edit Comment" add-log-edit-next-comment
		  :help "Cycle forward through Log-Edit mode comment history"))
    (define-key menu-map [pr]
      '(menu-item "Previous Log-Edit Comment" add-log-edit-prev-comment
		  :help "Cycle backward through Log-Edit mode comment history"))
573
    map)
Karl Heuer's avatar
Karl Heuer committed
574 575
  "Keymap for Change Log major mode.")

576 577 578 579
;; It used to be called change-log-time-zone-rule but really should be
;; called add-log-time-zone-rule since it's only used from add-log-* code.
(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule)
(defvar add-log-time-zone-rule nil
580 581
  "Time zone used for calculating change log time stamps.
It takes the same format as the TZ argument of `set-time-zone-rule'.
582 583
If nil, use local time.
If t, use universal time.")
584 585
(put 'add-log-time-zone-rule 'safe-local-variable
     '(lambda (x) (or (booleanp x) (stringp x))))
586

587
(defun add-log-iso8601-time-zone (&optional time)
588 589 590 591 592 593 594 595 596 597 598 599
  (let* ((utc-offset (or (car (current-time-zone time)) 0))
	 (sign (if (< utc-offset 0) ?- ?+))
	 (sec (abs utc-offset))
	 (ss (% sec 60))
	 (min (/ sec 60))
	 (mm (% min 60))
	 (hh (/ min 60)))
    (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
		  ((not (zerop mm)) "%c%02d:%02d")
		  (t "%c%02d"))
	    sign hh mm ss)))

600 601
(defvar add-log-iso8601-with-time-zone nil)

602
(defun add-log-iso8601-time-string ()
603 604
  (let ((time (format-time-string "%Y-%m-%d"
                                  nil (eq t add-log-time-zone-rule))))
605 606 607
    (if add-log-iso8601-with-time-zone
        (concat time " " (add-log-iso8601-time-zone))
      time)))
608

Eric S. Raymond's avatar
Eric S. Raymond committed
609
(defun change-log-name ()
Dave Love's avatar
Dave Love committed
610
  "Return (system-dependent) default name for a change log file."
Eric S. Raymond's avatar
Eric S. Raymond committed
611
  (or change-log-default-name
Dan Nicolaescu's avatar
Dan Nicolaescu committed
612
      "ChangeLog"))
Eric S. Raymond's avatar
Eric S. Raymond committed
613

614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638
(defun add-log-edit-prev-comment (arg)
  "Cycle backward through Log-Edit mode comment history.
With a numeric prefix ARG, go back ARG comments."
  (interactive "*p")
  (save-restriction
    (narrow-to-region (point)
		      (if (memq last-command '(add-log-edit-prev-comment
					       add-log-edit-next-comment))
			  (mark) (point)))
    (when (fboundp 'log-edit-previous-comment)
      (log-edit-previous-comment arg)
      (indent-region (point-min) (point-max))
      (goto-char (point-min))
      (unless (save-restriction (widen) (bolp))
	(delete-region (point) (progn (skip-chars-forward " \t\n") (point))))
      (set-mark (point-min))
      (goto-char (point-max))
      (delete-region (point) (progn (skip-chars-backward " \t\n") (point))))))

(defun add-log-edit-next-comment (arg)
  "Cycle forward through Log-Edit mode comment history.
With a numeric prefix ARG, go back ARG comments."
  (interactive "*p")
  (add-log-edit-prev-comment (- arg)))

639
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
640 641
(defun prompt-for-change-log-name ()
  "Prompt for a change log name."
642 643 644 645 646 647 648 649 650 651 652 653 654 655
  (let* ((default (change-log-name))
	 (name (expand-file-name
		(read-file-name (format "Log file (default %s): " default)
				nil default))))
    ;; Handle something that is syntactically a directory name.
    ;; Look for ChangeLog or whatever in that directory.
    (if (string= (file-name-nondirectory name) "")
	(expand-file-name (file-name-nondirectory default)
			  name)
      ;; Handle specifying a file that is a directory.
      (if (file-directory-p name)
	  (expand-file-name (file-name-nondirectory default)
			    (file-name-as-directory name))
	name))))
Eric S. Raymond's avatar
Eric S. Raymond committed
656

657
(defun change-log-version-number-search ()
Dave Love's avatar
Dave Love committed
658
  "Return version number of current buffer's file.
Eric S. Raymond's avatar
Eric S. Raymond committed
659
This is the value returned by `vc-working-revision' or, if that is
Dave Love's avatar
Dave Love committed
660
nil, by matching `change-log-version-number-regexp-list'."
661
  (let* ((size (buffer-size))
662
	 (limit
Dave Love's avatar
Dave Love committed
663 664 665
	  ;; The version number can be anywhere in the file, but
	  ;; restrict search to the file beginning: 10% should be
	  ;; enough to prevent some mishits.
666
	  ;;
Dave Love's avatar
Dave Love committed
667 668
	  ;; Apply percentage only if buffer size is bigger than
	  ;; approx 100 lines.
669
	  (if (> size (* 100 80)) (+ (point) (/ size 10)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
670
    (or (and buffer-file-name (vc-working-revision buffer-file-name))
Dave Love's avatar
Dave Love committed
671 672
	(save-restriction
	  (widen)
673 674
	  (let ((regexps change-log-version-number-regexp-list)
		version)
Dave Love's avatar
Dave Love committed
675 676 677
	    (while regexps
	      (save-excursion
		(goto-char (point-min))
678
		(when (re-search-forward (pop regexps) limit t)
Dave Love's avatar
Dave Love committed
679
		  (setq version (match-string 1)
680 681
			regexps nil))))
	    version)))))
682

683
(declare-function diff-find-source-location "diff-mode"
684
		  (&optional other-file reverse noprompt))
685

686
;;;###autoload
687
(defun find-change-log (&optional file-name buffer-file)
688
  "Find a change log file for \\[add-change-log-entry] and return the name.
689 690

Optional arg FILE-NAME specifies the file to use.
691
If FILE-NAME is nil, use the value of `change-log-default-name'.
692
If `change-log-default-name' is nil, behave as though it were 'ChangeLog'
693 694
\(or whatever we use on this operating system).

695
If `change-log-default-name' contains a leading directory component, then
696
simply find it in the current directory.  Otherwise, search in the current
697
directory and its successive parents for a file so named.
698 699

Once a file is found, `change-log-default-name' is set locally in the
700 701
current buffer to the complete file name.
Optional arg BUFFER-FILE overrides `buffer-file-name'."
702 703
  ;; If we are called from a diff, first switch to the source buffer;
  ;; in order to respect buffer-local settings of change-log-default-name, etc.
Glenn Morris's avatar
Glenn Morris committed
704 705 706 707 708
  (with-current-buffer (let ((buff (if (eq major-mode 'diff-mode)
				       (car (ignore-errors
					     (diff-find-source-location))))))
			 (if (buffer-live-p buff) buff
			   (current-buffer)))
709 710
      ;; If user specified a file name or if this buffer knows which one to use,
      ;; just use that.
Glenn Morris's avatar
Glenn Morris committed
711 712 713 714 715 716 717 718
    (or file-name
	(setq file-name (and change-log-default-name
			     (file-name-directory change-log-default-name)
			     change-log-default-name))
	(progn
	  ;; Chase links in the source file
	  ;; and use the change log in the dir where it points.
	  (setq file-name (or (and (or buffer-file buffer-file-name)
719
				   (file-name-directory
Glenn Morris's avatar
Glenn Morris committed
720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749
				    (file-chase-links
				     (or buffer-file buffer-file-name))))
			      default-directory))
	  (if (file-directory-p file-name)
	      (setq file-name (expand-file-name (change-log-name) file-name)))
	  ;; Chase links before visiting the file.
	  ;; This makes it easier to use a single change log file
	  ;; for several related directories.
	  (setq file-name (file-chase-links file-name))
	  (setq file-name (expand-file-name file-name))
	  ;; Move up in the dir hierarchy till we find a change log file.
	  (let ((file1 file-name)
		parent-dir)
	    (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
			(progn (setq parent-dir
				     (file-name-directory
				      (directory-file-name
				       (file-name-directory file1))))
			       ;; Give up if we are already at the root dir.
			       (not (string= (file-name-directory file1)
					     parent-dir))))
	      ;; Move up to the parent dir and try again.
	      (setq file1 (expand-file-name
			   (file-name-nondirectory (change-log-name))
			   parent-dir)))
	    ;; If we found a change log in a parent, use that.
	    (if (or (get-file-buffer file1) (file-exists-p file1))
		(setq file-name file1)))))
    ;; Make a local variable in this buffer so we needn't search again.
    (set (make-local-variable 'change-log-default-name) file-name))
750
  file-name)
751

752 753 754
(defun add-log-file-name (buffer-file log-file)
  ;; Never want to add a change log entry for the ChangeLog file itself.
  (unless (or (null buffer-file) (string= buffer-file log-file))
755 756 757
    (if add-log-file-name-function
	(funcall add-log-file-name-function buffer-file)
      (setq buffer-file
758
            (file-relative-name buffer-file (file-name-directory log-file)))
759 760 761 762 763 764
      ;; If we have a backup file, it's presumably because we're
      ;; comparing old and new versions (e.g. for deleted
      ;; functions) and we'll want to use the original name.
      (if (backup-file-name-p buffer-file)
	  (file-name-sans-versions buffer-file)
	buffer-file))))
765

Eric S. Raymond's avatar
Eric S. Raymond committed
766
;;;###autoload
767 768
(defun add-change-log-entry (&optional whoami file-name other-window new-entry
				       put-new-entry-on-new-line)
769
  "Find change log file, and add an entry for today and an item for this file.
770
Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
771
name and email (stored in `add-log-full-name' and `add-log-mailing-address').
772

773 774 775
Second arg FILE-NAME is file name of the change log.
If nil, use the value of `change-log-default-name'.

776
Third arg OTHER-WINDOW non-nil means visit in other window.
777

778
Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
779 780 781
never append to an existing entry.  Option `add-log-keep-changes-together'
otherwise affects whether a new entry is created.

782 783 784 785
Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new
entry is created, put it on a new line by itself, do not put it
after a comma on an existing line.

786 787 788 789
Option `add-log-always-start-new-record' non-nil means always create a
new record, even when the last record was made on the same date and by
the same person.

790 791 792 793
The change log file can start with a copyright notice and a copying
permission notice.  The first blank line indicates the end of these
notices.

794
Today's date is calculated according to `add-log-time-zone-rule' if
795
non-nil, otherwise in local time."
Eric S. Raymond's avatar
Eric S. Raymond committed
796 797
  (interactive (list current-prefix-arg
		     (prompt-for-change-log-name)))
798 799 800
  (let* ((defun (add-log-current-defun))
	 (version (and change-log-version-info-enabled
		       (change-log-version-number-search)))
801 802 803 804
	 (buf-file-name (if add-log-buffer-file-name-function
			    (funcall add-log-buffer-file-name-function)
			  buffer-file-name))
	 (buffer-file (if buf-file-name (expand-file-name buf-file-name)))
805
	 (file-name (expand-file-name (find-change-log file-name buffer-file)))
806
	 ;; Set ITEM to the file name to use in the new item.
807
	 (item (add-log-file-name buffer-file file-name)))
808

809 810 811 812
    (unless (equal file-name buffer-file-name)
      (if (or other-window (window-dedicated-p (selected-window)))
	  (find-file-other-window file-name)
	(find-file file-name)))
813
    (or (derived-mode-p 'change-log-mode)
814
	(change-log-mode))
Eric S. Raymond's avatar
Eric S. Raymond committed
815 816
    (undo-boundary)
    (goto-char (point-min))
817

818 819 820 821
    (let ((full-name (or add-log-full-name (user-full-name)))
          (mailing-address (or add-log-mailing-address user-mail-address)))

      (when whoami
Miles Bader's avatar
Miles Bader committed
822
        (setq full-name (read-string "Full name: " full-name))
823 824 825 826 827
        ;; Note that some sites have room and phone number fields in
        ;; full name which look silly when inserted.  Rather than do
        ;; anything about that here, let user give prefix argument so that
        ;; s/he can edit the full name field in prompter if s/he wants.
        (setq mailing-address
Miles Bader's avatar
Miles Bader committed
828
	      (read-string "Mailing address: " mailing-address)))
829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863

      ;; If file starts with a copyright and permission notice, skip them.
      ;; Assume they end at first blank line.
      (when (looking-at "Copyright")
        (search-forward "\n\n")
        (skip-chars-forward "\n"))

      ;; Advance into first entry if it is usable; else make new one.
      (let ((new-entries
             (mapcar (lambda (addr)
                       (concat
                        (if (stringp add-log-time-zone-rule)
                            (let ((tz (getenv "TZ")))
                              (unwind-protect
                                  (progn
                                    (set-time-zone-rule add-log-time-zone-rule)
                                    (funcall add-log-time-format))
                                (set-time-zone-rule tz)))
                          (funcall add-log-time-format))
                        "  " full-name
                        "  <" addr ">"))
                     (if (consp mailing-address)
                         mailing-address
                       (list mailing-address)))))
        (if (and (not add-log-always-start-new-record)
                 (let ((hit nil))
                   (dolist (entry new-entries hit)
                     (when (looking-at (regexp-quote entry))
                       (setq hit t)))))
            (forward-line 1)
          (insert (nth (random (length new-entries))
                       new-entries)
                  (if use-hard-newlines hard-newline "\n")
                  (if use-hard-newlines hard-newline "\n"))
          (forward-line -1))))
864

865 866
    ;; Determine where we should stop searching for a usable
    ;; item to add to, within this entry.
867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911
    (let ((bound
           (save-excursion
             (if (looking-at "\n*[^\n* \t]")
                 (skip-chars-forward "\n")
               (if add-log-keep-changes-together
                   (forward-page)      ; page delimits entries for date
                 (forward-paragraph))) ; paragraph delimits entries for file
             (point))))

      ;; Now insert the new line for this item.
      (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
             ;; Put this file name into the existing empty item.
             (if item
                 (insert item)))
            ((and (not new-entry)
                  (let (case-fold-search)
                    (re-search-forward
                     (concat (regexp-quote (concat "* " item))
                             ;; Don't accept `foo.bar' when
                             ;; looking for `foo':
                             "\\(\\s \\|[(),:]\\)")
                     bound t)))
             ;; Add to the existing item for the same file.
             (re-search-forward "^\\s *$\\|^\\s \\*")
             (goto-char (match-beginning 0))
             ;; Delete excess empty lines; make just 2.
             (while (and (not (eobp)) (looking-at "^\\s *$"))
               (delete-region (point) (line-beginning-position 2)))
             (insert (if use-hard-newlines hard-newline "\n")
                     (if use-hard-newlines hard-newline "\n"))
             (forward-line -2)
             (indent-relative-maybe))
            (t
             ;; Make a new item.
             (while (looking-at "\\sW")
               (forward-line 1))
             (while (and (not (eobp)) (looking-at "^\\s *$"))
               (delete-region (point) (line-beginning-position 2)))
             (insert (if use-hard-newlines hard-newline "\n")
                     (if use-hard-newlines hard-newline "\n")
                     (if use-hard-newlines hard-newline "\n"))
             (forward-line -2)
             (indent-to left-margin)
             (insert "* ")
             (if item (insert item)))))
912
    ;; Now insert the function name, if we have one.
913
    ;; Point is at the item for this file,
Eric S. Raymond's avatar
Eric S. Raymond committed
914
    ;; either at the end of the line or at the first blank line.
915 916 917 918 919 920
    (if (not defun)
	;; No function name, so put in a colon unless we have just a star.
	(unless (save-excursion
		  (beginning-of-line 1)
		  (looking-at "\\s *\\(\\*\\s *\\)?$"))
	  (insert ": ")
921
	  (if version (insert version ?\s)))
922 923
      ;; Make it easy to get rid of the function name.
      (undo-boundary)
Dave Love's avatar
Dave Love committed
924 925
      (unless (save-excursion
		(beginning-of-line 1)
926
		(looking-at "\\s *$"))
927
	(insert ?\s))
928 929 930 931 932
      ;; See if the prev function name has a message yet or not.
      ;; If not, merge the two items.
      (let ((pos (point-marker)))
	(skip-syntax-backward " ")
	(skip-chars-backward "):")
933 934
	(if (and (not put-new-entry-on-new-line)
		 (looking-at "):")
935 936 937 938 939 940 941
		 (let ((pos (save-excursion (backward-sexp 1) (point))))
		   (when (equal (buffer-substring pos (point)) defun)
		     (delete-region pos (point)))
		   (> fill-column (+ (current-column) (length defun) 4))))
	    (progn (skip-chars-backward ", ")
		   (delete-region (point) pos)
		   (unless (memq (char-before) '(?\()) (insert ", ")))
942 943
	  (when (and (not put-new-entry-on-new-line) (looking-at "):"))
	    (delete-region (+ 1 (point)) (line-end-position)))
944 945 946 947
	  (goto-char pos)
	  (insert "("))
	(set-marker pos nil))
      (insert defun "): ")
948
      (if version (insert version ?\s)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
949 950 951

;;;###autoload
(defun add-change-log-entry-other-window (&optional whoami file-name)
952 953 954
  "Find change log file in other window and add entry and item.
This is just like `add-change-log-entry' except that it displays
the change log file in another window."
Eric S. Raymond's avatar
Eric S. Raymond committed
955 956 957 958 959
  (interactive (if current-prefix-arg
		   (list current-prefix-arg
			 (prompt-for-change-log-name))))
  (add-change-log-entry whoami file-name t))

960

961
(defvar change-log-indent-text 0)
962

963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996
(defun change-log-fill-parenthesized-list ()
  ;; Fill parenthesized lists of names according to GNU standards.
  ;; * file-name.ext (very-long-foo, very-long-bar, very-long-foobar):
  ;; should be filled as
  ;; * file-name.ext (very-long-foo, very-long-bar)
  ;; (very-long-foobar):
  (save-excursion
    (end-of-line 0)
    (skip-chars-backward " \t")
    (when (and (equal (char-before) ?\,)
	       (> (point) (1+ (point-min))))
      (condition-case nil
	  (when (save-excursion
		  (and (prog2
			   (up-list -1)
			   (equal (char-after) ?\()
			 (skip-chars-backward " \t"))
		       (or (bolp)
			   ;; Skip everything but a whitespace or asterisk.
			   (and (not (zerop (skip-chars-backward "^ \t\n*")))
				(skip-chars-backward " \t")
				;; We want one asterisk here.
				(= (skip-chars-backward "*") -1)
				(skip-chars-backward " \t")
				(bolp)))))
	    ;; Delete the comma.
	    (delete-char -1)
	    ;; Close list on previous line.
	    (insert ")")
	    (skip-chars-forward " \t\n")
	    ;; Start list on new line.
	    (insert-before-markers "("))
	(error nil)))))

997
(defun change-log-indent ()
998
  (change-log-fill-parenthesized-list)