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