* configure.in: Correctly handle
[bpt/emacs.git] / lisp / add-log.el
CommitLineData
5abdc915 1;;; add-log.el --- change log maintenance commands for Emacs
84fc2cfa 2
e91081eb 3;; Copyright (C) 1985, 1986, 1988, 1993, 1994, 1997, 1998, 2000, 2001,
409cc4a3 4;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
84fc2cfa 5
6228c05b 6;; Maintainer: FSF
df63ae66 7;; Keywords: tools
e9571d2a 8
84fc2cfa
ER
9;; This file is part of GNU Emacs.
10
eb3fa2cf 11;; GNU Emacs is free software: you can redistribute it and/or modify
84fc2cfa 12;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
84fc2cfa
ER
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
eb3fa2cf 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
84fc2cfa 23
e41b2db1
ER
24;;; Commentary:
25
26;; This facility is documented in the Emacs Manual.
27
b0a96f7b
SM
28;; Todo:
29
30;; - Find/use/create _MTN/log if there's a _MTN directory.
31;; - Find/use/create ++log.* if there's an {arch} directory.
32;; - Use an open *VC-Log* or *cvs-commit* buffer if it's related to the
33;; source file.
34;; - Don't add TAB indents (and username?) if inserting entries in those
35;; special places.
36
fd7fa35a 37;;; Code:
84fc2cfa 38
776d8e16 39(eval-when-compile
5960adc7 40 (require 'timezone))
3697b807 41
fcad5199 42(defgroup change-log nil
7b297602 43 "Change log maintenance."
fcad5199 44 :group 'tools
3697b807 45 :link '(custom-manual "(emacs)Change Log")
fcad5199
RS
46 :prefix "change-log-"
47 :prefix "add-log-")
84fc2cfa 48
fcad5199
RS
49
50(defcustom change-log-default-name nil
b0a96f7b 51 "Name of a change log file for \\[add-change-log-entry]."
fcad5199
RS
52 :type '(choice (const :tag "default" nil)
53 string)
54 :group 'change-log)
10b35c39 55(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
fcad5199 56
c3979f12
DL
57(defcustom change-log-mode-hook nil
58 "Normal hook run by `change-log-mode'."
59 :type 'hook
60 :group 'change-log)
61
c882e115
RS
62;; Many modes set this variable, so avoid warnings.
63;;;###autoload
fcad5199 64(defcustom add-log-current-defun-function nil
bb042dc6 65 "If non-nil, function to guess name of surrounding function.
5960adc7
DL
66It is used by `add-log-current-defun' in preference to built-in rules.
67Returns function's name as a string, or nil if outside a function."
cea3855a 68 :type '(choice (const nil) function)
fcad5199 69 :group 'change-log)
6258d3af 70
29db528b 71;;;###autoload
fcad5199 72(defcustom add-log-full-name nil
bb042dc6 73 "Full name of user, for inclusion in ChangeLog daily headers.
075a6629 74This defaults to the value returned by the function `user-full-name'."
fcad5199
RS
75 :type '(choice (const :tag "Default" nil)
76 string)
77 :group 'change-log)
02ec1592 78
29db528b 79;;;###autoload
fcad5199 80(defcustom add-log-mailing-address nil
d1921057 81 "Email addresses of user, for inclusion in ChangeLog headers.
c1b3ae42
CW
82This defaults to the value of `user-mail-address'. In addition to
83being a simple string, this value can also be a list. All elements
84will be recognized as referring to the same user; when creating a new
85ChangeLog entry, one element will be chosen at random."
fcad5199 86 :type '(choice (const :tag "Default" nil)
24f4201f
MR
87 (string :tag "String")
88 (repeat :tag "List of Strings" string))
fcad5199
RS
89 :group 'change-log)
90
df63ae66 91(defcustom add-log-time-format 'add-log-iso8601-time-string
d1921057 92 "Function that defines the time format.
df63ae66
RS
93For example, `add-log-iso8601-time-string', which gives the
94date in international ISO 8601 format,
95and `current-time-string' are two valid values."
96 :type '(radio (const :tag "International ISO 8601 format"
97 add-log-iso8601-time-string)
98 (const :tag "Old format, as returned by `current-time-string'"
99 current-time-string)
100 (function :tag "Other"))
101 :group 'change-log)
02ec1592 102
83afd62c 103(defcustom add-log-keep-changes-together nil
d1921057 104 "If non-nil, normally keep day's log entries for one file together.
3697b807
DL
105
106Log entries for a given file made with \\[add-change-log-entry] or
107\\[add-change-log-entry-other-window] will only be added to others \
108for that file made
109today if this variable is non-nil or that file comes first in today's
110entries. Otherwise another entry for that file will be started. An
111original log:
112
113 * foo (...): ...
114 * bar (...): change 1
83afd62c 115
3697b807
DL
116in the latter case, \\[add-change-log-entry-other-window] in a \
117buffer visiting `bar', yields:
83afd62c 118
3697b807
DL
119 * bar (...): -!-
120 * foo (...): ...
121 * bar (...): change 1
83afd62c 122
3697b807 123and in the former:
83afd62c 124
3697b807
DL
125 * foo (...): ...
126 * bar (...): change 1
127 (...): -!-
83afd62c 128
3697b807
DL
129The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
130this variable."
131 :version "20.3"
83afd62c
KH
132 :type 'boolean
133 :group 'change-log)
134
598f34fa 135(defcustom add-log-always-start-new-record nil
d1921057 136 "If non-nil, `add-change-log-entry' will always start a new record."
bf247b6e 137 :version "22.1"
598f34fa
SS
138 :type 'boolean
139 :group 'change-log)
140
d68f7f1b 141(defcustom add-log-buffer-file-name-function nil
d1921057 142 "If non-nil, function to call to identify the full filename of a buffer.
d68f7f1b
SM
143This function is called with no argument. If this is nil, the default is to
144use `buffer-file-name'."
cea3855a 145 :type '(choice (const nil) function)
d68f7f1b
SM
146 :group 'change-log)
147
666f4056 148(defcustom add-log-file-name-function nil
d1921057 149 "If non-nil, function to call to identify the filename for a ChangeLog entry.
075a6629
DL
150This function is called with one argument, the value of variable
151`buffer-file-name' in that buffer. If this is nil, the default is to
152use the file's name relative to the directory of the change log file."
cea3855a 153 :type '(choice (const nil) function)
666f4056
RS
154 :group 'change-log)
155
776d8e16
GM
156
157(defcustom change-log-version-info-enabled nil
bb042dc6 158 "If non-nil, enable recording version numbers with the changes."
776d8e16
GM
159 :version "21.1"
160 :type 'boolean
161 :group 'change-log)
162
163(defcustom change-log-version-number-regexp-list
164 (let ((re "\\([0-9]+\.[0-9.]+\\)"))
165 (list
166 ;; (defconst ad-version "2.15"
167 (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
168 ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp
5960adc7 169 (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re)))
bb042dc6 170 "List of regexps to search for version number.
5960adc7 171The version number must be in group 1.
776d8e16
GM
172Note: The search is conducted only within 10%, at the beginning of the file."
173 :version "21.1"
174 :type '(repeat regexp)
175 :group 'change-log)
176
fe735a8d 177(defface change-log-date
163f7b71
GM
178 '((t (:inherit font-lock-string-face)))
179 "Face used to highlight dates in date lines."
180 :version "21.1"
181 :group 'change-log)
fe735a8d
MB
182;; backward-compatibility alias
183(put 'change-log-date-face 'face-alias 'change-log-date)
163f7b71 184
fe735a8d 185(defface change-log-name
163f7b71
GM
186 '((t (:inherit font-lock-constant-face)))
187 "Face for highlighting author names."
188 :version "21.1"
189 :group 'change-log)
fe735a8d
MB
190;; backward-compatibility alias
191(put 'change-log-name-face 'face-alias 'change-log-name)
163f7b71 192
fe735a8d 193(defface change-log-email
163f7b71
GM
194 '((t (:inherit font-lock-variable-name-face)))
195 "Face for highlighting author email addresses."
196 :version "21.1"
197 :group 'change-log)
fe735a8d
MB
198;; backward-compatibility alias
199(put 'change-log-email-face 'face-alias 'change-log-email)
163f7b71 200
fe735a8d 201(defface change-log-file
163f7b71
GM
202 '((t (:inherit font-lock-function-name-face)))
203 "Face for highlighting file names."
204 :version "21.1"
205 :group 'change-log)
fe735a8d
MB
206;; backward-compatibility alias
207(put 'change-log-file-face 'face-alias 'change-log-file)
163f7b71 208
fe735a8d 209(defface change-log-list
163f7b71
GM
210 '((t (:inherit font-lock-keyword-face)))
211 "Face for highlighting parenthesized lists of functions or variables."
212 :version "21.1"
213 :group 'change-log)
fe735a8d
MB
214;; backward-compatibility alias
215(put 'change-log-list-face 'face-alias 'change-log-list)
598f34fa 216
fe735a8d 217(defface change-log-conditionals
163f7b71
GM
218 '((t (:inherit font-lock-variable-name-face)))
219 "Face for highlighting conditionals of the form `[...]'."
220 :version "21.1"
221 :group 'change-log)
fe735a8d
MB
222;; backward-compatibility alias
223(put 'change-log-conditionals-face 'face-alias 'change-log-conditionals)
163f7b71 224
fe735a8d 225(defface change-log-function
163f7b71
GM
226 '((t (:inherit font-lock-variable-name-face)))
227 "Face for highlighting items of the form `<....>'."
228 :version "21.1"
229 :group 'change-log)
fe735a8d
MB
230;; backward-compatibility alias
231(put 'change-log-function-face 'face-alias 'change-log-function)
163f7b71 232
fe735a8d 233(defface change-log-acknowledgement
163f7b71
GM
234 '((t (:inherit font-lock-comment-face)))
235 "Face for highlighting acknowledgments."
236 :version "21.1"
237 :group 'change-log)
fe735a8d
MB
238;; backward-compatibility alias
239(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement)
776d8e16 240
a28ed9e5 241(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
000605b3 242(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
a28ed9e5 243
5f562719 244(defvar change-log-font-lock-keywords
a28ed9e5 245 `(;;
080525ae
KH
246 ;; Date lines, new (2000-01-01) and old (Sat Jan 1 00:00:00 2000) styles.
247 ;; Fixme: this regepx is just an approximate one and may match
248 ;; wrongly with a non-date line existing as a random note. In
249 ;; addition, using any kind of fixed setting like this doesn't
250 ;; work if a user customizes add-log-time-format.
251 ("^[0-9-]+ +\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-z][a-z][a-z] [0-9:+ ]+"
252 (0 'change-log-date-face)
97a3278b 253 ;; Name and e-mail; some people put e-mail in parens, not angles.
7397a79f 254 ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
fe735a8d
MB
255 (1 'change-log-name)
256 (2 'change-log-email)))
5572c1d1
SM
257 ;;
258 ;; File names.
a28ed9e5 259 (,change-log-file-names-re
fe735a8d 260 (2 'change-log-file)
97a3278b 261 ;; Possibly further names in a list:
fe735a8d 262 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file))
97a3278b 263 ;; Possibly a parenthesized list of names:
171c707b 264 ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
fe735a8d 265 nil nil (1 'change-log-list))
171c707b 266 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
fe735a8d 267 nil nil (1 'change-log-list)))
5572c1d1
SM
268 ;;
269 ;; Function or variable names.
9e4b54a0 270 ("^\\( +\\|\t\\)(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
fe735a8d 271 (2 'change-log-list)
171c707b 272 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil
fe735a8d 273 (1 'change-log-list)))
5572c1d1
SM
274 ;;
275 ;; Conditionals.
fe735a8d 276 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals))
5572c1d1 277 ;;
a8d693d8 278 ;; Function of change.
fe735a8d 279 ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function))
a8d693d8 280 ;;
a3cab9f0 281 ;; Acknowledgements.
a8e10524
RS
282 ;; Don't include plain "From" because that is vague;
283 ;; we want to encourage people to say something more specific.
c50089c9
RS
284 ;; Note that the FSF does not use "Patches by"; our convention
285 ;; is to put the name of the author of the changes at the top
286 ;; of the change log entry.
9e4b54a0 287 ("\\(^\\( +\\|\t\\)\\| \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
fe735a8d 288 3 'change-log-acknowledgement))
5f562719
RS
289 "Additional expressions to highlight in Change Log mode.")
290
a28ed9e5
DN
291(defun change-log-search-file-name (where)
292 "Return the file-name for the change under point."
293 (save-excursion
294 (goto-char where)
295 (beginning-of-line 1)
000605b3
DN
296 (if (looking-at change-log-start-entry-re)
297 ;; We are at the start of an entry, search forward for a file
298 ;; name.
299 (progn
300 (re-search-forward change-log-file-names-re nil t)
f06b5ed2 301 (match-string-no-properties 2))
000605b3
DN
302 (if (looking-at change-log-file-names-re)
303 ;; We found a file name.
f06b5ed2 304 (match-string-no-properties 2)
000605b3
DN
305 ;; Look backwards for either a file name or the log entry start.
306 (if (re-search-backward
307 (concat "\\(" change-log-start-entry-re
308 "\\)\\|\\("
309 change-log-file-names-re "\\)") nil t)
310 (if (match-beginning 1)
311 ;; We got the start of the entry, look forward for a
312 ;; file name.
313 (progn
314 (re-search-forward change-log-file-names-re nil t)
f06b5ed2
MR
315 (match-string-no-properties 2))
316 (match-string-no-properties 4))
000605b3
DN
317 ;; We must be before any file name, look forward.
318 (re-search-forward change-log-file-names-re nil t)
f06b5ed2 319 (match-string-no-properties 2))))))
a28ed9e5
DN
320
321(defun change-log-find-file ()
322 "Visit the file for the change under point."
323 (interactive)
324 (let ((file (change-log-search-file-name (point))))
325 (if (and file (file-exists-p file))
326 (find-file file)
000605b3 327 (message "No such file or directory: %s" file))))
a28ed9e5 328
f06b5ed2
MR
329(defun change-log-search-tag-name-1 (&optional from)
330 "Search for a tag name within subexpression 1 of last match.
331Optional argument FROM specifies a buffer position where the tag
332name should be located. Return value is a cons whose car is the
333string representing the tag and whose cdr is the position where
334the tag was found."
335 (save-restriction
336 (narrow-to-region (match-beginning 1) (match-end 1))
337 (when from (goto-char from))
338 ;; The regexp below skips any symbol near `point' (FROM) followed by
339 ;; whitespace and another symbol. This should skip, for example,
340 ;; "struct" in a specification like "(struct buffer)" and move to
341 ;; "buffer". A leading paren is ignored.
342 (when (looking-at
343 "[(]?\\(?:\\(?:\\sw\\|\\s_\\)+\\(?:[ \t]+\\(\\sw\\|\\s_\\)+\\)\\)")
344 (goto-char (match-beginning 1)))
345 (cons (find-tag-default) (point))))
346
347(defconst change-log-tag-re
348 "(\\(\\(?:\\sw\\|\\s_\\)+\\(?:[, \t]+\\(?:\\sw\\|\\s_\\)+\\)*\\))"
349 "Regexp matching a tag name in change log entries.")
350
351(defun change-log-search-tag-name (&optional at)
352 "Search for a tag name near `point'.
353Optional argument AT non-nil means search near buffer position
354AT. Return value is a cons whose car is the string representing
355the tag and whose cdr is the position where the tag was found."
356 (save-excursion
357 (goto-char (setq at (or at (point))))
358 (save-restriction
359 (widen)
360 (or (condition-case nil
361 ;; Within parenthesized list?
362 (save-excursion
363 (backward-up-list)
364 (when (looking-at change-log-tag-re)
365 (change-log-search-tag-name-1 at)))
366 (error nil))
367 (condition-case nil
368 ;; Before parenthesized list?
369 (save-excursion
370 (when (and (skip-chars-forward " \t")
371 (looking-at change-log-tag-re))
372 (change-log-search-tag-name-1)))
373 (error nil))
374 (condition-case nil
375 ;; Near filename?
376 (save-excursion
377 (when (and (progn
378 (beginning-of-line)
379 (looking-at change-log-file-names-re))
380 (goto-char (match-end 0))
381 (skip-syntax-forward " ")
382 (looking-at change-log-tag-re))
383 (change-log-search-tag-name-1)))
384 (error nil))
385 (condition-case nil
386 ;; Before filename?
387 (save-excursion
388 (when (and (progn
389 (skip-syntax-backward " ")
390 (beginning-of-line)
391 (looking-at change-log-file-names-re))
392 (goto-char (match-end 0))
393 (skip-syntax-forward " ")
394 (looking-at change-log-tag-re))
395 (change-log-search-tag-name-1)))
396 (error nil))
397 (condition-case nil
398 ;; Near start entry?
399 (save-excursion
400 (when (and (progn
401 (beginning-of-line)
402 (looking-at change-log-start-entry-re))
403 (forward-line) ; Won't work for multiple
404 ; names, etc.
405 (skip-syntax-forward " ")
406 (progn
407 (beginning-of-line)
408 (looking-at change-log-file-names-re))
409 (goto-char (match-end 0))
410 (re-search-forward change-log-tag-re))
411 (change-log-search-tag-name-1)))
412 (error nil))
413 (condition-case nil
414 ;; After parenthesized list?.
415 (when (re-search-backward change-log-tag-re)
416 (save-restriction
417 (narrow-to-region (match-beginning 1) (match-end 1))
418 (goto-char (point-max))
419 (cons (find-tag-default) (point-max))))
420 (error nil))))))
421
422(defvar change-log-find-head nil)
423(defvar change-log-find-tail nil)
424
425(defun change-log-goto-source-1 (tag regexp file buffer
426 &optional window first last)
427 "Search for tag TAG in buffer BUFFER visiting file FILE.
428REGEXP is a regular expression for TAG. The remaining arguments
429are optional: WINDOW denotes the window to display the results of
430the search. FIRST is a position in BUFFER denoting the first
431match from previous searches for TAG. LAST is the position in
432BUFFER denoting the last match for TAG in the last search."
433 (with-current-buffer buffer
434 (save-excursion
435 (save-restriction
436 (widen)
437 (if last
438 (progn
439 ;; When LAST is set make sure we continue from the next
440 ;; line end to not find the same tag again.
441 (goto-char last)
442 (end-of-line)
443 (condition-case nil
444 ;; Try to go to the end of the current defun to avoid
445 ;; false positives within the current defun's body
446 ;; since these would match `add-log-current-defun'.
447 (end-of-defun)
448 ;; Don't fall behind when `end-of-defun' fails.
449 (error (progn (goto-char last) (end-of-line))))
450 (setq last nil))
451 ;; When LAST was not set start at beginning of BUFFER.
452 (goto-char (point-min)))
453 (let (current-defun)
454 (while (and (not last) (re-search-forward regexp nil t))
455 ;; Verify that `add-log-current-defun' invoked at the end
456 ;; of the match returns TAG. This heuristic works well
457 ;; whenever the name of the defun occurs within the first
458 ;; line of the defun.
459 (setq current-defun (add-log-current-defun))
460 (when (and current-defun (string-equal current-defun tag))
461 ;; Record this as last match.
462 (setq last (line-beginning-position))
463 ;; Record this as first match when there's none.
464 (unless first (setq first last)))))))
465 (if (or last first)
466 (with-selected-window (or window (display-buffer buffer))
467 (if last
468 (progn
469 (when (or (< last (point-min)) (> last (point-max)))
470 ;; Widen to show TAG.
471 (widen))
472 (push-mark)
473 (goto-char last))
474 ;; When there are no more matches go (back) to FIRST.
475 (message "No more matches for tag `%s' in file `%s'" tag file)
476 (setq last first)
477 (goto-char first))
478 ;; Return new "tail".
479 (list (selected-window) first last))
480 (message "Source location of tag `%s' not found in file `%s'" tag file)
481 nil)))
482
483(defun change-log-goto-source ()
484 "Go to source location of change log tag near `point'.
485A change log tag is a symbol within a parenthesized,
486comma-separated list."
487 (interactive)
488 (if (and (eq last-command 'change-log-goto-source)
489 change-log-find-tail)
490 (setq change-log-find-tail
491 (condition-case nil
492 (apply 'change-log-goto-source-1
493 (append change-log-find-head change-log-find-tail))
494 (error
495 (format "Cannot find more matches for tag `%s' in file `%s'"
496 (car change-log-find-head)
497 (nth 2 change-log-find-head)))))
498 (save-excursion
499 (let* ((tag-at (change-log-search-tag-name))
500 (tag (car tag-at))
501 (file (when tag-at
502 (change-log-search-file-name (cdr tag-at)))))
83750bb1 503 (if (or (not tag) (not file))
f06b5ed2
MR
504 (error "No suitable tag near `point'")
505 (setq change-log-find-head
506 (list tag (concat "\\_<" (regexp-quote tag) "\\_>")
507 file (find-file-noselect file)))
508 (condition-case nil
509 (setq change-log-find-tail
510 (apply 'change-log-goto-source-1 change-log-find-head))
511 (error (format "Cannot find matches for tag `%s' in `%s'"
512 tag file))))))))
513
7be2b094
TZ
514(defun change-log-next-error (&optional argp reset)
515 "Move to the Nth (default 1) next match in an Occur mode buffer.
516Compatibility function for \\[next-error] invocations."
517 (interactive "p")
518 (let* ((argp (or argp 0))
519 (count (abs argp)) ; how many cycles
520 (down (< argp 0)) ; are we going down? (is argp negative?)
521 (up (not down))
522 (search-function (if up 're-search-forward 're-search-backward)))
523
524 ;; set the starting position
525 (goto-char (cond (reset (point-min))
526 (down (line-beginning-position))
527 (up (line-end-position))
528 ((point))))
529
530 (funcall search-function change-log-file-names-re nil t count))
531
532 (beginning-of-line)
533 ;; if we found a place to visit...
534 (when (looking-at change-log-file-names-re)
535 (change-log-goto-source)))
536
3066d4ad
SM
537(defvar change-log-mode-map
538 (let ((map (make-sparse-keymap)))
539 (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
540 (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
a28ed9e5 541 (define-key map [?\C-c ?\C-f] 'change-log-find-file)
f06b5ed2 542 (define-key map [?\C-c ?\C-c] 'change-log-goto-source)
3066d4ad 543 map)
45c50c5d 544 "Keymap for Change Log major mode.")
45c50c5d 545
d1921057
SM
546;; It used to be called change-log-time-zone-rule but really should be
547;; called add-log-time-zone-rule since it's only used from add-log-* code.
548(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule)
549(defvar add-log-time-zone-rule nil
51bd1843
EN
550 "Time zone used for calculating change log time stamps.
551It takes the same format as the TZ argument of `set-time-zone-rule'.
d1921057
SM
552If nil, use local time.
553If t, use universal time.")
d52c204b
RS
554(put 'add-log-time-zone-rule 'safe-local-variable
555 '(lambda (x) (or (booleanp x) (stringp x))))
51bd1843 556
0739a962 557(defun add-log-iso8601-time-zone (&optional time)
51bd1843
EN
558 (let* ((utc-offset (or (car (current-time-zone time)) 0))
559 (sign (if (< utc-offset 0) ?- ?+))
560 (sec (abs utc-offset))
561 (ss (% sec 60))
562 (min (/ sec 60))
563 (mm (% min 60))
564 (hh (/ min 60)))
565 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
566 ((not (zerop mm)) "%c%02d:%02d")
567 (t "%c%02d"))
568 sign hh mm ss)))
569
d1921057
SM
570(defvar add-log-iso8601-with-time-zone nil)
571
df63ae66 572(defun add-log-iso8601-time-string ()
0739a962
SM
573 (let ((time (format-time-string "%Y-%m-%d"
574 nil (eq t add-log-time-zone-rule))))
d1921057
SM
575 (if add-log-iso8601-with-time-zone
576 (concat time " " (add-log-iso8601-time-zone))
577 time)))
df63ae66 578
84fc2cfa 579(defun change-log-name ()
075a6629 580 "Return (system-dependent) default name for a change log file."
84fc2cfa 581 (or change-log-default-name
7c2fb837 582 "ChangeLog"))
84fc2cfa 583
3066d4ad
SM
584(defun add-log-edit-prev-comment (arg)
585 "Cycle backward through Log-Edit mode comment history.
586With a numeric prefix ARG, go back ARG comments."
587 (interactive "*p")
588 (save-restriction
589 (narrow-to-region (point)
590 (if (memq last-command '(add-log-edit-prev-comment
591 add-log-edit-next-comment))
592 (mark) (point)))
593 (when (fboundp 'log-edit-previous-comment)
594 (log-edit-previous-comment arg)
595 (indent-region (point-min) (point-max))
596 (goto-char (point-min))
597 (unless (save-restriction (widen) (bolp))
598 (delete-region (point) (progn (skip-chars-forward " \t\n") (point))))
599 (set-mark (point-min))
600 (goto-char (point-max))
601 (delete-region (point) (progn (skip-chars-backward " \t\n") (point))))))
602
603(defun add-log-edit-next-comment (arg)
604 "Cycle forward through Log-Edit mode comment history.
605With a numeric prefix ARG, go back ARG comments."
606 (interactive "*p")
607 (add-log-edit-prev-comment (- arg)))
608
287d149f 609;;;###autoload
84fc2cfa
ER
610(defun prompt-for-change-log-name ()
611 "Prompt for a change log name."
117aaf60
KH
612 (let* ((default (change-log-name))
613 (name (expand-file-name
614 (read-file-name (format "Log file (default %s): " default)
615 nil default))))
616 ;; Handle something that is syntactically a directory name.
617 ;; Look for ChangeLog or whatever in that directory.
618 (if (string= (file-name-nondirectory name) "")
619 (expand-file-name (file-name-nondirectory default)
620 name)
621 ;; Handle specifying a file that is a directory.
622 (if (file-directory-p name)
623 (expand-file-name (file-name-nondirectory default)
624 (file-name-as-directory name))
625 name))))
84fc2cfa 626
776d8e16 627(defun change-log-version-number-search ()
5960adc7 628 "Return version number of current buffer's file.
ac3f4c6f 629This is the value returned by `vc-working-revision' or, if that is
5960adc7 630nil, by matching `change-log-version-number-regexp-list'."
776d8e16 631 (let* ((size (buffer-size))
fc9b0554 632 (limit
5960adc7
DL
633 ;; The version number can be anywhere in the file, but
634 ;; restrict search to the file beginning: 10% should be
635 ;; enough to prevent some mishits.
776d8e16 636 ;;
5960adc7
DL
637 ;; Apply percentage only if buffer size is bigger than
638 ;; approx 100 lines.
fc9b0554 639 (if (> size (* 100 80)) (+ (point) (/ size 10)))))
ac3f4c6f 640 (or (and buffer-file-name (vc-working-revision buffer-file-name))
5960adc7
DL
641 (save-restriction
642 (widen)
fc9b0554
SM
643 (let ((regexps change-log-version-number-regexp-list)
644 version)
5960adc7
DL
645 (while regexps
646 (save-excursion
647 (goto-char (point-min))
fc9b0554 648 (when (re-search-forward (pop regexps) limit t)
5960adc7 649 (setq version (match-string 1)
fc9b0554
SM
650 regexps nil))))
651 version)))))
776d8e16
GM
652
653
45a13f0d 654;;;###autoload
d68f7f1b 655(defun find-change-log (&optional file-name buffer-file)
45a13f0d 656 "Find a change log file for \\[add-change-log-entry] and return the name.
a82e2ed5
RS
657
658Optional arg FILE-NAME specifies the file to use.
de98fcaf 659If FILE-NAME is nil, use the value of `change-log-default-name'.
218cf475 660If `change-log-default-name' is nil, behave as though it were 'ChangeLog'
de98fcaf
RS
661\(or whatever we use on this operating system).
662
218cf475 663If `change-log-default-name' contains a leading directory component, then
513063cf 664simply find it in the current directory. Otherwise, search in the current
de98fcaf 665directory and its successive parents for a file so named.
45a13f0d
RM
666
667Once a file is found, `change-log-default-name' is set locally in the
d68f7f1b
SM
668current buffer to the complete file name.
669Optional arg BUFFER-FILE overrides `buffer-file-name'."
a82e2ed5
RS
670 ;; If user specified a file name or if this buffer knows which one to use,
671 ;; just use that.
45a13f0d 672 (or file-name
de98fcaf
RS
673 (setq file-name (and change-log-default-name
674 (file-name-directory change-log-default-name)
675 change-log-default-name))
a82e2ed5
RS
676 (progn
677 ;; Chase links in the source file
678 ;; and use the change log in the dir where it points.
d68f7f1b 679 (setq file-name (or (and (or buffer-file buffer-file-name)
a82e2ed5 680 (file-name-directory
d68f7f1b
SM
681 (file-chase-links
682 (or buffer-file buffer-file-name))))
a82e2ed5
RS
683 default-directory))
684 (if (file-directory-p file-name)
685 (setq file-name (expand-file-name (change-log-name) file-name)))
686 ;; Chase links before visiting the file.
687 ;; This makes it easier to use a single change log file
688 ;; for several related directories.
689 (setq file-name (file-chase-links file-name))
690 (setq file-name (expand-file-name file-name))
691 ;; Move up in the dir hierarchy till we find a change log file.
692 (let ((file1 file-name)
693 parent-dir)
694 (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
695 (progn (setq parent-dir
696 (file-name-directory
697 (directory-file-name
698 (file-name-directory file1))))
699 ;; Give up if we are already at the root dir.
700 (not (string= (file-name-directory file1)
701 parent-dir))))
702 ;; Move up to the parent dir and try again.
513063cf 703 (setq file1 (expand-file-name
a82e2ed5
RS
704 (file-name-nondirectory (change-log-name))
705 parent-dir)))
706 ;; If we found a change log in a parent, use that.
707 (if (or (get-file-buffer file1) (file-exists-p file1))
708 (setq file-name file1)))))
709 ;; Make a local variable in this buffer so we needn't search again.
710 (set (make-local-variable 'change-log-default-name) file-name)
711 file-name)
45a13f0d 712
2eb7ccf4
SM
713(defun add-log-file-name (buffer-file log-file)
714 ;; Never want to add a change log entry for the ChangeLog file itself.
715 (unless (or (null buffer-file) (string= buffer-file log-file))
d68f7f1b
SM
716 (if add-log-file-name-function
717 (funcall add-log-file-name-function buffer-file)
718 (setq buffer-file
e1f5b0ed 719 (file-relative-name buffer-file (file-name-directory log-file)))
d68f7f1b
SM
720 ;; If we have a backup file, it's presumably because we're
721 ;; comparing old and new versions (e.g. for deleted
722 ;; functions) and we'll want to use the original name.
723 (if (backup-file-name-p buffer-file)
724 (file-name-sans-versions buffer-file)
725 buffer-file))))
2eb7ccf4 726
84fc2cfa 727;;;###autoload
2a520399
DN
728(defun add-change-log-entry (&optional whoami file-name other-window new-entry
729 put-new-entry-on-new-line)
d882f144 730 "Find change log file, and add an entry for today and an item for this file.
83afd62c 731Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
d9ee5172 732name and email (stored in `add-log-full-name' and `add-log-mailing-address').
83afd62c 733
d882f144
RS
734Second arg FILE-NAME is file name of the change log.
735If nil, use the value of `change-log-default-name'.
736
287d149f 737Third arg OTHER-WINDOW non-nil means visit in other window.
d882f144 738
287d149f 739Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
3697b807
DL
740never append to an existing entry. Option `add-log-keep-changes-together'
741otherwise affects whether a new entry is created.
742
2a520399
DN
743Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new
744entry is created, put it on a new line by itself, do not put it
745after a comma on an existing line.
746
598f34fa
SS
747Option `add-log-always-start-new-record' non-nil means always create a
748new record, even when the last record was made on the same date and by
749the same person.
750
d882f144
RS
751The change log file can start with a copyright notice and a copying
752permission notice. The first blank line indicates the end of these
753notices.
754
d1921057 755Today's date is calculated according to `add-log-time-zone-rule' if
3697b807 756non-nil, otherwise in local time."
84fc2cfa
ER
757 (interactive (list current-prefix-arg
758 (prompt-for-change-log-name)))
d68f7f1b
SM
759 (let* ((defun (add-log-current-defun))
760 (version (and change-log-version-info-enabled
761 (change-log-version-number-search)))
8f530b95
SM
762 (buf-file-name (if add-log-buffer-file-name-function
763 (funcall add-log-buffer-file-name-function)
764 buffer-file-name))
765 (buffer-file (if buf-file-name (expand-file-name buf-file-name)))
dd816e0d 766 (file-name (expand-file-name (find-change-log file-name buffer-file)))
d882f144 767 ;; Set ITEM to the file name to use in the new item.
ad4573c7 768 (item (add-log-file-name buffer-file file-name)))
2eb7ccf4 769
7cd017ba
SM
770 (unless (equal file-name buffer-file-name)
771 (if (or other-window (window-dedicated-p (selected-window)))
772 (find-file-other-window file-name)
773 (find-file file-name)))
bb042dc6 774 (or (derived-mode-p 'change-log-mode)
675a998f 775 (change-log-mode))
84fc2cfa
ER
776 (undo-boundary)
777 (goto-char (point-min))
d882f144 778
ad4573c7
SM
779 (let ((full-name (or add-log-full-name (user-full-name)))
780 (mailing-address (or add-log-mailing-address user-mail-address)))
781
782 (when whoami
1e899515 783 (setq full-name (read-string "Full name: " full-name))
ad4573c7
SM
784 ;; Note that some sites have room and phone number fields in
785 ;; full name which look silly when inserted. Rather than do
786 ;; anything about that here, let user give prefix argument so that
787 ;; s/he can edit the full name field in prompter if s/he wants.
788 (setq mailing-address
1e899515 789 (read-string "Mailing address: " mailing-address)))
ad4573c7
SM
790
791 ;; If file starts with a copyright and permission notice, skip them.
792 ;; Assume they end at first blank line.
793 (when (looking-at "Copyright")
794 (search-forward "\n\n")
795 (skip-chars-forward "\n"))
796
797 ;; Advance into first entry if it is usable; else make new one.
798 (let ((new-entries
799 (mapcar (lambda (addr)
800 (concat
801 (if (stringp add-log-time-zone-rule)
802 (let ((tz (getenv "TZ")))
803 (unwind-protect
804 (progn
805 (set-time-zone-rule add-log-time-zone-rule)
806 (funcall add-log-time-format))
807 (set-time-zone-rule tz)))
808 (funcall add-log-time-format))
809 " " full-name
810 " <" addr ">"))
811 (if (consp mailing-address)
812 mailing-address
813 (list mailing-address)))))
814 (if (and (not add-log-always-start-new-record)
815 (let ((hit nil))
816 (dolist (entry new-entries hit)
817 (when (looking-at (regexp-quote entry))
818 (setq hit t)))))
819 (forward-line 1)
820 (insert (nth (random (length new-entries))
821 new-entries)
822 (if use-hard-newlines hard-newline "\n")
823 (if use-hard-newlines hard-newline "\n"))
824 (forward-line -1))))
82f4acaf 825
d882f144
RS
826 ;; Determine where we should stop searching for a usable
827 ;; item to add to, within this entry.
ad4573c7
SM
828 (let ((bound
829 (save-excursion
830 (if (looking-at "\n*[^\n* \t]")
831 (skip-chars-forward "\n")
832 (if add-log-keep-changes-together
833 (forward-page) ; page delimits entries for date
834 (forward-paragraph))) ; paragraph delimits entries for file
835 (point))))
836
837 ;; Now insert the new line for this item.
838 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
839 ;; Put this file name into the existing empty item.
840 (if item
841 (insert item)))
842 ((and (not new-entry)
843 (let (case-fold-search)
844 (re-search-forward
845 (concat (regexp-quote (concat "* " item))
846 ;; Don't accept `foo.bar' when
847 ;; looking for `foo':
848 "\\(\\s \\|[(),:]\\)")
849 bound t)))
850 ;; Add to the existing item for the same file.
851 (re-search-forward "^\\s *$\\|^\\s \\*")
852 (goto-char (match-beginning 0))
853 ;; Delete excess empty lines; make just 2.
854 (while (and (not (eobp)) (looking-at "^\\s *$"))
855 (delete-region (point) (line-beginning-position 2)))
856 (insert (if use-hard-newlines hard-newline "\n")
857 (if use-hard-newlines hard-newline "\n"))
858 (forward-line -2)
859 (indent-relative-maybe))
860 (t
861 ;; Make a new item.
862 (while (looking-at "\\sW")
863 (forward-line 1))
864 (while (and (not (eobp)) (looking-at "^\\s *$"))
865 (delete-region (point) (line-beginning-position 2)))
866 (insert (if use-hard-newlines hard-newline "\n")
867 (if use-hard-newlines hard-newline "\n")
868 (if use-hard-newlines hard-newline "\n"))
869 (forward-line -2)
870 (indent-to left-margin)
871 (insert "* ")
872 (if item (insert item)))))
1832dbd1 873 ;; Now insert the function name, if we have one.
d882f144 874 ;; Point is at the item for this file,
21d7e080 875 ;; either at the end of the line or at the first blank line.
5a9ac14b
SM
876 (if (not defun)
877 ;; No function name, so put in a colon unless we have just a star.
878 (unless (save-excursion
879 (beginning-of-line 1)
880 (looking-at "\\s *\\(\\*\\s *\\)?$"))
881 (insert ": ")
7b297602 882 (if version (insert version ?\s)))
5a9ac14b
SM
883 ;; Make it easy to get rid of the function name.
884 (undo-boundary)
5960adc7
DL
885 (unless (save-excursion
886 (beginning-of-line 1)
5a9ac14b 887 (looking-at "\\s *$"))
7b297602 888 (insert ?\s))
5a9ac14b
SM
889 ;; See if the prev function name has a message yet or not.
890 ;; If not, merge the two items.
891 (let ((pos (point-marker)))
892 (skip-syntax-backward " ")
893 (skip-chars-backward "):")
2a520399
DN
894 (if (and (not put-new-entry-on-new-line)
895 (looking-at "):")
fc9b0554
SM
896 (let ((pos (save-excursion (backward-sexp 1) (point))))
897 (when (equal (buffer-substring pos (point)) defun)
898 (delete-region pos (point)))
899 (> fill-column (+ (current-column) (length defun) 4))))
900 (progn (skip-chars-backward ", ")
901 (delete-region (point) pos)
902 (unless (memq (char-before) '(?\()) (insert ", ")))
2a520399
DN
903 (when (and (not put-new-entry-on-new-line) (looking-at "):"))
904 (delete-region (+ 1 (point)) (line-end-position)))
5a9ac14b
SM
905 (goto-char pos)
906 (insert "("))
907 (set-marker pos nil))
908 (insert defun "): ")
7b297602 909 (if version (insert version ?\s)))))
84fc2cfa 910
84fc2cfa
ER
911;;;###autoload
912(defun add-change-log-entry-other-window (&optional whoami file-name)
d882f144
RS
913 "Find change log file in other window and add entry and item.
914This is just like `add-change-log-entry' except that it displays
915the change log file in another window."
84fc2cfa
ER
916 (interactive (if current-prefix-arg
917 (list current-prefix-arg
918 (prompt-for-change-log-name))))
919 (add-change-log-entry whoami file-name t))
920
6dbf6147 921
d1921057 922(defvar change-log-indent-text 0)
fc9b0554 923
6dbf6147
MR
924(defun change-log-fill-parenthesized-list ()
925 ;; Fill parenthesized lists of names according to GNU standards.
926 ;; * file-name.ext (very-long-foo, very-long-bar, very-long-foobar):
927 ;; should be filled as
928 ;; * file-name.ext (very-long-foo, very-long-bar)
929 ;; (very-long-foobar):
930 (save-excursion
931 (end-of-line 0)
932 (skip-chars-backward " \t")
933 (when (and (equal (char-before) ?\,)
934 (> (point) (1+ (point-min))))
935 (condition-case nil
936 (when (save-excursion
937 (and (prog2
938 (up-list -1)
939 (equal (char-after) ?\()
940 (skip-chars-backward " \t"))
941 (or (bolp)
942 ;; Skip everything but a whitespace or asterisk.
943 (and (not (zerop (skip-chars-backward "^ \t\n*")))
944 (skip-chars-backward " \t")
945 ;; We want one asterisk here.
946 (= (skip-chars-backward "*") -1)
947 (skip-chars-backward " \t")
948 (bolp)))))
949 ;; Delete the comma.
950 (delete-char -1)
951 ;; Close list on previous line.
952 (insert ")")
953 (skip-chars-forward " \t\n")
954 ;; Start list on new line.
955 (insert-before-markers "("))
956 (error nil)))))
957
d1921057 958(defun change-log-indent ()
6dbf6147 959 (change-log-fill-parenthesized-list)
fc9b0554
SM
960 (let* ((indent
961 (save-excursion
962 (beginning-of-line)
963 (skip-chars-forward " \t")
964 (cond
d1921057 965 ((and (looking-at "\\(.*\\) [^ \n].*[^ \n] <.*>\\(?: +(.*)\\)? *$")
fc9b0554
SM
966 ;; Matching the output of add-log-time-format is difficult,
967 ;; but I'll get it has at least two adjacent digits.
968 (string-match "[[:digit:]][[:digit:]]" (match-string 1)))
969 0)
970 ((looking-at "[^*(]")
d1921057 971 (+ (current-left-margin) change-log-indent-text))
fc9b0554
SM
972 (t (current-left-margin)))))
973 (pos (save-excursion (indent-line-to indent) (point))))
974 (if (> pos (point)) (goto-char pos))))
975
976
3066d4ad 977(defvar smerge-resolve-function)
8bb4ed88 978(defvar copyright-at-end-flag)
3066d4ad 979
1da56800 980;;;###autoload
7cd017ba 981(define-derived-mode change-log-mode text-mode "Change Log"
eb8c3be9 982 "Major mode for editing change logs; like Indented Text Mode.
09b389d0 983Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
3697b807 984New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
5516387c 985Each entry behaves as a paragraph, and the entries for one day as a page.
3066d4ad
SM
986Runs `change-log-mode-hook'.
987\\{change-log-mode-map}"
7cd017ba 988 (setq left-margin 8
4f675a8c 989 fill-column 74
60f10a06 990 indent-tabs-mode t
ccf0d2ca
JB
991 tab-width 8
992 show-trailing-whitespace t)
60f10a06
KH
993 (set (make-local-variable 'fill-paragraph-function)
994 'change-log-fill-paragraph)
3ee9a09c
MR
995 ;; Avoid that filling leaves behind a single "*" on a line.
996 (add-hook 'fill-nobreak-predicate
997 '(lambda ()
8bb4ed88 998 (looking-back "^\\s *\\*\\s *" (line-beginning-position)))
3ee9a09c 999 nil t)
d1921057 1000 (set (make-local-variable 'indent-line-function) 'change-log-indent)
fc9b0554 1001 (set (make-local-variable 'tab-always-indent) nil)
8bb4ed88 1002 (set (make-local-variable 'copyright-at-end-flag) t)
4b7d4d0d
DL
1003 ;; We really do want "^" in paragraph-start below: it is only the
1004 ;; lines that begin at column 0 (despite the left-margin of 8) that
1005 ;; we are looking for. Adding `* ' allows eliding the blank line
1006 ;; between entries for different files.
c9cfb0f2 1007 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
4b7d4d0d 1008 (set (make-local-variable 'paragraph-separate) paragraph-start)
2c91c85c
RS
1009 ;; Match null string on the date-line so that the date-line
1010 ;; is grouped with what follows.
964141f2 1011 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
dd309224 1012 (set (make-local-variable 'version-control) 'never)
7cd017ba
SM
1013 (set (make-local-variable 'smerge-resolve-function)
1014 'change-log-resolve-conflict)
dd309224 1015 (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
4b286eca 1016 (set (make-local-variable 'font-lock-defaults)
73b27641 1017 '(change-log-font-lock-keywords t nil nil backward-paragraph))
e50fa43e 1018 (set (make-local-variable 'multi-isearch-next-buffer-function)
73b27641 1019 'change-log-next-buffer)
0bde6a03
DN
1020 (set (make-local-variable 'beginning-of-defun-function)
1021 'change-log-beginning-of-defun)
1022 (set (make-local-variable 'end-of-defun-function)
7be2b094
TZ
1023 'change-log-end-of-defun)
1024 ;; next-error function glue
1025 (setq next-error-function 'change-log-next-error)
1026 (setq next-error-last-buffer (current-buffer)))
73b27641
JL
1027
1028(defun change-log-next-buffer (&optional buffer wrap)
1029 "Return the next buffer in the series of ChangeLog file buffers.
1030This function is used for multiple buffers isearch.
1031A sequence of buffers is formed by ChangeLog files with decreasing
1032numeric file name suffixes in the directory of the initial ChangeLog
1033file were isearch was started."
1034 (let* ((name (change-log-name))
1035 (files (cons name (sort (file-expand-wildcards
1036 (concat name "[-.][0-9]*"))
1037 (lambda (a b)
bac2f6bc
SM
1038 ;; The file's extension may not have a valid
1039 ;; version form (e.g. VC backup revisions).
1040 (ignore-errors
1041 (version< (substring b (length name))
1042 (substring a (length name))))))))
73b27641
JL
1043 (files (if isearch-forward files (reverse files))))
1044 (find-file-noselect
1045 (if wrap
1046 (car files)
1047 (cadr (member (file-name-nondirectory (buffer-file-name buffer))
1048 files))))))
21d7e080 1049
287d149f
RM
1050;; It might be nice to have a general feature to replace this. The idea I
1051;; have is a variable giving a regexp matching text which should not be
1052;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
1053;; But I don't feel up to implementing that today.
1054(defun change-log-fill-paragraph (&optional justify)
1055 "Fill the paragraph, but preserve open parentheses at beginning of lines.
1056Prefix arg means justify as well."
1057 (interactive "P")
8d6467a4
RS
1058 (let ((end (progn (forward-paragraph) (point)))
1059 (beg (progn (backward-paragraph) (point)))
6dbf6147
MR
1060 ;; Add lines starting with whitespace followed by a left paren or an
1061 ;; asterisk.
1062 (paragraph-start (concat paragraph-start "\\|\\s *\\(?:\\s(\\|\\*\\)"))
1063 ;; Make sure we call `change-log-indent'.
1064 (fill-indent-according-to-mode t))
8d6467a4
RS
1065 (fill-region beg end justify)
1066 t))
287d149f 1067\f
fcad5199 1068(defcustom add-log-current-defun-header-regexp
a8d693d8 1069 "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]"
d1921057 1070 "Heuristic regexp used by `add-log-current-defun' for unknown major modes."
fcad5199
RS
1071 :type 'regexp
1072 :group 'change-log)
21d7e080 1073
fb644f48
EN
1074;;;###autoload
1075(defvar add-log-lisp-like-modes
d1921057 1076 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
fb644f48
EN
1077 "*Modes that look like Lisp to `add-log-current-defun'.")
1078
1079;;;###autoload
1080(defvar add-log-c-like-modes
d1921057 1081 '(c-mode c++-mode c++-c-mode objc-mode)
fb644f48
EN
1082 "*Modes that look like C to `add-log-current-defun'.")
1083
1084;;;###autoload
1085(defvar add-log-tex-like-modes
bb042dc6 1086 '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode)
fb644f48
EN
1087 "*Modes that look like TeX to `add-log-current-defun'.")
1088
ab319633
GM
1089(declare-function c-cpp-define-name "cc-cmds" ())
1090(declare-function c-defun-name "cc-cmds" ())
004a00f4 1091
e332f80b 1092;;;###autoload
21d7e080
ER
1093(defun add-log-current-defun ()
1094 "Return name of function definition point is in, or nil.
1095
63314951 1096Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
5960adc7 1097Texinfo (@node titles) and Perl.
21d7e080
ER
1098
1099Other modes are handled by a heuristic that looks in the 10K before
1100point for uppercase headings starting in the first column or
5960adc7 1101identifiers followed by `:' or `='. See variables
c1356086 1102`add-log-current-defun-header-regexp' and
5ef08021 1103`add-log-current-defun-function'.
21d7e080
ER
1104
1105Has a preference of looking backwards."
2cc0b765
RS
1106 (condition-case nil
1107 (save-excursion
1108 (let ((location (point)))
5960adc7
DL
1109 (cond (add-log-current-defun-function
1110 (funcall add-log-current-defun-function))
bb042dc6 1111 ((apply 'derived-mode-p add-log-lisp-like-modes)
a0151877 1112 ;; If we are now precisely at the beginning of a defun,
2cc0b765
RS
1113 ;; make sure beginning-of-defun finds that one
1114 ;; rather than the previous one.
1115 (or (eobp) (forward-char 1))
1116 (beginning-of-defun)
5960adc7
DL
1117 ;; Make sure we are really inside the defun found,
1118 ;; not after it.
42b1fc29
RS
1119 (when (and (looking-at "\\s(")
1120 (progn (end-of-defun)
1121 (< location (point)))
1122 (progn (forward-sexp -1)
1123 (>= location (point))))
1124 (if (looking-at "\\s(")
1125 (forward-char 1))
1126 ;; Skip the defining construct name, typically "defun"
1127 ;; or "defvar".
1128 (forward-sexp 1)
1129 ;; The second element is usually a symbol being defined.
1130 ;; If it is not, use the first symbol in it.
63c7727f 1131 (skip-chars-forward " \t\n'(")
5960adc7
DL
1132 (buffer-substring-no-properties (point)
1133 (progn (forward-sexp 1)
1134 (point)))))
bb042dc6 1135 ((apply 'derived-mode-p add-log-c-like-modes)
221fcdaa
AM
1136 (or (c-cpp-define-name)
1137 (c-defun-name)))
1138 ((memq major-mode add-log-tex-like-modes)
2cc0b765 1139 (if (re-search-backward
5960adc7
DL
1140 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
1141 nil t)
2cc0b765
RS
1142 (progn
1143 (goto-char (match-beginning 0))
5960adc7
DL
1144 (buffer-substring-no-properties
1145 (1+ (point)) ; without initial backslash
1146 (line-end-position)))))
bb042dc6 1147 ((derived-mode-p 'texinfo-mode)
3071ee28 1148 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
5960adc7 1149 (match-string-no-properties 1)))
fb1b68a4 1150 ((derived-mode-p 'perl-mode 'cperl-mode)
5a9ac14b 1151 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
5960adc7
DL
1152 (match-string-no-properties 1)))
1153 ;; Emacs's autoconf-mode installs its own
1154 ;; `add-log-current-defun-function'. This applies to
1155 ;; a different mode apparently for editing .m4
1156 ;; autoconf source.
bb042dc6 1157 ((derived-mode-p 'autoconf-mode)
5960adc7
DL
1158 (if (re-search-backward
1159 "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
1160 (match-string-no-properties 3)))
2cc0b765
RS
1161 (t
1162 ;; If all else fails, try heuristics
c1356086
GM
1163 (let (case-fold-search
1164 result)
2cc0b765 1165 (end-of-line)
c1356086
GM
1166 (when (re-search-backward
1167 add-log-current-defun-header-regexp
1168 (- (point) 10000)
1169 t)
5960adc7
DL
1170 (setq result (or (match-string-no-properties 1)
1171 (match-string-no-properties 0)))
c1356086
GM
1172 ;; Strip whitespace away
1173 (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
1174 result)
5960adc7 1175 (setq result (match-string-no-properties 1 result)))
c1356086 1176 result))))))
2cc0b765 1177 (error nil)))
ef15f270 1178
83afd62c 1179(defvar change-log-get-method-definition-md)
15319a8f 1180
83afd62c 1181;; Subroutine used within change-log-get-method-definition.
59c1a7de
RS
1182;; Add the last match in the buffer to the end of `md',
1183;; followed by the string END; move to the end of that match.
83afd62c
KH
1184(defun change-log-get-method-definition-1 (end)
1185 (setq change-log-get-method-definition-md
1186 (concat change-log-get-method-definition-md
5960adc7 1187 (match-string 1)
15319a8f 1188 end))
59c1a7de
RS
1189 (goto-char (match-end 0)))
1190
83afd62c 1191(defun change-log-get-method-definition ()
eba72fc1 1192"For Objective C, return the method name if we are in a method."
83afd62c 1193 (let ((change-log-get-method-definition-md "["))
59c1a7de 1194 (save-excursion
f27f16ed 1195 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
83afd62c 1196 (change-log-get-method-definition-1 " ")))
59c1a7de
RS
1197 (save-excursion
1198 (cond
f27f16ed 1199 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
83afd62c 1200 (change-log-get-method-definition-1 "")
59c1a7de
RS
1201 (while (not (looking-at "[{;]"))
1202 (looking-at
f27f16ed 1203 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
83afd62c
KH
1204 (change-log-get-method-definition-1 ""))
1205 (concat change-log-get-method-definition-md "]"))))))
075a6629
DL
1206\f
1207(defun change-log-sortable-date-at ()
1208 "Return date of log entry in a consistent form for sorting.
1209Point is assumed to be at the start of the entry."
1210 (require 'timezone)
0bde6a03 1211 (if (looking-at change-log-start-entry-re)
075a6629
DL
1212 (let ((date (match-string-no-properties 0)))
1213 (if date
1214 (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date)
1215 (concat (match-string 1 date) (match-string 2 date)
1216 (match-string 3 date))
1217 (condition-case nil
1218 (timezone-make-date-sortable date)
1219 (error nil)))))
1220 (error "Bad date")))
59c1a7de 1221
7cd017ba
SM
1222(defun change-log-resolve-conflict ()
1223 "Function to be used in `smerge-resolve-function'."
74dea9e1
SM
1224 (save-excursion
1225 (save-restriction
1226 (narrow-to-region (match-beginning 0) (match-end 0))
1227 (let ((mb1 (match-beginning 1))
1228 (me1 (match-end 1))
1229 (mb3 (match-beginning 3))
1230 (me3 (match-end 3))
1231 (tmp1 (generate-new-buffer " *changelog-resolve-1*"))
1232 (tmp2 (generate-new-buffer " *changelog-resolve-2*")))
1233 (unwind-protect
1234 (let ((buf (current-buffer)))
1235 (with-current-buffer tmp1
1236 (change-log-mode)
1237 (insert-buffer-substring buf mb1 me1))
1238 (with-current-buffer tmp2
1239 (change-log-mode)
1240 (insert-buffer-substring buf mb3 me3)
1241 ;; Do the merge here instead of inside `buf' so as to be
1242 ;; more robust in case change-log-merge fails.
1243 (change-log-merge tmp1))
1244 (goto-char (point-max))
1245 (delete-region (point-min)
1246 (prog1 (point)
1247 (insert-buffer-substring tmp2))))
1248 (kill-buffer tmp1)
1249 (kill-buffer tmp2))))))
7cd017ba 1250
075a6629
DL
1251;;;###autoload
1252(defun change-log-merge (other-log)
eba72fc1 1253 "Merge the contents of change log file OTHER-LOG with this buffer.
075a6629 1254Both must be found in Change Log mode (since the merging depends on
7cd017ba
SM
1255the appropriate motion commands). OTHER-LOG can be either a file name
1256or a buffer.
075a6629 1257
918f4ac3
DL
1258Entries are inserted in chronological order. Both the current and
1259old-style time formats for entries are supported."
075a6629 1260 (interactive "*fLog file name to merge: ")
bb042dc6 1261 (if (not (derived-mode-p 'change-log-mode))
075a6629 1262 (error "Not in Change Log mode"))
7cd017ba
SM
1263 (let ((other-buf (if (bufferp other-log) other-log
1264 (find-file-noselect other-log)))
075a6629
DL
1265 (buf (current-buffer))
1266 date1 start end)
1267 (save-excursion
1268 (goto-char (point-min))
1269 (set-buffer other-buf)
1270 (goto-char (point-min))
bb042dc6 1271 (if (not (derived-mode-p 'change-log-mode))
075a6629
DL
1272 (error "%s not found in Change Log mode" other-log))
1273 ;; Loop through all the entries in OTHER-LOG.
1274 (while (not (eobp))
1275 (setq date1 (change-log-sortable-date-at))
1276 (setq start (point)
1277 end (progn (forward-page) (point)))
1278 ;; Look for an entry in original buffer that isn't later.
1279 (with-current-buffer buf
1280 (while (and (not (eobp))
1281 (string< date1 (change-log-sortable-date-at)))
1282 (forward-page))
1283 (if (not (eobp))
1284 (insert-buffer-substring other-buf start end)
1285 ;; At the end of the original buffer, insert a newline to
1286 ;; separate entries and then the rest of the file being
7cd017ba
SM
1287 ;; merged.
1288 (unless (or (bobp)
1289 (and (= ?\n (char-before))
1290 (or (<= (1- (point)) (point-min))
1291 (= ?\n (char-before (1- (point)))))))
97f4e87c 1292 (insert (if use-hard-newlines hard-newline "\n")))
7cd017ba
SM
1293 ;; Move to the end of it to terminate outer loop.
1294 (with-current-buffer other-buf
1295 (goto-char (point-max)))
1296 (insert-buffer-substring other-buf start)))))))
ef15f270 1297
0bde6a03
DN
1298(defun change-log-beginning-of-defun ()
1299 (re-search-backward change-log-start-entry-re nil 'move))
1300
1301(defun change-log-end-of-defun ()
1302 ;; Look back and if there is no entry there it means we are before
1303 ;; the first ChangeLog entry, so go forward until finding one.
1304 (unless (save-excursion (re-search-backward change-log-start-entry-re nil t))
1305 (re-search-forward change-log-start-entry-re nil t))
1306
1307 ;; In case we are at the end of log entry going forward a line will
1308 ;; make us find the next entry when searching. If we are inside of
1309 ;; an entry going forward a line will still keep the point inside
1310 ;; the same entry.
1311 (forward-line 1)
1312
1313 ;; In case we are at the beginning of an entry, move past it.
1314 (when (looking-at change-log-start-entry-re)
1315 (goto-char (match-end 0))
1316 (forward-line 1))
1317
1318 ;; Search for the start of the next log entry. Go to the end of the
1319 ;; buffer if we could not find a next entry.
1320 (when (re-search-forward change-log-start-entry-re nil 'move)
1321 (goto-char (match-beginning 0))
1322 (forward-line -1)))
1323
1da56800
RS
1324(provide 'add-log)
1325
d1921057 1326;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762
fd7fa35a 1327;;; add-log.el ends here