(vc-mcvs-checkin): Use mapc rather than mapcar.
[bpt/emacs.git] / lisp / log-edit.el
CommitLineData
5b467bf4
SM
1;;; log-edit.el --- Major mode for editing CVS commit messages
2
c90f2757 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
d7a0267c 4;; 2005, 2006, 2007 Free Software Foundation, Inc.
5b467bf4 5
cc1eecfd 6;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
5b467bf4 7;; Keywords: pcl-cvs cvs commit log
5b467bf4
SM
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
b4aa6026 13;; the Free Software Foundation; either version 3, or (at your option)
5b467bf4
SM
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
5b467bf4
SM
25
26;;; Commentary:
27
28;; Todo:
29
5b467bf4
SM
30;; - Move in VC's code
31;; - Add compatibility for VC's hook variables
5b467bf4
SM
32
33;;; Code:
34
35(eval-when-compile (require 'cl))
36(require 'add-log) ; for all the ChangeLog goodies
37(require 'pcvs-util)
38(require 'ring)
5b467bf4 39
f1180544 40;;;;
5b467bf4 41;;;; Global Variables
f1180544 42;;;;
5b467bf4
SM
43
44(defgroup log-edit nil
bc35d341 45 "Major mode for editing RCS and CVS commit messages."
5b467bf4 46 :group 'pcl-cvs
bc35d341
DL
47 :group 'vc ; It's used by VC.
48 :version "21.1"
5b467bf4
SM
49 :prefix "log-edit-")
50
51;; compiler pacifiers
52(defvar cvs-buffer)
53
12dd83de
SM
54\f
55;; The main keymap
56
5b467bf4
SM
57(easy-mmode-defmap log-edit-mode-map
58 `(("\C-c\C-c" . log-edit-done)
59 ("\C-c\C-a" . log-edit-insert-changelog)
60 ("\C-c\C-f" . log-edit-show-files)
9fe89a26
SM
61 ("\M-n" . log-edit-next-comment)
62 ("\M-p" . log-edit-previous-comment)
63 ("\M-r" . log-edit-comment-search-backward)
64 ("\M-s" . log-edit-comment-search-forward)
0916e956 65 ("\C-c?" . log-edit-mode-help))
cdf54749 66 "Keymap for the `log-edit-mode' (to edit version control log messages)."
0916e956
SM
67 :group 'log-edit)
68
69;; Compatibility with old names. Should we bother ?
70(defvar vc-log-mode-map log-edit-mode-map)
71(defvar vc-log-entry-mode vc-log-mode-map)
5b467bf4 72
d247e32d
SM
73(easy-menu-define log-edit-menu log-edit-mode-map
74 "Menu used for `log-edit-mode'."
75 '("Log-Edit"
76 ["Done" log-edit-done
77 :help "Exit log-edit and proceed with the actual action."]
78 "--"
79 ["Insert ChangeLog" log-edit-insert-changelog]
80 ["Add to ChangeLog" log-edit-add-to-changelog]
81 "--"
82 ["List files" log-edit-show-files
83 :help "Show the list of relevant files."]
84 "--"
9fe89a26
SM
85 ["Previous comment" log-edit-previous-comment]
86 ["Next comment" log-edit-next-comment]
87 ["Search comment forward" log-edit-comment-search-forward]
88 ["Search comment backward" log-edit-comment-search-backward]))
d247e32d 89
f077c462 90(defcustom log-edit-confirm 'changed
5b467bf4
SM
91 "*If non-nil, `log-edit-done' will request confirmation.
92If 'changed, only request confirmation if the list of files has
93 changed since the beginning of the log-edit session."
94 :group 'log-edit
95 :type '(choice (const changed) (const t) (const nil)))
96
97(defcustom log-edit-keep-buffer nil
98 "*If non-nil, don't hide the buffer after `log-edit-done'."
99 :group 'log-edit
100 :type 'boolean)
101
a664185b
JB
102(defvar cvs-commit-buffer-require-final-newline t)
103(make-obsolete-variable 'cvs-commit-buffer-require-final-newline
104 'log-edit-require-final-newline)
5b467bf4
SM
105
106(defcustom log-edit-require-final-newline
107 cvs-commit-buffer-require-final-newline
108 "*Enforce a newline at the end of commit log messages.
109Enforce it silently if t, query if non-nil and don't do anything if nil."
110 :group 'log-edit
111 :type '(choice (const ask) (const t) (const nil)))
112
113(defcustom log-edit-setup-invert nil
114 "*Non-nil means `log-edit' should invert the meaning of its SETUP arg.
115If SETUP is 'force, this variable has no effect."
116 :group 'log-edit
117 :type 'boolean)
118
119(defcustom log-edit-hook '(log-edit-insert-cvs-template
120 log-edit-insert-changelog)
121 "*Hook run at the end of `log-edit'."
122 :group 'log-edit
f7eeab0d
SM
123 :type '(hook :options (log-edit-insert-changelog
124 log-edit-insert-cvs-rcstemplate
125 log-edit-insert-cvs-template
126 log-edit-insert-filenames)))
5b467bf4 127
3831af62 128(defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook)
5b467bf4
SM
129 "*Hook run when entering `log-edit-mode'."
130 :group 'log-edit
131 :type 'hook)
132
133(defcustom log-edit-done-hook nil
134 "*Hook run before doing the actual commit.
135This hook can be used to cleanup the message, enforce various
136conventions, or to allow recording the message in some other database,
137such as a bug-tracking system. The list of files about to be committed
138can be obtained from `log-edit-files'."
139 :group 'log-edit
43a9a0c4 140 :type '(hook :options (log-edit-set-common-indentation
5b467bf4
SM
141 log-edit-add-to-changelog)))
142
a664185b
JB
143(defvar cvs-changelog-full-paragraphs t)
144(make-obsolete-variable 'cvs-changelog-full-paragraphs
145 'log-edit-changelog-full-paragraphs)
14188021
SM
146
147(defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs
148 "*If non-nil, include full ChangeLog paragraphs in the log.
5b467bf4
SM
149This may be set in the ``local variables'' section of a ChangeLog, to
150indicate the policy for that ChangeLog.
151
152A ChangeLog paragraph is a bunch of log text containing no blank lines;
153a paragraph usually describes a set of changes with a single purpose,
154but perhaps spanning several functions in several files. Changes in
155different paragraphs are unrelated.
156
14188021 157You could argue that the log entry for a file should contain the
5b467bf4
SM
158full ChangeLog paragraph mentioning the change to the file, even though
159it may mention other files, because that gives you the full context you
5ab405e4 160need to understand the change. This is the behavior you get when this
5b467bf4
SM
161variable is set to t.
162
14188021 163On the other hand, you could argue that the log entry for a change
5b467bf4 164should contain only the text for the changes which occurred in that
5ab405e4 165file, because the log is per-file. This is the behavior you get
5b467bf4
SM
166when this variable is set to nil.")
167
168;;;; Internal global or buffer-local vars
169
170(defconst log-edit-files-buf "*log-edit-files*")
171(defvar log-edit-initial-files nil)
172(defvar log-edit-callback nil)
173(defvar log-edit-listfun nil)
cdf54749 174(defvar log-edit-parent-buffer nil)
5b467bf4 175
9fe89a26 176;;; Originally taken from VC-Log mode
12dd83de 177
9fe89a26 178(defconst log-edit-maximum-comment-ring-size 32
12dd83de 179 "Maximum number of saved comments in the comment ring.")
9fe89a26
SM
180(defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size))
181(defvar log-edit-comment-ring-index nil)
182(defvar log-edit-last-comment-match "")
12dd83de 183
9fe89a26 184(defun log-edit-new-comment-index (stride len)
12dd83de 185 "Return the comment index STRIDE elements from the current one.
9fe89a26 186LEN is the length of `log-edit-comment-ring'."
12dd83de 187 (mod (cond
9fe89a26 188 (log-edit-comment-ring-index (+ log-edit-comment-ring-index stride))
12dd83de
SM
189 ;; Initialize the index on the first use of this command
190 ;; so that the first M-p gets index 0, and the first M-n gets
191 ;; index -1.
192 ((> stride 0) (1- stride))
193 (t stride))
194 len))
195
9fe89a26 196(defun log-edit-previous-comment (arg)
12dd83de
SM
197 "Cycle backwards through comment history.
198With a numeric prefix ARG, go back ARG comments."
199 (interactive "*p")
9fe89a26 200 (let ((len (ring-length log-edit-comment-ring)))
12dd83de
SM
201 (if (<= len 0)
202 (progn (message "Empty comment ring") (ding))
0916e956
SM
203 ;; Don't use `erase-buffer' because we don't want to `widen'.
204 (delete-region (point-min) (point-max))
9fe89a26
SM
205 (setq log-edit-comment-ring-index (log-edit-new-comment-index arg len))
206 (message "Comment %d" (1+ log-edit-comment-ring-index))
207 (insert (ring-ref log-edit-comment-ring log-edit-comment-ring-index)))))
12dd83de 208
9fe89a26 209(defun log-edit-next-comment (arg)
12dd83de
SM
210 "Cycle forwards through comment history.
211With a numeric prefix ARG, go forward ARG comments."
212 (interactive "*p")
9fe89a26 213 (log-edit-previous-comment (- arg)))
12dd83de 214
9fe89a26 215(defun log-edit-comment-search-backward (str &optional stride)
12dd83de
SM
216 "Search backwards through comment history for substring match of STR.
217If the optional argument STRIDE is present, that is a step-width to use
218when going through the comment ring."
219 ;; Why substring rather than regexp ? -sm
220 (interactive
9fe89a26 221 (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
12dd83de
SM
222 (unless stride (setq stride 1))
223 (if (string= str "")
9fe89a26
SM
224 (setq str log-edit-last-comment-match)
225 (setq log-edit-last-comment-match str))
12dd83de 226 (let* ((str (regexp-quote str))
9fe89a26
SM
227 (len (ring-length log-edit-comment-ring))
228 (n (log-edit-new-comment-index stride len)))
12dd83de 229 (while (progn (when (or (>= n len) (< n 0)) (error "Not found"))
9fe89a26 230 (not (string-match str (ring-ref log-edit-comment-ring n))))
12dd83de 231 (setq n (+ n stride)))
9fe89a26
SM
232 (setq log-edit-comment-ring-index n)
233 (log-edit-previous-comment 0)))
12dd83de 234
9fe89a26 235(defun log-edit-comment-search-forward (str)
12dd83de
SM
236 "Search forwards through comment history for a substring match of STR."
237 (interactive
9fe89a26
SM
238 (list (read-string "Comment substring: " nil nil log-edit-last-comment-match)))
239 (log-edit-comment-search-backward str -1))
12dd83de 240
9fe89a26 241(defun log-edit-comment-to-change-log (&optional whoami file-name)
12dd83de
SM
242 "Enter last VC comment into the change log for the current file.
243WHOAMI (interactive prefix) non-nil means prompt for user name
244and site. FILE-NAME is the name of the change log; if nil, use
245`change-log-default-name'.
246
9fe89a26 247This may be useful as a `log-edit-checkin-hook' to update change logs
12dd83de
SM
248automatically."
249 (interactive (if current-prefix-arg
250 (list current-prefix-arg
251 (prompt-for-change-log-name))))
12dd83de 252 (let (;; Extract the comment first so we get any error before doing anything.
9fe89a26 253 (comment (ring-ref log-edit-comment-ring 0))
12dd83de
SM
254 ;; Don't let add-change-log-entry insert a defun name.
255 (add-log-current-defun-function 'ignore)
256 end)
257 ;; Call add-log to do half the work.
258 (add-change-log-entry whoami file-name t t)
259 ;; Insert the VC comment, leaving point before it.
260 (setq end (save-excursion (insert comment) (point-marker)))
261 (if (looking-at "\\s *\\s(")
262 ;; It starts with an open-paren, as in "(foo): Frobbed."
263 ;; So remove the ": " add-log inserted.
264 (delete-char -2))
265 ;; Canonicalize the white space between the file name and comment.
266 (just-one-space)
267 ;; Indent rest of the text the same way add-log indented the first line.
268 (let ((indentation (current-indentation)))
269 (save-excursion
270 (while (< (point) end)
271 (forward-line 1)
272 (indent-to indentation))
273 (setq end (point))))
274 ;; Fill the inserted text, preserving open-parens at bol.
0916e956 275 (let ((paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
12dd83de
SM
276 (beginning-of-line)
277 (fill-region (point) end))
278 ;; Canonicalize the white space at the end of the entry so it is
279 ;; separated from the next entry by a single blank line.
280 (skip-syntax-forward " " end)
281 (delete-char (- (skip-syntax-backward " ")))
282 (or (eobp) (looking-at "\n\n")
283 (insert "\n"))))
284
9fe89a26 285;; Compatibility with old names.
f7eeab0d
SM
286(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
287(define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1")
288(define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1")
289(define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1")
290(define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1")
291(define-obsolete-function-alias 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1")
292(define-obsolete-function-alias 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1")
9fe89a26 293
cdf54749
SM
294;;;
295;;; Actual code
296;;;
5b467bf4 297
63fbe552 298(defvar log-edit-font-lock-keywords
165a7fbe
SM
299 '(("\\`\\(Summary:\\)\\(.*\\)"
300 (1 font-lock-keyword-face)
301 (2 font-lock-function-name-face))))
302
5b467bf4 303;;;###autoload
cdf54749 304(defun log-edit (callback &optional setup listfun buffer &rest ignore)
5b467bf4 305 "Setup a buffer to enter a log message.
f077c462 306\\<log-edit-mode-map>The buffer will be put in `log-edit-mode'.
5b467bf4
SM
307If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
308Mark and point will be set around the entire contents of the
309buffer so that it is easy to kill the contents of the buffer with \\[kill-region].
310Once you're done editing the message, pressing \\[log-edit-done] will call
cdf54749
SM
311`log-edit-done' which will end up calling CALLBACK to do the actual commit.
312LISTFUN if non-nil is a function of no arguments returning the list of files
313 that are concerned by the current operation (using relative names).
314If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
315 log message and go back to the current buffer when done. Otherwise, it
316 uses the current buffer."
317 (let ((parent (current-buffer)))
318 (if buffer (pop-to-buffer buffer))
319 (when (and log-edit-setup-invert (not (eq setup 'force)))
320 (setq setup (not setup)))
321 (when setup (erase-buffer))
322 (log-edit-mode)
323 (set (make-local-variable 'log-edit-callback) callback)
324 (set (make-local-variable 'log-edit-listfun) listfun)
325 (if buffer (set (make-local-variable 'log-edit-parent-buffer) parent))
70c2a484 326 (set (make-local-variable 'log-edit-initial-files) (log-edit-files))
cdf54749
SM
327 (when setup (run-hooks 'log-edit-hook))
328 (goto-char (point-min)) (push-mark (point-max))
8a26c165 329 (message "%s" (substitute-command-keys
cdf54749 330 "Press \\[log-edit-done] when you are done editing."))))
5b467bf4
SM
331
332(define-derived-mode log-edit-mode text-mode "Log-Edit"
54877f36
SM
333 "Major mode for editing version-control log messages.
334When done editing the log entry, just type \\[log-edit-done] which
335will trigger the actual commit of the file(s).
336Several other handy support commands are provided of course and
337the package from which this is used might also provide additional
338commands (under C-x v for VC, for example).
339
1be77002 340\\{log-edit-mode-map}"
165a7fbe
SM
341 (set (make-local-variable 'font-lock-defaults)
342 '(log-edit-font-lock-keywords t))
9fe89a26 343 (make-local-variable 'log-edit-comment-ring-index))
5b467bf4
SM
344
345(defun log-edit-hide-buf (&optional buf where)
346 (when (setq buf (get-buffer (or buf log-edit-files-buf)))
347 (let ((win (get-buffer-window buf where)))
348 (if win (ignore-errors (delete-window win))))
349 (bury-buffer buf)))
350
351(defun log-edit-done ()
352 "Finish editing the log message and commit the files.
5b467bf4
SM
353If you want to abort the commit, simply delete the buffer."
354 (interactive)
ffe7dc64
SM
355 ;; Get rid of trailing empty lines
356 (goto-char (point-max))
357 (skip-syntax-backward " ")
358 (when (equal (char-after) ?\n) (forward-char 1))
359 (delete-region (point) (point-max))
360 ;; Check for final newline
cdf54749
SM
361 (if (and (> (point-max) (point-min))
362 (/= (char-before (point-max)) ?\n)
5b467bf4
SM
363 (or (eq log-edit-require-final-newline t)
364 (and log-edit-require-final-newline
365 (y-or-n-p
366 (format "Buffer %s does not end in newline. Add one? "
367 (buffer-name))))))
368 (save-excursion
369 (goto-char (point-max))
370 (insert ?\n)))
1be77002 371 (let ((comment (buffer-string)))
9fe89a26
SM
372 (when (or (ring-empty-p log-edit-comment-ring)
373 (not (equal comment (ring-ref log-edit-comment-ring 0))))
374 (ring-insert log-edit-comment-ring comment)))
5b467bf4
SM
375 (let ((win (get-buffer-window log-edit-files-buf)))
376 (if (and log-edit-confirm
377 (not (and (eq log-edit-confirm 'changed)
378 (equal (log-edit-files) log-edit-initial-files)))
379 (progn
380 (log-edit-show-files)
ce5a3ac0 381 (not (y-or-n-p "Really commit? "))))
5b467bf4
SM
382 (progn (when (not win) (log-edit-hide-buf))
383 (message "Oh, well! Later maybe?"))
384 (run-hooks 'log-edit-done-hook)
385 (log-edit-hide-buf)
cdf54749
SM
386 (unless (or log-edit-keep-buffer (not log-edit-parent-buffer))
387 (cvs-bury-buffer (current-buffer) log-edit-parent-buffer))
5b467bf4
SM
388 (call-interactively log-edit-callback))))
389
390(defun log-edit-files ()
391 "Return the list of files that are about to be committed."
392 (ignore-errors (funcall log-edit-listfun)))
393
5b467bf4
SM
394(defun log-edit-mode-help ()
395 "Provide help for the `log-edit-mode-map'."
396 (interactive)
397 (if (eq last-command 'log-edit-mode-help)
398 (describe-function major-mode)
8a26c165 399 (message "%s"
5b467bf4
SM
400 (substitute-command-keys
401 "Type `\\[log-edit-done]' to finish commit. Try `\\[describe-function] log-edit-done' for more help."))))
402
43a9a0c4
SM
403(defcustom log-edit-common-indent 0
404 "Minimum indentation to use in `log-edit-set-common-indentation'."
405 :group 'log-edit
406 :type 'integer)
407
408(defun log-edit-set-common-indentation ()
409 "(Un)Indent the current buffer rigidly to `log-edit-common-indent'."
5b467bf4
SM
410 (save-excursion
411 (let ((common (point-max)))
412 (goto-char (point-min))
413 (while (< (point) (point-max))
414 (if (not (looking-at "^[ \t]*$"))
415 (setq common (min common (current-indentation))))
416 (forward-line 1))
43a9a0c4
SM
417 (indent-rigidly (point-min) (point-max)
418 (- log-edit-common-indent common)))))
5b467bf4
SM
419
420(defun log-edit-show-files ()
421 "Show the list of files to be committed."
422 (interactive)
423 (let* ((files (log-edit-files))
cdf54749 424 (buf (get-buffer-create log-edit-files-buf)))
5b467bf4
SM
425 (with-current-buffer buf
426 (log-edit-hide-buf buf 'all)
427 (setq buffer-read-only nil)
428 (erase-buffer)
a88e99b5 429 (cvs-insert-strings files)
5b467bf4
SM
430 (setq buffer-read-only t)
431 (goto-char (point-min))
432 (save-selected-window
433 (cvs-pop-to-buffer-same-frame buf)
434 (shrink-window-if-larger-than-buffer)
435 (selected-window)))))
436
437(defun log-edit-insert-cvs-template ()
f7eeab0d
SM
438 "Insert the template specified by the CVS administrator, if any.
439This simply uses the local CVS/Template file."
5b467bf4 440 (interactive)
f7eeab0d
SM
441 (when (or (interactive-p) (= (point-min) (point-max)))
442 (when (file-readable-p "CVS/Template")
443 (insert-file-contents "CVS/Template"))))
444
445(defun log-edit-insert-cvs-rcstemplate ()
446 "Insert the rcstemplate from the CVS repository.
447This contacts the repository to get the rcstemplate file and
448can thus take some time."
449 (interactive)
450 (when (or (interactive-p) (= (point-min) (point-max)))
21227135
SM
451 (when (file-readable-p "CVS/Root")
452 ;; Ignore the stderr stuff, even if it's an error.
453 (call-process "cvs" nil '(t nil) nil
454 "checkout" "-p" "CVSROOT/rcstemplate"))))
f1180544 455
f7eeab0d
SM
456(defun log-edit-insert-filenames ()
457 "Insert the list of files that are to be committed."
458 (interactive)
459 (insert "Affected files: \n"
460 (mapconcat 'identity (log-edit-files) " \n")))
5b467bf4
SM
461
462(defun log-edit-add-to-changelog ()
463 "Insert this log message into the appropriate ChangeLog file."
464 (interactive)
465 ;; Yuck!
9fe89a26
SM
466 (unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0))
467 (ring-insert log-edit-comment-ring (buffer-string)))
5b467bf4
SM
468 (dolist (f (log-edit-files))
469 (let ((buffer-file-name (expand-file-name f)))
470 (save-excursion
9fe89a26 471 (log-edit-comment-to-change-log)))))
5b467bf4 472
f7eeab0d
SM
473(defvar log-edit-changelog-use-first nil)
474(defun log-edit-insert-changelog (&optional use-first)
475 "Insert a log message by looking at the ChangeLog.
476The idea is to write your ChangeLog entries first, and then use this
477command to commit your changes.
478
479To select default log text, we:
480- find the ChangeLog entries for the files to be checked in,
481- verify that the top entry in the ChangeLog is on the current date
482 and by the current user; if not, we don't provide any default text,
483- search the ChangeLog entry for paragraphs containing the names of
484 the files we're checking in, and finally
485- use those paragraphs as the log text.
486
487If the optional prefix arg USE-FIRST is given (via \\[universal-argument]),
488or if the command is repeated a second time in a row, use the first log entry
489regardless of user name or time."
490 (interactive "P")
491 (let ((log-edit-changelog-use-first
492 (or use-first (eq last-command 'log-edit-insert-changelog))))
493 (log-edit-insert-changelog-entries (log-edit-files)))
494 (log-edit-set-common-indentation)
495 (goto-char (point-min))
496 (when (looking-at "\\*\\s-+")
497 (forward-line 1)
498 (when (not (re-search-forward "^\\*\\s-+" nil t))
499 (goto-char (point-min))
500 (skip-chars-forward "^():")
501 (skip-chars-forward ": ")
502 (delete-region (point-min) (point)))))
503
f1180544 504;;;;
5b467bf4
SM
505;;;; functions for getting commit message from ChangeLog a file...
506;;;; Courtesy Jim Blandy
f1180544 507;;;;
5b467bf4 508
14188021 509(defun log-edit-narrow-changelog ()
5b467bf4
SM
510 "Narrow to the top page of the current buffer, a ChangeLog file.
511Actually, the narrowed region doesn't include the date line.
512A \"page\" in a ChangeLog file is the area between two dates."
513 (or (eq major-mode 'change-log-mode)
14188021 514 (error "log-edit-narrow-changelog: current buffer isn't a ChangeLog"))
5b467bf4
SM
515
516 (goto-char (point-min))
517
518 ;; Skip date line and subsequent blank lines.
519 (forward-line 1)
520 (if (looking-at "[ \t\n]*\n")
521 (goto-char (match-end 0)))
522
523 (let ((start (point)))
524 (forward-page 1)
525 (narrow-to-region start (point))
526 (goto-char (point-min))))
527
14188021 528(defun log-edit-changelog-paragraph ()
5b467bf4
SM
529 "Return the bounds of the ChangeLog paragraph containing point.
530If we are between paragraphs, return the previous paragraph."
531 (save-excursion
532 (beginning-of-line)
533 (if (looking-at "^[ \t]*$")
534 (skip-chars-backward " \t\n" (point-min)))
535 (list (progn
536 (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit)
537 (goto-char (match-end 0)))
538 (point))
539 (if (re-search-forward "^[ \t\n]*$" nil t)
540 (match-beginning 0)
3d200243 541 (point-max)))))
5b467bf4 542
14188021 543(defun log-edit-changelog-subparagraph ()
5b467bf4
SM
544 "Return the bounds of the ChangeLog subparagraph containing point.
545A subparagraph is a block of non-blank lines beginning with an asterisk.
546If we are between sub-paragraphs, return the previous subparagraph."
547 (save-excursion
548 (end-of-line)
549 (if (search-backward "*" nil t)
550 (list (progn (beginning-of-line) (point))
bc35d341 551 (progn
5b467bf4
SM
552 (forward-line 1)
553 (if (re-search-forward "^[ \t]*[\n*]" nil t)
554 (match-beginning 0)
555 (point-max))))
556 (list (point) (point)))))
557
14188021 558(defun log-edit-changelog-entry ()
5b467bf4 559 "Return the bounds of the ChangeLog entry containing point.
14188021 560The variable `log-edit-changelog-full-paragraphs' decides whether an
5b467bf4
SM
561\"entry\" is a paragraph or a subparagraph; see its documentation string
562for more details."
14188021
SM
563 (if log-edit-changelog-full-paragraphs
564 (log-edit-changelog-paragraph)
565 (log-edit-changelog-subparagraph)))
5b467bf4
SM
566
567(defvar user-full-name)
568(defvar user-mail-address)
14188021 569(defun log-edit-changelog-ours-p ()
5b467bf4 570 "See if ChangeLog entry at point is for the current user, today.
4837b516 571Return non-nil if it is."
5b467bf4
SM
572 ;; Code adapted from add-change-log-entry.
573 (let ((name (or (and (boundp 'add-log-full-name) add-log-full-name)
574 (and (fboundp 'user-full-name) (user-full-name))
575 (and (boundp 'user-full-name) user-full-name)))
576 (mail (or (and (boundp 'add-log-mailing-address) add-log-mailing-address)
577 ;;(and (fboundp 'user-mail-address) (user-mail-address))
578 (and (boundp 'user-mail-address) user-mail-address)))
579 (time (or (and (boundp 'add-log-time-format)
580 (functionp add-log-time-format)
581 (funcall add-log-time-format))
582 (format-time-string "%Y-%m-%d"))))
f7eeab0d
SM
583 (looking-at (if log-edit-changelog-use-first
584 "[^ \t]"
585 (regexp-quote (format "%s %s <%s>" time name mail))))))
5b467bf4 586
14188021 587(defun log-edit-changelog-entries (file)
5b467bf4
SM
588 "Return the ChangeLog entries for FILE, and the ChangeLog they came from.
589The return value looks like this:
590 (LOGBUFFER (ENTRYSTART . ENTRYEND) ...)
591where LOGBUFFER is the name of the ChangeLog buffer, and each
592\(ENTRYSTART . ENTRYEND\) pair is a buffer region."
d944ee49
SM
593 (let ((changelog-file-name
594 (let ((default-directory
595 (file-name-directory (expand-file-name file)))
596 (visiting-buffer (find-buffer-visiting file)))
597 ;; If there is a buffer visiting FILE, and it has a local
598 ;; value for `change-log-default-name', use that.
599 (if (and visiting-buffer
600 (local-variable-p 'change-log-default-name
601 visiting-buffer))
602 (with-current-buffer visiting-buffer
603 change-log-default-name)
604 ;; `find-change-log' uses `change-log-default-name' if set
605 ;; and sets it before exiting, so we need to work around
606 ;; that memoizing which is undesired here
607 (setq change-log-default-name nil)
608 (find-change-log)))))
609 (with-current-buffer (find-file-noselect changelog-file-name)
5b467bf4
SM
610 (unless (eq major-mode 'change-log-mode) (change-log-mode))
611 (goto-char (point-min))
612 (if (looking-at "\\s-*\n") (goto-char (match-end 0)))
14188021 613 (if (not (log-edit-changelog-ours-p))
5b467bf4
SM
614 (list (current-buffer))
615 (save-restriction
14188021 616 (log-edit-narrow-changelog)
5b467bf4 617 (goto-char (point-min))
f1180544 618
5b467bf4
SM
619 ;; Search for the name of FILE relative to the ChangeLog. If that
620 ;; doesn't occur anywhere, they're not using full relative
621 ;; filenames in the ChangeLog, so just look for FILE; we'll accept
622 ;; some false positives.
623 (let ((pattern (file-relative-name
624 file (file-name-directory changelog-file-name))))
625 (if (or (string= pattern "")
626 (not (save-excursion
627 (search-forward pattern nil t))))
628 (setq pattern (file-name-nondirectory file)))
629
b543ff57
NR
630 (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)"
631 pattern
632 "\\($\\|[^[:alnum:]]\\)"))
633
5b467bf4 634 (let (texts)
b543ff57 635 (while (re-search-forward pattern nil t)
14188021 636 (let ((entry (log-edit-changelog-entry)))
5b467bf4
SM
637 (push entry texts)
638 (goto-char (elt entry 1))))
639
640 (cons (current-buffer) texts))))))))
641
14188021 642(defun log-edit-changelog-insert-entries (buffer regions)
5b467bf4
SM
643 "Insert those regions in BUFFER specified in REGIONS.
644Sort REGIONS front-to-back first."
645 (let ((regions (sort regions 'car-less-than-car))
646 (last))
647 (dolist (region regions)
648 (when (and last (< last (car region))) (newline))
649 (setq last (elt region 1))
650 (apply 'insert-buffer-substring buffer region))))
651
14188021 652(defun log-edit-insert-changelog-entries (files)
5b467bf4
SM
653 "Given a list of files FILES, insert the ChangeLog entries for them."
654 (let ((buffer-entries nil))
655
656 ;; Add each buffer to buffer-entries, and associate it with the list
657 ;; of entries we want from that file.
658 (dolist (file files)
14188021 659 (let* ((entries (log-edit-changelog-entries file))
5b467bf4
SM
660 (pair (assq (car entries) buffer-entries)))
661 (if pair
662 (setcdr pair (cvs-union (cdr pair) (cdr entries)))
663 (push entries buffer-entries))))
664
665 ;; Now map over each buffer in buffer-entries, sort the entries for
666 ;; each buffer, and extract them as strings.
667 (dolist (buffer-entry buffer-entries)
14188021 668 (log-edit-changelog-insert-entries (car buffer-entry) (cdr buffer-entry))
5b467bf4
SM
669 (when (cdr buffer-entry) (newline)))))
670
671(provide 'log-edit)
54877f36 672
b543ff57 673;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc
5b467bf4 674;;; log-edit.el ends here