emacs.c (main): Under NS, set working dir to HOME when get a 'psn' argument.
[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
3066d4ad
SM
514(defvar change-log-mode-map
515 (let ((map (make-sparse-keymap)))
516 (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
517 (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
a28ed9e5 518 (define-key map [?\C-c ?\C-f] 'change-log-find-file)
f06b5ed2 519 (define-key map [?\C-c ?\C-c] 'change-log-goto-source)
3066d4ad 520 map)
45c50c5d 521 "Keymap for Change Log major mode.")
45c50c5d 522
d1921057
SM
523;; It used to be called change-log-time-zone-rule but really should be
524;; called add-log-time-zone-rule since it's only used from add-log-* code.
525(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule)
526(defvar add-log-time-zone-rule nil
51bd1843
EN
527 "Time zone used for calculating change log time stamps.
528It takes the same format as the TZ argument of `set-time-zone-rule'.
d1921057
SM
529If nil, use local time.
530If t, use universal time.")
d52c204b
RS
531(put 'add-log-time-zone-rule 'safe-local-variable
532 '(lambda (x) (or (booleanp x) (stringp x))))
51bd1843 533
0739a962 534(defun add-log-iso8601-time-zone (&optional time)
51bd1843
EN
535 (let* ((utc-offset (or (car (current-time-zone time)) 0))
536 (sign (if (< utc-offset 0) ?- ?+))
537 (sec (abs utc-offset))
538 (ss (% sec 60))
539 (min (/ sec 60))
540 (mm (% min 60))
541 (hh (/ min 60)))
542 (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
543 ((not (zerop mm)) "%c%02d:%02d")
544 (t "%c%02d"))
545 sign hh mm ss)))
546
d1921057
SM
547(defvar add-log-iso8601-with-time-zone nil)
548
df63ae66 549(defun add-log-iso8601-time-string ()
0739a962
SM
550 (let ((time (format-time-string "%Y-%m-%d"
551 nil (eq t add-log-time-zone-rule))))
d1921057
SM
552 (if add-log-iso8601-with-time-zone
553 (concat time " " (add-log-iso8601-time-zone))
554 time)))
df63ae66 555
84fc2cfa 556(defun change-log-name ()
075a6629 557 "Return (system-dependent) default name for a change log file."
84fc2cfa 558 (or change-log-default-name
7c2fb837 559 "ChangeLog"))
84fc2cfa 560
3066d4ad
SM
561(defun add-log-edit-prev-comment (arg)
562 "Cycle backward through Log-Edit mode comment history.
563With a numeric prefix ARG, go back ARG comments."
564 (interactive "*p")
565 (save-restriction
566 (narrow-to-region (point)
567 (if (memq last-command '(add-log-edit-prev-comment
568 add-log-edit-next-comment))
569 (mark) (point)))
570 (when (fboundp 'log-edit-previous-comment)
571 (log-edit-previous-comment arg)
572 (indent-region (point-min) (point-max))
573 (goto-char (point-min))
574 (unless (save-restriction (widen) (bolp))
575 (delete-region (point) (progn (skip-chars-forward " \t\n") (point))))
576 (set-mark (point-min))
577 (goto-char (point-max))
578 (delete-region (point) (progn (skip-chars-backward " \t\n") (point))))))
579
580(defun add-log-edit-next-comment (arg)
581 "Cycle forward through Log-Edit mode comment history.
582With a numeric prefix ARG, go back ARG comments."
583 (interactive "*p")
584 (add-log-edit-prev-comment (- arg)))
585
287d149f 586;;;###autoload
84fc2cfa
ER
587(defun prompt-for-change-log-name ()
588 "Prompt for a change log name."
117aaf60
KH
589 (let* ((default (change-log-name))
590 (name (expand-file-name
591 (read-file-name (format "Log file (default %s): " default)
592 nil default))))
593 ;; Handle something that is syntactically a directory name.
594 ;; Look for ChangeLog or whatever in that directory.
595 (if (string= (file-name-nondirectory name) "")
596 (expand-file-name (file-name-nondirectory default)
597 name)
598 ;; Handle specifying a file that is a directory.
599 (if (file-directory-p name)
600 (expand-file-name (file-name-nondirectory default)
601 (file-name-as-directory name))
602 name))))
84fc2cfa 603
776d8e16 604(defun change-log-version-number-search ()
5960adc7 605 "Return version number of current buffer's file.
ac3f4c6f 606This is the value returned by `vc-working-revision' or, if that is
5960adc7 607nil, by matching `change-log-version-number-regexp-list'."
776d8e16 608 (let* ((size (buffer-size))
fc9b0554 609 (limit
5960adc7
DL
610 ;; The version number can be anywhere in the file, but
611 ;; restrict search to the file beginning: 10% should be
612 ;; enough to prevent some mishits.
776d8e16 613 ;;
5960adc7
DL
614 ;; Apply percentage only if buffer size is bigger than
615 ;; approx 100 lines.
fc9b0554 616 (if (> size (* 100 80)) (+ (point) (/ size 10)))))
ac3f4c6f 617 (or (and buffer-file-name (vc-working-revision buffer-file-name))
5960adc7
DL
618 (save-restriction
619 (widen)
fc9b0554
SM
620 (let ((regexps change-log-version-number-regexp-list)
621 version)
5960adc7
DL
622 (while regexps
623 (save-excursion
624 (goto-char (point-min))
fc9b0554 625 (when (re-search-forward (pop regexps) limit t)
5960adc7 626 (setq version (match-string 1)
fc9b0554
SM
627 regexps nil))))
628 version)))))
776d8e16
GM
629
630
45a13f0d 631;;;###autoload
d68f7f1b 632(defun find-change-log (&optional file-name buffer-file)
45a13f0d 633 "Find a change log file for \\[add-change-log-entry] and return the name.
a82e2ed5
RS
634
635Optional arg FILE-NAME specifies the file to use.
de98fcaf 636If FILE-NAME is nil, use the value of `change-log-default-name'.
218cf475 637If `change-log-default-name' is nil, behave as though it were 'ChangeLog'
de98fcaf
RS
638\(or whatever we use on this operating system).
639
218cf475 640If `change-log-default-name' contains a leading directory component, then
513063cf 641simply find it in the current directory. Otherwise, search in the current
de98fcaf 642directory and its successive parents for a file so named.
45a13f0d
RM
643
644Once a file is found, `change-log-default-name' is set locally in the
d68f7f1b
SM
645current buffer to the complete file name.
646Optional arg BUFFER-FILE overrides `buffer-file-name'."
a82e2ed5
RS
647 ;; If user specified a file name or if this buffer knows which one to use,
648 ;; just use that.
45a13f0d 649 (or file-name
de98fcaf
RS
650 (setq file-name (and change-log-default-name
651 (file-name-directory change-log-default-name)
652 change-log-default-name))
a82e2ed5
RS
653 (progn
654 ;; Chase links in the source file
655 ;; and use the change log in the dir where it points.
d68f7f1b 656 (setq file-name (or (and (or buffer-file buffer-file-name)
a82e2ed5 657 (file-name-directory
d68f7f1b
SM
658 (file-chase-links
659 (or buffer-file buffer-file-name))))
a82e2ed5
RS
660 default-directory))
661 (if (file-directory-p file-name)
662 (setq file-name (expand-file-name (change-log-name) file-name)))
663 ;; Chase links before visiting the file.
664 ;; This makes it easier to use a single change log file
665 ;; for several related directories.
666 (setq file-name (file-chase-links file-name))
667 (setq file-name (expand-file-name file-name))
668 ;; Move up in the dir hierarchy till we find a change log file.
669 (let ((file1 file-name)
670 parent-dir)
671 (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
672 (progn (setq parent-dir
673 (file-name-directory
674 (directory-file-name
675 (file-name-directory file1))))
676 ;; Give up if we are already at the root dir.
677 (not (string= (file-name-directory file1)
678 parent-dir))))
679 ;; Move up to the parent dir and try again.
513063cf 680 (setq file1 (expand-file-name
a82e2ed5
RS
681 (file-name-nondirectory (change-log-name))
682 parent-dir)))
683 ;; If we found a change log in a parent, use that.
684 (if (or (get-file-buffer file1) (file-exists-p file1))
685 (setq file-name file1)))))
686 ;; Make a local variable in this buffer so we needn't search again.
687 (set (make-local-variable 'change-log-default-name) file-name)
688 file-name)
45a13f0d 689
2eb7ccf4
SM
690(defun add-log-file-name (buffer-file log-file)
691 ;; Never want to add a change log entry for the ChangeLog file itself.
692 (unless (or (null buffer-file) (string= buffer-file log-file))
d68f7f1b
SM
693 (if add-log-file-name-function
694 (funcall add-log-file-name-function buffer-file)
695 (setq buffer-file
e1f5b0ed 696 (file-relative-name buffer-file (file-name-directory log-file)))
d68f7f1b
SM
697 ;; If we have a backup file, it's presumably because we're
698 ;; comparing old and new versions (e.g. for deleted
699 ;; functions) and we'll want to use the original name.
700 (if (backup-file-name-p buffer-file)
701 (file-name-sans-versions buffer-file)
702 buffer-file))))
2eb7ccf4 703
84fc2cfa 704;;;###autoload
2a520399
DN
705(defun add-change-log-entry (&optional whoami file-name other-window new-entry
706 put-new-entry-on-new-line)
d882f144 707 "Find change log file, and add an entry for today and an item for this file.
83afd62c 708Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
d9ee5172 709name and email (stored in `add-log-full-name' and `add-log-mailing-address').
83afd62c 710
d882f144
RS
711Second arg FILE-NAME is file name of the change log.
712If nil, use the value of `change-log-default-name'.
713
287d149f 714Third arg OTHER-WINDOW non-nil means visit in other window.
d882f144 715
287d149f 716Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
3697b807
DL
717never append to an existing entry. Option `add-log-keep-changes-together'
718otherwise affects whether a new entry is created.
719
2a520399
DN
720Fifth arg PUT-NEW-ENTRY-ON-NEW-LINE non-nil means that if a new
721entry is created, put it on a new line by itself, do not put it
722after a comma on an existing line.
723
598f34fa
SS
724Option `add-log-always-start-new-record' non-nil means always create a
725new record, even when the last record was made on the same date and by
726the same person.
727
d882f144
RS
728The change log file can start with a copyright notice and a copying
729permission notice. The first blank line indicates the end of these
730notices.
731
d1921057 732Today's date is calculated according to `add-log-time-zone-rule' if
3697b807 733non-nil, otherwise in local time."
84fc2cfa
ER
734 (interactive (list current-prefix-arg
735 (prompt-for-change-log-name)))
d68f7f1b
SM
736 (let* ((defun (add-log-current-defun))
737 (version (and change-log-version-info-enabled
738 (change-log-version-number-search)))
8f530b95
SM
739 (buf-file-name (if add-log-buffer-file-name-function
740 (funcall add-log-buffer-file-name-function)
741 buffer-file-name))
742 (buffer-file (if buf-file-name (expand-file-name buf-file-name)))
dd816e0d 743 (file-name (expand-file-name (find-change-log file-name buffer-file)))
d882f144 744 ;; Set ITEM to the file name to use in the new item.
ad4573c7 745 (item (add-log-file-name buffer-file file-name)))
2eb7ccf4 746
7cd017ba
SM
747 (unless (equal file-name buffer-file-name)
748 (if (or other-window (window-dedicated-p (selected-window)))
749 (find-file-other-window file-name)
750 (find-file file-name)))
bb042dc6 751 (or (derived-mode-p 'change-log-mode)
675a998f 752 (change-log-mode))
84fc2cfa
ER
753 (undo-boundary)
754 (goto-char (point-min))
d882f144 755
ad4573c7
SM
756 (let ((full-name (or add-log-full-name (user-full-name)))
757 (mailing-address (or add-log-mailing-address user-mail-address)))
758
759 (when whoami
1e899515 760 (setq full-name (read-string "Full name: " full-name))
ad4573c7
SM
761 ;; Note that some sites have room and phone number fields in
762 ;; full name which look silly when inserted. Rather than do
763 ;; anything about that here, let user give prefix argument so that
764 ;; s/he can edit the full name field in prompter if s/he wants.
765 (setq mailing-address
1e899515 766 (read-string "Mailing address: " mailing-address)))
ad4573c7
SM
767
768 ;; If file starts with a copyright and permission notice, skip them.
769 ;; Assume they end at first blank line.
770 (when (looking-at "Copyright")
771 (search-forward "\n\n")
772 (skip-chars-forward "\n"))
773
774 ;; Advance into first entry if it is usable; else make new one.
775 (let ((new-entries
776 (mapcar (lambda (addr)
777 (concat
778 (if (stringp add-log-time-zone-rule)
779 (let ((tz (getenv "TZ")))
780 (unwind-protect
781 (progn
782 (set-time-zone-rule add-log-time-zone-rule)
783 (funcall add-log-time-format))
784 (set-time-zone-rule tz)))
785 (funcall add-log-time-format))
786 " " full-name
787 " <" addr ">"))
788 (if (consp mailing-address)
789 mailing-address
790 (list mailing-address)))))
791 (if (and (not add-log-always-start-new-record)
792 (let ((hit nil))
793 (dolist (entry new-entries hit)
794 (when (looking-at (regexp-quote entry))
795 (setq hit t)))))
796 (forward-line 1)
797 (insert (nth (random (length new-entries))
798 new-entries)
799 (if use-hard-newlines hard-newline "\n")
800 (if use-hard-newlines hard-newline "\n"))
801 (forward-line -1))))
82f4acaf 802
d882f144
RS
803 ;; Determine where we should stop searching for a usable
804 ;; item to add to, within this entry.
ad4573c7
SM
805 (let ((bound
806 (save-excursion
807 (if (looking-at "\n*[^\n* \t]")
808 (skip-chars-forward "\n")
809 (if add-log-keep-changes-together
810 (forward-page) ; page delimits entries for date
811 (forward-paragraph))) ; paragraph delimits entries for file
812 (point))))
813
814 ;; Now insert the new line for this item.
815 (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
816 ;; Put this file name into the existing empty item.
817 (if item
818 (insert item)))
819 ((and (not new-entry)
820 (let (case-fold-search)
821 (re-search-forward
822 (concat (regexp-quote (concat "* " item))
823 ;; Don't accept `foo.bar' when
824 ;; looking for `foo':
825 "\\(\\s \\|[(),:]\\)")
826 bound t)))
827 ;; Add to the existing item for the same file.
828 (re-search-forward "^\\s *$\\|^\\s \\*")
829 (goto-char (match-beginning 0))
830 ;; Delete excess empty lines; make just 2.
831 (while (and (not (eobp)) (looking-at "^\\s *$"))
832 (delete-region (point) (line-beginning-position 2)))
833 (insert (if use-hard-newlines hard-newline "\n")
834 (if use-hard-newlines hard-newline "\n"))
835 (forward-line -2)
836 (indent-relative-maybe))
837 (t
838 ;; Make a new item.
839 (while (looking-at "\\sW")
840 (forward-line 1))
841 (while (and (not (eobp)) (looking-at "^\\s *$"))
842 (delete-region (point) (line-beginning-position 2)))
843 (insert (if use-hard-newlines hard-newline "\n")
844 (if use-hard-newlines hard-newline "\n")
845 (if use-hard-newlines hard-newline "\n"))
846 (forward-line -2)
847 (indent-to left-margin)
848 (insert "* ")
849 (if item (insert item)))))
1832dbd1 850 ;; Now insert the function name, if we have one.
d882f144 851 ;; Point is at the item for this file,
21d7e080 852 ;; either at the end of the line or at the first blank line.
5a9ac14b
SM
853 (if (not defun)
854 ;; No function name, so put in a colon unless we have just a star.
855 (unless (save-excursion
856 (beginning-of-line 1)
857 (looking-at "\\s *\\(\\*\\s *\\)?$"))
858 (insert ": ")
7b297602 859 (if version (insert version ?\s)))
5a9ac14b
SM
860 ;; Make it easy to get rid of the function name.
861 (undo-boundary)
5960adc7
DL
862 (unless (save-excursion
863 (beginning-of-line 1)
5a9ac14b 864 (looking-at "\\s *$"))
7b297602 865 (insert ?\s))
5a9ac14b
SM
866 ;; See if the prev function name has a message yet or not.
867 ;; If not, merge the two items.
868 (let ((pos (point-marker)))
869 (skip-syntax-backward " ")
870 (skip-chars-backward "):")
2a520399
DN
871 (if (and (not put-new-entry-on-new-line)
872 (looking-at "):")
fc9b0554
SM
873 (let ((pos (save-excursion (backward-sexp 1) (point))))
874 (when (equal (buffer-substring pos (point)) defun)
875 (delete-region pos (point)))
876 (> fill-column (+ (current-column) (length defun) 4))))
877 (progn (skip-chars-backward ", ")
878 (delete-region (point) pos)
879 (unless (memq (char-before) '(?\()) (insert ", ")))
2a520399
DN
880 (when (and (not put-new-entry-on-new-line) (looking-at "):"))
881 (delete-region (+ 1 (point)) (line-end-position)))
5a9ac14b
SM
882 (goto-char pos)
883 (insert "("))
884 (set-marker pos nil))
885 (insert defun "): ")
7b297602 886 (if version (insert version ?\s)))))
84fc2cfa 887
84fc2cfa
ER
888;;;###autoload
889(defun add-change-log-entry-other-window (&optional whoami file-name)
d882f144
RS
890 "Find change log file in other window and add entry and item.
891This is just like `add-change-log-entry' except that it displays
892the change log file in another window."
84fc2cfa
ER
893 (interactive (if current-prefix-arg
894 (list current-prefix-arg
895 (prompt-for-change-log-name))))
896 (add-change-log-entry whoami file-name t))
897
6dbf6147 898
d1921057 899(defvar change-log-indent-text 0)
fc9b0554 900
6dbf6147
MR
901(defun change-log-fill-parenthesized-list ()
902 ;; Fill parenthesized lists of names according to GNU standards.
903 ;; * file-name.ext (very-long-foo, very-long-bar, very-long-foobar):
904 ;; should be filled as
905 ;; * file-name.ext (very-long-foo, very-long-bar)
906 ;; (very-long-foobar):
907 (save-excursion
908 (end-of-line 0)
909 (skip-chars-backward " \t")
910 (when (and (equal (char-before) ?\,)
911 (> (point) (1+ (point-min))))
912 (condition-case nil
913 (when (save-excursion
914 (and (prog2
915 (up-list -1)
916 (equal (char-after) ?\()
917 (skip-chars-backward " \t"))
918 (or (bolp)
919 ;; Skip everything but a whitespace or asterisk.
920 (and (not (zerop (skip-chars-backward "^ \t\n*")))
921 (skip-chars-backward " \t")
922 ;; We want one asterisk here.
923 (= (skip-chars-backward "*") -1)
924 (skip-chars-backward " \t")
925 (bolp)))))
926 ;; Delete the comma.
927 (delete-char -1)
928 ;; Close list on previous line.
929 (insert ")")
930 (skip-chars-forward " \t\n")
931 ;; Start list on new line.
932 (insert-before-markers "("))
933 (error nil)))))
934
d1921057 935(defun change-log-indent ()
6dbf6147 936 (change-log-fill-parenthesized-list)
fc9b0554
SM
937 (let* ((indent
938 (save-excursion
939 (beginning-of-line)
940 (skip-chars-forward " \t")
941 (cond
d1921057 942 ((and (looking-at "\\(.*\\) [^ \n].*[^ \n] <.*>\\(?: +(.*)\\)? *$")
fc9b0554
SM
943 ;; Matching the output of add-log-time-format is difficult,
944 ;; but I'll get it has at least two adjacent digits.
945 (string-match "[[:digit:]][[:digit:]]" (match-string 1)))
946 0)
947 ((looking-at "[^*(]")
d1921057 948 (+ (current-left-margin) change-log-indent-text))
fc9b0554
SM
949 (t (current-left-margin)))))
950 (pos (save-excursion (indent-line-to indent) (point))))
951 (if (> pos (point)) (goto-char pos))))
952
953
3066d4ad 954(defvar smerge-resolve-function)
8bb4ed88 955(defvar copyright-at-end-flag)
3066d4ad 956
1da56800 957;;;###autoload
7cd017ba 958(define-derived-mode change-log-mode text-mode "Change Log"
eb8c3be9 959 "Major mode for editing change logs; like Indented Text Mode.
09b389d0 960Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
3697b807 961New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
5516387c 962Each entry behaves as a paragraph, and the entries for one day as a page.
3066d4ad
SM
963Runs `change-log-mode-hook'.
964\\{change-log-mode-map}"
7cd017ba 965 (setq left-margin 8
4f675a8c 966 fill-column 74
60f10a06 967 indent-tabs-mode t
ccf0d2ca
JB
968 tab-width 8
969 show-trailing-whitespace t)
60f10a06
KH
970 (set (make-local-variable 'fill-paragraph-function)
971 'change-log-fill-paragraph)
3ee9a09c
MR
972 ;; Avoid that filling leaves behind a single "*" on a line.
973 (add-hook 'fill-nobreak-predicate
974 '(lambda ()
8bb4ed88 975 (looking-back "^\\s *\\*\\s *" (line-beginning-position)))
3ee9a09c 976 nil t)
d1921057 977 (set (make-local-variable 'indent-line-function) 'change-log-indent)
fc9b0554 978 (set (make-local-variable 'tab-always-indent) nil)
8bb4ed88 979 (set (make-local-variable 'copyright-at-end-flag) t)
4b7d4d0d
DL
980 ;; We really do want "^" in paragraph-start below: it is only the
981 ;; lines that begin at column 0 (despite the left-margin of 8) that
982 ;; we are looking for. Adding `* ' allows eliding the blank line
983 ;; between entries for different files.
c9cfb0f2 984 (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
4b7d4d0d 985 (set (make-local-variable 'paragraph-separate) paragraph-start)
2c91c85c
RS
986 ;; Match null string on the date-line so that the date-line
987 ;; is grouped with what follows.
964141f2 988 (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
dd309224 989 (set (make-local-variable 'version-control) 'never)
7cd017ba
SM
990 (set (make-local-variable 'smerge-resolve-function)
991 'change-log-resolve-conflict)
dd309224 992 (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
4b286eca 993 (set (make-local-variable 'font-lock-defaults)
73b27641 994 '(change-log-font-lock-keywords t nil nil backward-paragraph))
e50fa43e 995 (set (make-local-variable 'multi-isearch-next-buffer-function)
73b27641 996 'change-log-next-buffer)
0bde6a03
DN
997 (set (make-local-variable 'beginning-of-defun-function)
998 'change-log-beginning-of-defun)
999 (set (make-local-variable 'end-of-defun-function)
e50fa43e 1000 'change-log-end-of-defun))
73b27641
JL
1001
1002(defun change-log-next-buffer (&optional buffer wrap)
1003 "Return the next buffer in the series of ChangeLog file buffers.
1004This function is used for multiple buffers isearch.
1005A sequence of buffers is formed by ChangeLog files with decreasing
1006numeric file name suffixes in the directory of the initial ChangeLog
1007file were isearch was started."
1008 (let* ((name (change-log-name))
1009 (files (cons name (sort (file-expand-wildcards
1010 (concat name "[-.][0-9]*"))
1011 (lambda (a b)
bac2f6bc
SM
1012 ;; The file's extension may not have a valid
1013 ;; version form (e.g. VC backup revisions).
1014 (ignore-errors
1015 (version< (substring b (length name))
1016 (substring a (length name))))))))
73b27641
JL
1017 (files (if isearch-forward files (reverse files))))
1018 (find-file-noselect
1019 (if wrap
1020 (car files)
1021 (cadr (member (file-name-nondirectory (buffer-file-name buffer))
1022 files))))))
21d7e080 1023
287d149f
RM
1024;; It might be nice to have a general feature to replace this. The idea I
1025;; have is a variable giving a regexp matching text which should not be
1026;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(".
1027;; But I don't feel up to implementing that today.
1028(defun change-log-fill-paragraph (&optional justify)
1029 "Fill the paragraph, but preserve open parentheses at beginning of lines.
1030Prefix arg means justify as well."
1031 (interactive "P")
8d6467a4
RS
1032 (let ((end (progn (forward-paragraph) (point)))
1033 (beg (progn (backward-paragraph) (point)))
6dbf6147
MR
1034 ;; Add lines starting with whitespace followed by a left paren or an
1035 ;; asterisk.
1036 (paragraph-start (concat paragraph-start "\\|\\s *\\(?:\\s(\\|\\*\\)"))
1037 ;; Make sure we call `change-log-indent'.
1038 (fill-indent-according-to-mode t))
8d6467a4
RS
1039 (fill-region beg end justify)
1040 t))
287d149f 1041\f
fcad5199 1042(defcustom add-log-current-defun-header-regexp
a8d693d8 1043 "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]"
d1921057 1044 "Heuristic regexp used by `add-log-current-defun' for unknown major modes."
fcad5199
RS
1045 :type 'regexp
1046 :group 'change-log)
21d7e080 1047
fb644f48
EN
1048;;;###autoload
1049(defvar add-log-lisp-like-modes
d1921057 1050 '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode)
fb644f48
EN
1051 "*Modes that look like Lisp to `add-log-current-defun'.")
1052
1053;;;###autoload
1054(defvar add-log-c-like-modes
d1921057 1055 '(c-mode c++-mode c++-c-mode objc-mode)
fb644f48
EN
1056 "*Modes that look like C to `add-log-current-defun'.")
1057
1058;;;###autoload
1059(defvar add-log-tex-like-modes
bb042dc6 1060 '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode)
fb644f48
EN
1061 "*Modes that look like TeX to `add-log-current-defun'.")
1062
ab319633
GM
1063(declare-function c-cpp-define-name "cc-cmds" ())
1064(declare-function c-defun-name "cc-cmds" ())
004a00f4 1065
e332f80b 1066;;;###autoload
21d7e080
ER
1067(defun add-log-current-defun ()
1068 "Return name of function definition point is in, or nil.
1069
63314951 1070Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
5960adc7 1071Texinfo (@node titles) and Perl.
21d7e080
ER
1072
1073Other modes are handled by a heuristic that looks in the 10K before
1074point for uppercase headings starting in the first column or
5960adc7 1075identifiers followed by `:' or `='. See variables
c1356086 1076`add-log-current-defun-header-regexp' and
5ef08021 1077`add-log-current-defun-function'.
21d7e080
ER
1078
1079Has a preference of looking backwards."
2cc0b765
RS
1080 (condition-case nil
1081 (save-excursion
1082 (let ((location (point)))
5960adc7
DL
1083 (cond (add-log-current-defun-function
1084 (funcall add-log-current-defun-function))
bb042dc6 1085 ((apply 'derived-mode-p add-log-lisp-like-modes)
a0151877 1086 ;; If we are now precisely at the beginning of a defun,
2cc0b765
RS
1087 ;; make sure beginning-of-defun finds that one
1088 ;; rather than the previous one.
1089 (or (eobp) (forward-char 1))
1090 (beginning-of-defun)
5960adc7
DL
1091 ;; Make sure we are really inside the defun found,
1092 ;; not after it.
42b1fc29
RS
1093 (when (and (looking-at "\\s(")
1094 (progn (end-of-defun)
1095 (< location (point)))
1096 (progn (forward-sexp -1)
1097 (>= location (point))))
1098 (if (looking-at "\\s(")
1099 (forward-char 1))
1100 ;; Skip the defining construct name, typically "defun"
1101 ;; or "defvar".
1102 (forward-sexp 1)
1103 ;; The second element is usually a symbol being defined.
1104 ;; If it is not, use the first symbol in it.
63c7727f 1105 (skip-chars-forward " \t\n'(")
5960adc7
DL
1106 (buffer-substring-no-properties (point)
1107 (progn (forward-sexp 1)
1108 (point)))))
bb042dc6 1109 ((apply 'derived-mode-p add-log-c-like-modes)
221fcdaa
AM
1110 (or (c-cpp-define-name)
1111 (c-defun-name)))
1112 ((memq major-mode add-log-tex-like-modes)
2cc0b765 1113 (if (re-search-backward
5960adc7
DL
1114 "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)"
1115 nil t)
2cc0b765
RS
1116 (progn
1117 (goto-char (match-beginning 0))
5960adc7
DL
1118 (buffer-substring-no-properties
1119 (1+ (point)) ; without initial backslash
1120 (line-end-position)))))
bb042dc6 1121 ((derived-mode-p 'texinfo-mode)
3071ee28 1122 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
5960adc7 1123 (match-string-no-properties 1)))
fb1b68a4 1124 ((derived-mode-p 'perl-mode 'cperl-mode)
5a9ac14b 1125 (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
5960adc7
DL
1126 (match-string-no-properties 1)))
1127 ;; Emacs's autoconf-mode installs its own
1128 ;; `add-log-current-defun-function'. This applies to
1129 ;; a different mode apparently for editing .m4
1130 ;; autoconf source.
bb042dc6 1131 ((derived-mode-p 'autoconf-mode)
5960adc7
DL
1132 (if (re-search-backward
1133 "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t)
1134 (match-string-no-properties 3)))
2cc0b765
RS
1135 (t
1136 ;; If all else fails, try heuristics
c1356086
GM
1137 (let (case-fold-search
1138 result)
2cc0b765 1139 (end-of-line)
c1356086
GM
1140 (when (re-search-backward
1141 add-log-current-defun-header-regexp
1142 (- (point) 10000)
1143 t)
5960adc7
DL
1144 (setq result (or (match-string-no-properties 1)
1145 (match-string-no-properties 0)))
c1356086
GM
1146 ;; Strip whitespace away
1147 (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)"
1148 result)
5960adc7 1149 (setq result (match-string-no-properties 1 result)))
c1356086 1150 result))))))
2cc0b765 1151 (error nil)))
ef15f270 1152
83afd62c 1153(defvar change-log-get-method-definition-md)
15319a8f 1154
83afd62c 1155;; Subroutine used within change-log-get-method-definition.
59c1a7de
RS
1156;; Add the last match in the buffer to the end of `md',
1157;; followed by the string END; move to the end of that match.
83afd62c
KH
1158(defun change-log-get-method-definition-1 (end)
1159 (setq change-log-get-method-definition-md
1160 (concat change-log-get-method-definition-md
5960adc7 1161 (match-string 1)
15319a8f 1162 end))
59c1a7de
RS
1163 (goto-char (match-end 0)))
1164
83afd62c 1165(defun change-log-get-method-definition ()
eba72fc1 1166"For Objective C, return the method name if we are in a method."
83afd62c 1167 (let ((change-log-get-method-definition-md "["))
59c1a7de 1168 (save-excursion
f27f16ed 1169 (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
83afd62c 1170 (change-log-get-method-definition-1 " ")))
59c1a7de
RS
1171 (save-excursion
1172 (cond
f27f16ed 1173 ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
83afd62c 1174 (change-log-get-method-definition-1 "")
59c1a7de
RS
1175 (while (not (looking-at "[{;]"))
1176 (looking-at
f27f16ed 1177 "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
83afd62c
KH
1178 (change-log-get-method-definition-1 ""))
1179 (concat change-log-get-method-definition-md "]"))))))
075a6629
DL
1180\f
1181(defun change-log-sortable-date-at ()
1182 "Return date of log entry in a consistent form for sorting.
1183Point is assumed to be at the start of the entry."
1184 (require 'timezone)
0bde6a03 1185 (if (looking-at change-log-start-entry-re)
075a6629
DL
1186 (let ((date (match-string-no-properties 0)))
1187 (if date
1188 (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date)
1189 (concat (match-string 1 date) (match-string 2 date)
1190 (match-string 3 date))
1191 (condition-case nil
1192 (timezone-make-date-sortable date)
1193 (error nil)))))
1194 (error "Bad date")))
59c1a7de 1195
7cd017ba
SM
1196(defun change-log-resolve-conflict ()
1197 "Function to be used in `smerge-resolve-function'."
74dea9e1
SM
1198 (save-excursion
1199 (save-restriction
1200 (narrow-to-region (match-beginning 0) (match-end 0))
1201 (let ((mb1 (match-beginning 1))
1202 (me1 (match-end 1))
1203 (mb3 (match-beginning 3))
1204 (me3 (match-end 3))
1205 (tmp1 (generate-new-buffer " *changelog-resolve-1*"))
1206 (tmp2 (generate-new-buffer " *changelog-resolve-2*")))
1207 (unwind-protect
1208 (let ((buf (current-buffer)))
1209 (with-current-buffer tmp1
1210 (change-log-mode)
1211 (insert-buffer-substring buf mb1 me1))
1212 (with-current-buffer tmp2
1213 (change-log-mode)
1214 (insert-buffer-substring buf mb3 me3)
1215 ;; Do the merge here instead of inside `buf' so as to be
1216 ;; more robust in case change-log-merge fails.
1217 (change-log-merge tmp1))
1218 (goto-char (point-max))
1219 (delete-region (point-min)
1220 (prog1 (point)
1221 (insert-buffer-substring tmp2))))
1222 (kill-buffer tmp1)
1223 (kill-buffer tmp2))))))
7cd017ba 1224
075a6629
DL
1225;;;###autoload
1226(defun change-log-merge (other-log)
eba72fc1 1227 "Merge the contents of change log file OTHER-LOG with this buffer.
075a6629 1228Both must be found in Change Log mode (since the merging depends on
7cd017ba
SM
1229the appropriate motion commands). OTHER-LOG can be either a file name
1230or a buffer.
075a6629 1231
918f4ac3
DL
1232Entries are inserted in chronological order. Both the current and
1233old-style time formats for entries are supported."
075a6629 1234 (interactive "*fLog file name to merge: ")
bb042dc6 1235 (if (not (derived-mode-p 'change-log-mode))
075a6629 1236 (error "Not in Change Log mode"))
7cd017ba
SM
1237 (let ((other-buf (if (bufferp other-log) other-log
1238 (find-file-noselect other-log)))
075a6629
DL
1239 (buf (current-buffer))
1240 date1 start end)
1241 (save-excursion
1242 (goto-char (point-min))
1243 (set-buffer other-buf)
1244 (goto-char (point-min))
bb042dc6 1245 (if (not (derived-mode-p 'change-log-mode))
075a6629
DL
1246 (error "%s not found in Change Log mode" other-log))
1247 ;; Loop through all the entries in OTHER-LOG.
1248 (while (not (eobp))
1249 (setq date1 (change-log-sortable-date-at))
1250 (setq start (point)
1251 end (progn (forward-page) (point)))
1252 ;; Look for an entry in original buffer that isn't later.
1253 (with-current-buffer buf
1254 (while (and (not (eobp))
1255 (string< date1 (change-log-sortable-date-at)))
1256 (forward-page))
1257 (if (not (eobp))
1258 (insert-buffer-substring other-buf start end)
1259 ;; At the end of the original buffer, insert a newline to
1260 ;; separate entries and then the rest of the file being
7cd017ba
SM
1261 ;; merged.
1262 (unless (or (bobp)
1263 (and (= ?\n (char-before))
1264 (or (<= (1- (point)) (point-min))
1265 (= ?\n (char-before (1- (point)))))))
97f4e87c 1266 (insert (if use-hard-newlines hard-newline "\n")))
7cd017ba
SM
1267 ;; Move to the end of it to terminate outer loop.
1268 (with-current-buffer other-buf
1269 (goto-char (point-max)))
1270 (insert-buffer-substring other-buf start)))))))
ef15f270 1271
0bde6a03
DN
1272(defun change-log-beginning-of-defun ()
1273 (re-search-backward change-log-start-entry-re nil 'move))
1274
1275(defun change-log-end-of-defun ()
1276 ;; Look back and if there is no entry there it means we are before
1277 ;; the first ChangeLog entry, so go forward until finding one.
1278 (unless (save-excursion (re-search-backward change-log-start-entry-re nil t))
1279 (re-search-forward change-log-start-entry-re nil t))
1280
1281 ;; In case we are at the end of log entry going forward a line will
1282 ;; make us find the next entry when searching. If we are inside of
1283 ;; an entry going forward a line will still keep the point inside
1284 ;; the same entry.
1285 (forward-line 1)
1286
1287 ;; In case we are at the beginning of an entry, move past it.
1288 (when (looking-at change-log-start-entry-re)
1289 (goto-char (match-end 0))
1290 (forward-line 1))
1291
1292 ;; Search for the start of the next log entry. Go to the end of the
1293 ;; buffer if we could not find a next entry.
1294 (when (re-search-forward change-log-start-entry-re nil 'move)
1295 (goto-char (match-beginning 0))
1296 (forward-line -1)))
1297
1da56800
RS
1298(provide 'add-log)
1299
d1921057 1300;; arch-tag: 81eee6fc-088f-4372-a37f-80ad9620e762
fd7fa35a 1301;;; add-log.el ends here