Mercurial > emacs
comparison lisp/vc/log-edit.el @ 109404:e93288477c43
Merge from mainline.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sun, 13 Jun 2010 22:57:55 +0000 |
parents | lisp/log-edit.el@da77a7326f79 lisp/log-edit.el@c3dddc8e5767 |
children |
comparison
equal
deleted
inserted
replaced
109403:681cd08dc0f7 | 109404:e93288477c43 |
---|---|
1 ;;; log-edit.el --- Major mode for editing CVS commit messages | |
2 | |
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, | |
4 ;; 2008, 2009, 2010 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | |
7 ;; Keywords: pcl-cvs cvs commit log vc | |
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 | |
13 ;; the Free Software Foundation, either version 3 of the License, or | |
14 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>. | |
23 | |
24 ;;; Commentary: | |
25 | |
26 ;; Todo: | |
27 | |
28 ;; - Move in VC's code | |
29 ;; - Add compatibility for VC's hook variables | |
30 | |
31 ;;; Code: | |
32 | |
33 (eval-when-compile (require 'cl)) | |
34 (require 'add-log) ; for all the ChangeLog goodies | |
35 (require 'pcvs-util) | |
36 (require 'ring) | |
37 | |
38 ;;;; | |
39 ;;;; Global Variables | |
40 ;;;; | |
41 | |
42 (defgroup log-edit nil | |
43 "Major mode for editing RCS and CVS commit messages." | |
44 :group 'pcl-cvs | |
45 :group 'vc ; It's used by VC. | |
46 :version "21.1" | |
47 :prefix "log-edit-") | |
48 | |
49 ;; compiler pacifiers | |
50 (defvar cvs-buffer) | |
51 | |
52 | |
53 ;; The main keymap | |
54 | |
55 (easy-mmode-defmap log-edit-mode-map | |
56 `(("\C-c\C-c" . log-edit-done) | |
57 ("\C-c\C-a" . log-edit-insert-changelog) | |
58 ("\C-c\C-d" . log-edit-show-diff) | |
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 :help "Insert a log message by looking at the ChangeLog"] | |
80 ["Add to ChangeLog" log-edit-add-to-changelog | |
81 :help "Insert this log message into the appropriate ChangeLog file"] | |
82 "--" | |
83 ["Show diff" log-edit-show-diff | |
84 :help "Show the diff for the files to be committed."] | |
85 ["List files" log-edit-show-files | |
86 :help "Show the list of relevant files."] | |
87 "--" | |
88 ["Previous comment" log-edit-previous-comment | |
89 :help "Cycle backwards through comment history"] | |
90 ["Next comment" log-edit-next-comment | |
91 :help "Cycle forwards through comment history."] | |
92 ["Search comment forward" log-edit-comment-search-forward | |
93 :help "Search forwards through comment history for a substring match of str"] | |
94 ["Search comment backward" log-edit-comment-search-backward | |
95 :help "Search backwards through comment history for substring match of str"])) | |
96 | |
97 (defcustom log-edit-confirm 'changed | |
98 "If non-nil, `log-edit-done' will request confirmation. | |
99 If 'changed, only request confirmation if the list of files has | |
100 changed since the beginning of the log-edit session." | |
101 :group 'log-edit | |
102 :type '(choice (const changed) (const t) (const nil))) | |
103 | |
104 (defcustom log-edit-keep-buffer nil | |
105 "If non-nil, don't hide the buffer after `log-edit-done'." | |
106 :group 'log-edit | |
107 :type 'boolean) | |
108 | |
109 (defvar cvs-commit-buffer-require-final-newline t) | |
110 (make-obsolete-variable 'cvs-commit-buffer-require-final-newline | |
111 'log-edit-require-final-newline | |
112 "21.1") | |
113 | |
114 (defcustom log-edit-require-final-newline | |
115 cvs-commit-buffer-require-final-newline | |
116 "Enforce a newline at the end of commit log messages. | |
117 Enforce it silently if t, query if non-nil and don't do anything if nil." | |
118 :group 'log-edit | |
119 :type '(choice (const ask) (const t) (const nil))) | |
120 | |
121 (defcustom log-edit-setup-invert nil | |
122 "Non-nil means `log-edit' should invert the meaning of its SETUP arg. | |
123 If SETUP is 'force, this variable has no effect." | |
124 :group 'log-edit | |
125 :type 'boolean) | |
126 | |
127 (defcustom log-edit-hook '(log-edit-insert-cvs-template | |
128 log-edit-show-files | |
129 log-edit-insert-changelog) | |
130 "Hook run at the end of `log-edit'." | |
131 :group 'log-edit | |
132 :type '(hook :options (log-edit-insert-changelog | |
133 log-edit-insert-cvs-rcstemplate | |
134 log-edit-insert-cvs-template | |
135 log-edit-insert-filenames))) | |
136 | |
137 (defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook) | |
138 "Hook run when entering `log-edit-mode'." | |
139 :group 'log-edit | |
140 :type 'hook) | |
141 | |
142 (defcustom log-edit-done-hook nil | |
143 "Hook run before doing the actual commit. | |
144 This hook can be used to cleanup the message, enforce various | |
145 conventions, or to allow recording the message in some other database, | |
146 such as a bug-tracking system. The list of files about to be committed | |
147 can be obtained from `log-edit-files'." | |
148 :group 'log-edit | |
149 :type '(hook :options (log-edit-set-common-indentation | |
150 log-edit-add-to-changelog))) | |
151 | |
152 (defcustom log-edit-strip-single-file-name nil | |
153 "If non-nil, remove file name from single-file log entries." | |
154 :type 'boolean | |
155 :safe 'booleanp | |
156 :group 'log-edit | |
157 :version "24.1") | |
158 | |
159 (defvar cvs-changelog-full-paragraphs t) | |
160 (make-obsolete-variable 'cvs-changelog-full-paragraphs | |
161 'log-edit-changelog-full-paragraphs | |
162 "21.1") | |
163 | |
164 (defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs | |
165 "*If non-nil, include full ChangeLog paragraphs in the log. | |
166 This may be set in the ``local variables'' section of a ChangeLog, to | |
167 indicate the policy for that ChangeLog. | |
168 | |
169 A ChangeLog paragraph is a bunch of log text containing no blank lines; | |
170 a paragraph usually describes a set of changes with a single purpose, | |
171 but perhaps spanning several functions in several files. Changes in | |
172 different paragraphs are unrelated. | |
173 | |
174 You could argue that the log entry for a file should contain the | |
175 full ChangeLog paragraph mentioning the change to the file, even though | |
176 it may mention other files, because that gives you the full context you | |
177 need to understand the change. This is the behavior you get when this | |
178 variable is set to t. | |
179 | |
180 On the other hand, you could argue that the log entry for a change | |
181 should contain only the text for the changes which occurred in that | |
182 file, because the log is per-file. This is the behavior you get | |
183 when this variable is set to nil.") | |
184 | |
185 ;;;; Internal global or buffer-local vars | |
186 | |
187 (defconst log-edit-files-buf "*log-edit-files*") | |
188 (defvar log-edit-initial-files nil) | |
189 (defvar log-edit-callback nil) | |
190 (defvar log-edit-diff-function nil) | |
191 (defvar log-edit-listfun nil) | |
192 | |
193 (defvar log-edit-parent-buffer nil) | |
194 | |
195 ;;; Originally taken from VC-Log mode | |
196 | |
197 (defconst log-edit-maximum-comment-ring-size 32 | |
198 "Maximum number of saved comments in the comment ring.") | |
199 (defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size)) | |
200 (defvar log-edit-comment-ring-index nil) | |
201 (defvar log-edit-last-comment-match "") | |
202 | |
203 (defun log-edit-new-comment-index (stride len) | |
204 "Return the comment index STRIDE elements from the current one. | |
205 LEN is the length of `log-edit-comment-ring'." | |
206 (mod (cond | |
207 (log-edit-comment-ring-index (+ log-edit-comment-ring-index stride)) | |
208 ;; Initialize the index on the first use of this command | |
209 ;; so that the first M-p gets index 0, and the first M-n gets | |
210 ;; index -1. | |
211 ((> stride 0) (1- stride)) | |
212 (t stride)) | |
213 len)) | |
214 | |
215 (defun log-edit-previous-comment (arg) | |
216 "Cycle backwards through comment history. | |
217 With a numeric prefix ARG, go back ARG comments." | |
218 (interactive "*p") | |
219 (let ((len (ring-length log-edit-comment-ring))) | |
220 (if (<= len 0) | |
221 (progn (message "Empty comment ring") (ding)) | |
222 ;; Don't use `erase-buffer' because we don't want to `widen'. | |
223 (delete-region (point-min) (point-max)) | |
224 (setq log-edit-comment-ring-index (log-edit-new-comment-index arg len)) | |
225 (message "Comment %d" (1+ log-edit-comment-ring-index)) | |
226 (insert (ring-ref log-edit-comment-ring log-edit-comment-ring-index))))) | |
227 | |
228 (defun log-edit-next-comment (arg) | |
229 "Cycle forwards through comment history. | |
230 With a numeric prefix ARG, go forward ARG comments." | |
231 (interactive "*p") | |
232 (log-edit-previous-comment (- arg))) | |
233 | |
234 (defun log-edit-comment-search-backward (str &optional stride) | |
235 "Search backwards through comment history for substring match of STR. | |
236 If the optional argument STRIDE is present, that is a step-width to use | |
237 when going through the comment ring." | |
238 ;; Why substring rather than regexp ? -sm | |
239 (interactive | |
240 (list (read-string "Comment substring: " nil nil log-edit-last-comment-match))) | |
241 (unless stride (setq stride 1)) | |
242 (if (string= str "") | |
243 (setq str log-edit-last-comment-match) | |
244 (setq log-edit-last-comment-match str)) | |
245 (let* ((str (regexp-quote str)) | |
246 (len (ring-length log-edit-comment-ring)) | |
247 (n (log-edit-new-comment-index stride len))) | |
248 (while (progn (when (or (>= n len) (< n 0)) (error "Not found")) | |
249 (not (string-match str (ring-ref log-edit-comment-ring n)))) | |
250 (setq n (+ n stride))) | |
251 (setq log-edit-comment-ring-index n) | |
252 (log-edit-previous-comment 0))) | |
253 | |
254 (defun log-edit-comment-search-forward (str) | |
255 "Search forwards through comment history for a substring match of STR." | |
256 (interactive | |
257 (list (read-string "Comment substring: " nil nil log-edit-last-comment-match))) | |
258 (log-edit-comment-search-backward str -1)) | |
259 | |
260 (defun log-edit-comment-to-change-log (&optional whoami file-name) | |
261 "Enter last VC comment into the change log for the current file. | |
262 WHOAMI (interactive prefix) non-nil means prompt for user name | |
263 and site. FILE-NAME is the name of the change log; if nil, use | |
264 `change-log-default-name'. | |
265 | |
266 This may be useful as a `log-edit-checkin-hook' to update change logs | |
267 automatically." | |
268 (interactive (if current-prefix-arg | |
269 (list current-prefix-arg | |
270 (prompt-for-change-log-name)))) | |
271 (let (;; Extract the comment first so we get any error before doing anything. | |
272 (comment (ring-ref log-edit-comment-ring 0)) | |
273 ;; Don't let add-change-log-entry insert a defun name. | |
274 (add-log-current-defun-function 'ignore) | |
275 end) | |
276 ;; Call add-log to do half the work. | |
277 (add-change-log-entry whoami file-name t t) | |
278 ;; Insert the VC comment, leaving point before it. | |
279 (setq end (save-excursion (insert comment) (point-marker))) | |
280 (if (looking-at "\\s *\\s(") | |
281 ;; It starts with an open-paren, as in "(foo): Frobbed." | |
282 ;; So remove the ": " add-log inserted. | |
283 (delete-char -2)) | |
284 ;; Canonicalize the white space between the file name and comment. | |
285 (just-one-space) | |
286 ;; Indent rest of the text the same way add-log indented the first line. | |
287 (let ((indentation (current-indentation))) | |
288 (save-excursion | |
289 (while (< (point) end) | |
290 (forward-line 1) | |
291 (indent-to indentation)) | |
292 (setq end (point)))) | |
293 ;; Fill the inserted text, preserving open-parens at bol. | |
294 (let ((paragraph-start (concat paragraph-start "\\|\\s *\\s("))) | |
295 (beginning-of-line) | |
296 (fill-region (point) end)) | |
297 ;; Canonicalize the white space at the end of the entry so it is | |
298 ;; separated from the next entry by a single blank line. | |
299 (skip-syntax-forward " " end) | |
300 (delete-char (- (skip-syntax-backward " "))) | |
301 (or (eobp) (looking-at "\n\n") | |
302 (insert "\n")))) | |
303 | |
304 ;; Compatibility with old names. | |
305 (define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1") | |
306 (define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1") | |
307 (define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1") | |
308 (define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1") | |
309 (define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1") | |
310 (define-obsolete-function-alias 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1") | |
311 (define-obsolete-function-alias 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1") | |
312 | |
313 ;;; | |
314 ;;; Actual code | |
315 ;;; | |
316 | |
317 (defface log-edit-summary '((t :inherit font-lock-function-name-face)) | |
318 "Face for the summary in `log-edit-mode' buffers.") | |
319 | |
320 (defface log-edit-header '((t :inherit font-lock-keyword-face)) | |
321 "Face for the headers in `log-edit-mode' buffers.") | |
322 | |
323 (defface log-edit-unknown-header '((t :inherit font-lock-comment-face)) | |
324 "Face for unknown headers in `log-edit-mode' buffers.") | |
325 | |
326 (defvar log-edit-headers-alist '(("Summary" . log-edit-summary) | |
327 ("Fixes") ("Author")) | |
328 "AList of known headers and the face to use to highlight them.") | |
329 | |
330 (defconst log-edit-header-contents-regexp | |
331 "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?") | |
332 | |
333 (defun log-edit-match-to-eoh (limit) | |
334 ;; FIXME: copied from message-match-to-eoh. | |
335 (let ((start (point))) | |
336 (rfc822-goto-eoh) | |
337 ;; Typical situation: some temporary change causes the header to be | |
338 ;; incorrect, so EOH comes earlier than intended: the last lines of the | |
339 ;; intended headers are now not considered part of the header any more, | |
340 ;; so they don't have the multiline property set. When the change is | |
341 ;; completed and the header has its correct shape again, the lack of the | |
342 ;; multiline property means we won't rehighlight the last lines of | |
343 ;; the header. | |
344 (if (< (point) start) | |
345 nil ;No header within start..limit. | |
346 ;; Here we disregard LIMIT so that we may extend the area again. | |
347 (set-match-data (list start (point))) | |
348 (point)))) | |
349 | |
350 (defvar log-edit-font-lock-keywords | |
351 ;; Copied/inspired by message-font-lock-keywords. | |
352 `((log-edit-match-to-eoh | |
353 (,(concat "^\\(\\([a-z]+\\):\\)" log-edit-header-contents-regexp | |
354 "\\|\\(.*\\)") | |
355 (progn (goto-char (match-beginning 0)) (match-end 0)) nil | |
356 (1 (if (assoc (match-string 2) log-edit-headers-alist) | |
357 'log-edit-header | |
358 'log-edit-unknown-header) | |
359 nil lax) | |
360 (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) | |
361 'log-edit-header) | |
362 nil lax) | |
363 (4 font-lock-warning-face))))) | |
364 | |
365 ;;;###autoload | |
366 (defun log-edit (callback &optional setup params buffer mode &rest ignore) | |
367 "Setup a buffer to enter a log message. | |
368 \\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode' | |
369 if MODE is nil. | |
370 If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. | |
371 Mark and point will be set around the entire contents of the buffer so | |
372 that it is easy to kill the contents of the buffer with \\[kill-region]. | |
373 Once you're done editing the message, pressing \\[log-edit-done] will call | |
374 `log-edit-done' which will end up calling CALLBACK to do the actual commit. | |
375 | |
376 PARAMS if non-nil is an alist. Possible keys and associated values: | |
377 `log-edit-listfun' -- function taking no arguments that returns the list of | |
378 files that are concerned by the current operation (using relative names); | |
379 `log-edit-diff-function' -- function taking no arguments that | |
380 displays a diff of the files concerned by the current operation. | |
381 | |
382 If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the | |
383 log message and go back to the current buffer when done. Otherwise, it | |
384 uses the current buffer." | |
385 (let ((parent (current-buffer))) | |
386 (if buffer (pop-to-buffer buffer)) | |
387 (when (and log-edit-setup-invert (not (eq setup 'force))) | |
388 (setq setup (not setup))) | |
389 (when setup | |
390 (erase-buffer) | |
391 (insert "Summary: ") | |
392 (save-excursion (insert "\n\n"))) | |
393 (if mode | |
394 (funcall mode) | |
395 (log-edit-mode)) | |
396 (set (make-local-variable 'log-edit-callback) callback) | |
397 (if (listp params) | |
398 (dolist (crt params) | |
399 (set (make-local-variable (car crt)) (cdr crt))) | |
400 ;; For backward compatibility with log-edit up to version 22.2 | |
401 ;; accept non-list PARAMS to mean `log-edit-list'. | |
402 (set (make-local-variable 'log-edit-listfun) params)) | |
403 | |
404 (if buffer (set (make-local-variable 'log-edit-parent-buffer) parent)) | |
405 (set (make-local-variable 'log-edit-initial-files) (log-edit-files)) | |
406 (when setup (run-hooks 'log-edit-hook)) | |
407 (goto-char (point-min)) (push-mark (point-max)) | |
408 (message "%s" (substitute-command-keys | |
409 "Press \\[log-edit-done] when you are done editing.")))) | |
410 | |
411 (define-derived-mode log-edit-mode text-mode "Log-Edit" | |
412 "Major mode for editing version-control log messages. | |
413 When done editing the log entry, just type \\[log-edit-done] which | |
414 will trigger the actual commit of the file(s). | |
415 Several other handy support commands are provided of course and | |
416 the package from which this is used might also provide additional | |
417 commands (under C-x v for VC, for example). | |
418 | |
419 \\{log-edit-mode-map}" | |
420 (set (make-local-variable 'font-lock-defaults) | |
421 '(log-edit-font-lock-keywords t t)) | |
422 (make-local-variable 'log-edit-comment-ring-index) | |
423 (hack-dir-local-variables-non-file-buffer)) | |
424 | |
425 (defun log-edit-hide-buf (&optional buf where) | |
426 (when (setq buf (get-buffer (or buf log-edit-files-buf))) | |
427 (let ((win (get-buffer-window buf where))) | |
428 (if win (ignore-errors (delete-window win)))) | |
429 (bury-buffer buf))) | |
430 | |
431 (defun log-edit-done () | |
432 "Finish editing the log message and commit the files. | |
433 If you want to abort the commit, simply delete the buffer." | |
434 (interactive) | |
435 ;; Clean up empty headers. | |
436 (goto-char (point-min)) | |
437 (while (looking-at (concat "^[a-z]*:" log-edit-header-contents-regexp)) | |
438 (let ((beg (match-beginning 0))) | |
439 (goto-char (match-end 0)) | |
440 (if (string-match "\\`[ \n\t]*\\'" (match-string 1)) | |
441 (delete-region beg (point))))) | |
442 ;; Get rid of leading empty lines. | |
443 (goto-char (point-min)) | |
444 (when (looking-at "\\([ \t]*\n\\)+") | |
445 (delete-region (match-beginning 0) (match-end 0))) | |
446 ;; Get rid of trailing empty lines | |
447 (goto-char (point-max)) | |
448 (skip-syntax-backward " ") | |
449 (when (equal (char-after) ?\n) (forward-char 1)) | |
450 (delete-region (point) (point-max)) | |
451 ;; Check for final newline | |
452 (if (and (> (point-max) (point-min)) | |
453 (/= (char-before (point-max)) ?\n) | |
454 (or (eq log-edit-require-final-newline t) | |
455 (and log-edit-require-final-newline | |
456 (y-or-n-p | |
457 (format "Buffer %s does not end in newline. Add one? " | |
458 (buffer-name)))))) | |
459 (save-excursion | |
460 (goto-char (point-max)) | |
461 (insert ?\n))) | |
462 (let ((comment (buffer-string))) | |
463 (when (or (ring-empty-p log-edit-comment-ring) | |
464 (not (equal comment (ring-ref log-edit-comment-ring 0)))) | |
465 (ring-insert log-edit-comment-ring comment))) | |
466 (let ((win (get-buffer-window log-edit-files-buf))) | |
467 (if (and log-edit-confirm | |
468 (not (and (eq log-edit-confirm 'changed) | |
469 (equal (log-edit-files) log-edit-initial-files))) | |
470 (progn | |
471 (log-edit-show-files) | |
472 (not (y-or-n-p "Really commit? ")))) | |
473 (progn (when (not win) (log-edit-hide-buf)) | |
474 (message "Oh, well! Later maybe?")) | |
475 (run-hooks 'log-edit-done-hook) | |
476 (log-edit-hide-buf) | |
477 (unless (or log-edit-keep-buffer (not log-edit-parent-buffer)) | |
478 (cvs-bury-buffer (current-buffer) log-edit-parent-buffer)) | |
479 (call-interactively log-edit-callback)))) | |
480 | |
481 (defun log-edit-files () | |
482 "Return the list of files that are about to be committed." | |
483 (ignore-errors (funcall log-edit-listfun))) | |
484 | |
485 (defun log-edit-mode-help () | |
486 "Provide help for the `log-edit-mode-map'." | |
487 (interactive) | |
488 (if (eq last-command 'log-edit-mode-help) | |
489 (describe-function major-mode) | |
490 (message "%s" | |
491 (substitute-command-keys | |
492 "Type `\\[log-edit-done]' to finish commit. Try `\\[describe-function] log-edit-done' for more help.")))) | |
493 | |
494 (defcustom log-edit-common-indent 0 | |
495 "Minimum indentation to use in `log-edit-set-common-indentation'." | |
496 :group 'log-edit | |
497 :type 'integer) | |
498 | |
499 (defun log-edit-set-common-indentation () | |
500 "(Un)Indent the current buffer rigidly to `log-edit-common-indent'." | |
501 (save-excursion | |
502 (let ((common (point-max))) | |
503 (rfc822-goto-eoh) | |
504 (while (< (point) (point-max)) | |
505 (if (not (looking-at "^[ \t]*$")) | |
506 (setq common (min common (current-indentation)))) | |
507 (forward-line 1)) | |
508 (rfc822-goto-eoh) | |
509 (indent-rigidly (point) (point-max) | |
510 (- log-edit-common-indent common))))) | |
511 | |
512 (defun log-edit-show-diff () | |
513 "Show the diff for the files to be committed." | |
514 (interactive) | |
515 (if (functionp log-edit-diff-function) | |
516 (funcall log-edit-diff-function) | |
517 (error "Diff functionality has not been setup"))) | |
518 | |
519 (defun log-edit-show-files () | |
520 "Show the list of files to be committed." | |
521 (interactive) | |
522 (let* ((files (log-edit-files)) | |
523 (buf (get-buffer-create log-edit-files-buf))) | |
524 (with-current-buffer buf | |
525 (log-edit-hide-buf buf 'all) | |
526 (setq buffer-read-only nil) | |
527 (erase-buffer) | |
528 (cvs-insert-strings files) | |
529 (setq buffer-read-only t) | |
530 (goto-char (point-min)) | |
531 (save-selected-window | |
532 (cvs-pop-to-buffer-same-frame buf) | |
533 (shrink-window-if-larger-than-buffer) | |
534 (selected-window))))) | |
535 | |
536 (defun log-edit-insert-cvs-template () | |
537 "Insert the template specified by the CVS administrator, if any. | |
538 This simply uses the local CVS/Template file." | |
539 (interactive) | |
540 (when (or (called-interactively-p 'interactive) | |
541 (= (point-min) (point-max))) | |
542 (when (file-readable-p "CVS/Template") | |
543 (insert-file-contents "CVS/Template")))) | |
544 | |
545 (defun log-edit-insert-cvs-rcstemplate () | |
546 "Insert the rcstemplate from the CVS repository. | |
547 This contacts the repository to get the rcstemplate file and | |
548 can thus take some time." | |
549 (interactive) | |
550 (when (or (called-interactively-p 'interactive) | |
551 (= (point-min) (point-max))) | |
552 (when (file-readable-p "CVS/Root") | |
553 ;; Ignore the stderr stuff, even if it's an error. | |
554 (call-process "cvs" nil '(t nil) nil | |
555 "checkout" "-p" "CVSROOT/rcstemplate")))) | |
556 | |
557 (defun log-edit-insert-filenames () | |
558 "Insert the list of files that are to be committed." | |
559 (interactive) | |
560 (insert "Affected files: \n" | |
561 (mapconcat 'identity (log-edit-files) " \n"))) | |
562 | |
563 (defun log-edit-add-to-changelog () | |
564 "Insert this log message into the appropriate ChangeLog file." | |
565 (interactive) | |
566 ;; Yuck! | |
567 (unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0)) | |
568 (ring-insert log-edit-comment-ring (buffer-string))) | |
569 (dolist (f (log-edit-files)) | |
570 (let ((buffer-file-name (expand-file-name f))) | |
571 (save-excursion | |
572 (log-edit-comment-to-change-log))))) | |
573 | |
574 (defvar log-edit-changelog-use-first nil) | |
575 (defun log-edit-insert-changelog (&optional use-first) | |
576 "Insert a log message by looking at the ChangeLog. | |
577 The idea is to write your ChangeLog entries first, and then use this | |
578 command to commit your changes. | |
579 | |
580 To select default log text, we: | |
581 - find the ChangeLog entries for the files to be checked in, | |
582 - verify that the top entry in the ChangeLog is on the current date | |
583 and by the current user; if not, we don't provide any default text, | |
584 - search the ChangeLog entry for paragraphs containing the names of | |
585 the files we're checking in, and finally | |
586 - use those paragraphs as the log text. | |
587 | |
588 If the optional prefix arg USE-FIRST is given (via \\[universal-argument]), | |
589 or if the command is repeated a second time in a row, use the first log entry | |
590 regardless of user name or time." | |
591 (interactive "P") | |
592 (let ((eoh (save-excursion (rfc822-goto-eoh) (point)))) | |
593 (when (<= (point) eoh) | |
594 (goto-char eoh) | |
595 (if (looking-at "\n") (forward-char 1)))) | |
596 (let ((log-edit-changelog-use-first | |
597 (or use-first (eq last-command 'log-edit-insert-changelog)))) | |
598 (log-edit-insert-changelog-entries (log-edit-files))) | |
599 (log-edit-set-common-indentation) | |
600 (goto-char (point-min)) | |
601 (when (and log-edit-strip-single-file-name (looking-at "\\*\\s-+")) | |
602 (forward-line 1) | |
603 (when (not (re-search-forward "^\\*\\s-+" nil t)) | |
604 (goto-char (point-min)) | |
605 (skip-chars-forward "^():") | |
606 (skip-chars-forward ": ") | |
607 (delete-region (point-min) (point))))) | |
608 | |
609 ;;;; | |
610 ;;;; functions for getting commit message from ChangeLog a file... | |
611 ;;;; Courtesy Jim Blandy | |
612 ;;;; | |
613 | |
614 (defun log-edit-narrow-changelog () | |
615 "Narrow to the top page of the current buffer, a ChangeLog file. | |
616 Actually, the narrowed region doesn't include the date line. | |
617 A \"page\" in a ChangeLog file is the area between two dates." | |
618 (or (eq major-mode 'change-log-mode) | |
619 (error "log-edit-narrow-changelog: current buffer isn't a ChangeLog")) | |
620 | |
621 (goto-char (point-min)) | |
622 | |
623 ;; Skip date line and subsequent blank lines. | |
624 (forward-line 1) | |
625 (if (looking-at "[ \t\n]*\n") | |
626 (goto-char (match-end 0))) | |
627 | |
628 (let ((start (point))) | |
629 (forward-page 1) | |
630 (narrow-to-region start (point)) | |
631 (goto-char (point-min)))) | |
632 | |
633 (defun log-edit-changelog-paragraph () | |
634 "Return the bounds of the ChangeLog paragraph containing point. | |
635 If we are between paragraphs, return the previous paragraph." | |
636 (beginning-of-line) | |
637 (if (looking-at "^[ \t]*$") | |
638 (skip-chars-backward " \t\n" (point-min))) | |
639 (list (progn | |
640 (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit) | |
641 (goto-char (match-end 0))) | |
642 (point)) | |
643 (if (re-search-forward "^[ \t\n]*$" nil t) | |
644 (match-beginning 0) | |
645 (point-max)))) | |
646 | |
647 (defun log-edit-changelog-subparagraph () | |
648 "Return the bounds of the ChangeLog subparagraph containing point. | |
649 A subparagraph is a block of non-blank lines beginning with an asterisk. | |
650 If we are between sub-paragraphs, return the previous subparagraph." | |
651 (end-of-line) | |
652 (if (search-backward "*" nil t) | |
653 (list (progn (beginning-of-line) (point)) | |
654 (progn | |
655 (forward-line 1) | |
656 (if (re-search-forward "^[ \t]*[\n*]" nil t) | |
657 (match-beginning 0) | |
658 (point-max)))) | |
659 (list (point) (point)))) | |
660 | |
661 (defun log-edit-changelog-entry () | |
662 "Return the bounds of the ChangeLog entry containing point. | |
663 The variable `log-edit-changelog-full-paragraphs' decides whether an | |
664 \"entry\" is a paragraph or a subparagraph; see its documentation string | |
665 for more details." | |
666 (save-excursion | |
667 (if log-edit-changelog-full-paragraphs | |
668 (log-edit-changelog-paragraph) | |
669 (log-edit-changelog-subparagraph)))) | |
670 | |
671 (defvar user-full-name) | |
672 (defvar user-mail-address) | |
673 (defun log-edit-changelog-ours-p () | |
674 "See if ChangeLog entry at point is for the current user, today. | |
675 Return non-nil if it is." | |
676 ;; Code adapted from add-change-log-entry. | |
677 (let ((name (or (and (boundp 'add-log-full-name) add-log-full-name) | |
678 (and (fboundp 'user-full-name) (user-full-name)) | |
679 (and (boundp 'user-full-name) user-full-name))) | |
680 (mail (or (and (boundp 'add-log-mailing-address) add-log-mailing-address) | |
681 ;;(and (fboundp 'user-mail-address) (user-mail-address)) | |
682 (and (boundp 'user-mail-address) user-mail-address))) | |
683 (time (or (and (boundp 'add-log-time-format) | |
684 (functionp add-log-time-format) | |
685 (funcall add-log-time-format)) | |
686 (format-time-string "%Y-%m-%d")))) | |
687 (looking-at (if log-edit-changelog-use-first | |
688 "[^ \t]" | |
689 (regexp-quote (format "%s %s <%s>" time name mail)))))) | |
690 | |
691 (defun log-edit-changelog-entries (file) | |
692 "Return the ChangeLog entries for FILE, and the ChangeLog they came from. | |
693 The return value looks like this: | |
694 (LOGBUFFER (ENTRYSTART ENTRYEND) ...) | |
695 where LOGBUFFER is the name of the ChangeLog buffer, and each | |
696 \(ENTRYSTART . ENTRYEND\) pair is a buffer region." | |
697 (let ((changelog-file-name | |
698 (let ((default-directory | |
699 (file-name-directory (expand-file-name file))) | |
700 (visiting-buffer (find-buffer-visiting file))) | |
701 ;; If there is a buffer visiting FILE, and it has a local | |
702 ;; value for `change-log-default-name', use that. | |
703 (if (and visiting-buffer | |
704 (local-variable-p 'change-log-default-name | |
705 visiting-buffer)) | |
706 (with-current-buffer visiting-buffer | |
707 change-log-default-name) | |
708 ;; `find-change-log' uses `change-log-default-name' if set | |
709 ;; and sets it before exiting, so we need to work around | |
710 ;; that memoizing which is undesired here | |
711 (setq change-log-default-name nil) | |
712 (find-change-log))))) | |
713 (with-current-buffer (find-file-noselect changelog-file-name) | |
714 (unless (eq major-mode 'change-log-mode) (change-log-mode)) | |
715 (goto-char (point-min)) | |
716 (if (looking-at "\\s-*\n") (goto-char (match-end 0))) | |
717 (if (not (log-edit-changelog-ours-p)) | |
718 (list (current-buffer)) | |
719 (save-restriction | |
720 (log-edit-narrow-changelog) | |
721 (goto-char (point-min)) | |
722 | |
723 ;; Search for the name of FILE relative to the ChangeLog. If that | |
724 ;; doesn't occur anywhere, they're not using full relative | |
725 ;; filenames in the ChangeLog, so just look for FILE; we'll accept | |
726 ;; some false positives. | |
727 (let ((pattern (file-relative-name | |
728 file (file-name-directory changelog-file-name)))) | |
729 (if (or (string= pattern "") | |
730 (not (save-excursion | |
731 (search-forward pattern nil t)))) | |
732 (setq pattern (file-name-nondirectory file))) | |
733 | |
734 (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)" | |
735 pattern | |
736 "\\($\\|[^[:alnum:]]\\)")) | |
737 | |
738 (let (texts | |
739 (pos (point))) | |
740 (while (and (not (eobp)) (re-search-forward pattern nil t)) | |
741 (let ((entry (log-edit-changelog-entry))) | |
742 (if (< (elt entry 1) (max (1+ pos) (point))) | |
743 ;; This is not relevant, actually. | |
744 nil | |
745 (push entry texts)) | |
746 ;; Make sure we make progress. | |
747 (setq pos (max (1+ pos) (elt entry 1))) | |
748 (goto-char pos))) | |
749 | |
750 (cons (current-buffer) texts)))))))) | |
751 | |
752 (defun log-edit-changelog-insert-entries (buffer beg end &rest files) | |
753 "Insert the text from BUFFER between BEG and END. | |
754 Rename relative filenames in the ChangeLog entry as FILES." | |
755 (let ((opoint (point)) | |
756 (log-name (buffer-file-name buffer)) | |
757 (case-fold-search nil) | |
758 bound) | |
759 (insert-buffer-substring buffer beg end) | |
760 (setq bound (point-marker)) | |
761 (when log-name | |
762 (dolist (f files) | |
763 (save-excursion | |
764 (goto-char opoint) | |
765 (when (re-search-forward | |
766 (concat "\\(^\\|[ \t]\\)\\(" | |
767 (file-relative-name f (file-name-directory log-name)) | |
768 "\\)[, :\n]") | |
769 bound t) | |
770 (replace-match f t t nil 2))))) | |
771 ;; Eliminate tabs at the beginning of the line. | |
772 (save-excursion | |
773 (goto-char opoint) | |
774 (while (re-search-forward "^\\(\t+\\)" bound t) | |
775 (replace-match ""))))) | |
776 | |
777 (defun log-edit-insert-changelog-entries (files) | |
778 "Given a list of files FILES, insert the ChangeLog entries for them." | |
779 (let ((log-entries nil)) | |
780 ;; Note that any ChangeLog entry can apply to more than one file. | |
781 ;; Here we construct a log-entries list with elements of the form | |
782 ;; ((LOGBUFFER ENTRYSTART ENTRYEND) FILE1 FILE2...) | |
783 (dolist (file files) | |
784 (let* ((entries (log-edit-changelog-entries file)) | |
785 (buf (car entries)) | |
786 key entry) | |
787 (dolist (region (cdr entries)) | |
788 (setq key (cons buf region)) | |
789 (if (setq entry (assoc key log-entries)) | |
790 (setcdr entry (append (cdr entry) (list file))) | |
791 (push (list key file) log-entries))))) | |
792 ;; Now map over log-entries, and extract the strings. | |
793 (dolist (log-entry (nreverse log-entries)) | |
794 (apply 'log-edit-changelog-insert-entries | |
795 (append (car log-entry) (cdr log-entry))) | |
796 (insert "\n")))) | |
797 | |
798 (defun log-edit-extract-headers (headers comment) | |
799 "Extract headers from COMMENT to form command line arguments. | |
800 HEADERS should be an alist with elements of the form (HEADER . CMDARG) | |
801 associating header names to the corresponding cmdline option name and the | |
802 result is then a list of the form (MSG CMDARG1 HDRTEXT1 CMDARG2 HDRTEXT2...). | |
803 where MSG is the remaining text from STRING. | |
804 If \"Summary\" is not in HEADERS, then the \"Summary\" header is extracted | |
805 anyway and put back as the first line of MSG." | |
806 (with-temp-buffer | |
807 (insert comment) | |
808 (rfc822-goto-eoh) | |
809 (narrow-to-region (point-min) (point)) | |
810 (let ((case-fold-search t) | |
811 (summary ()) | |
812 (res ())) | |
813 (dolist (header (if (assoc "Summary" headers) headers | |
814 (cons '("Summary" . t) headers))) | |
815 (goto-char (point-min)) | |
816 (while (re-search-forward (concat "^" (car header) | |
817 ":" log-edit-header-contents-regexp) | |
818 nil t) | |
819 (if (eq t (cdr header)) | |
820 (setq summary (match-string 1)) | |
821 (push (match-string 1) res) | |
822 (push (or (cdr header) (car header)) res)) | |
823 (replace-match "" t t))) | |
824 ;; Remove header separator if the header is empty. | |
825 (widen) | |
826 (goto-char (point-min)) | |
827 (when (looking-at "\\([ \t]*\n\\)+") | |
828 (delete-region (match-beginning 0) (match-end 0))) | |
829 (if summary (insert summary "\n")) | |
830 (cons (buffer-string) res)))) | |
831 | |
832 (provide 'log-edit) | |
833 | |
834 ;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc | |
835 ;;; log-edit.el ends here |