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