1 |
;;; log-edit.el --- Major mode for editing CVS commit messages |
;;; log-edit.el --- Major mode for editing CVS commit messages |
2 |
|
|
3 |
;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1999,2000,2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Stefan Monnier <monnier@cs.yale.edu> |
;; Author: Stefan Monnier <monnier@cs.yale.edu> |
6 |
;; Keywords: pcl-cvs cvs commit log |
;; Keywords: pcl-cvs cvs commit log |
|
;; Revision: $Id$ |
|
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
35 |
(require 'add-log) ; for all the ChangeLog goodies |
(require 'add-log) ; for all the ChangeLog goodies |
36 |
(require 'pcvs-util) |
(require 'pcvs-util) |
37 |
(require 'ring) |
(require 'ring) |
|
(require 'vc) |
|
38 |
|
|
39 |
;;;; |
;;;; |
40 |
;;;; Global Variables |
;;;; Global Variables |
50 |
;; compiler pacifiers |
;; compiler pacifiers |
51 |
(defvar cvs-buffer) |
(defvar cvs-buffer) |
52 |
|
|
53 |
|
|
54 |
|
;; The main keymap |
55 |
|
|
56 |
(easy-mmode-defmap log-edit-mode-map |
(easy-mmode-defmap log-edit-mode-map |
57 |
`(("\C-c\C-c" . log-edit-done) |
`(("\C-c\C-c" . log-edit-done) |
58 |
("\C-c\C-a" . log-edit-insert-changelog) |
("\C-c\C-a" . log-edit-insert-changelog) |
59 |
("\C-c\C-f" . log-edit-show-files) |
("\C-c\C-f" . log-edit-show-files) |
60 |
("\C-c?" . log-edit-mode-help)) |
("\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)." |
"Keymap for the `log-edit-mode' (to edit version control log messages)." |
66 |
:group 'log-edit |
:group 'log-edit) |
67 |
:inherit (if (boundp 'vc-log-entry-mode) vc-log-entry-mode |
|
68 |
(if (boundp 'vc-log-mode-map) vc-log-mode-map))) |
;; 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 |
(easy-menu-define log-edit-menu log-edit-mode-map |
73 |
"Menu used for `log-edit-mode'." |
"Menu used for `log-edit-mode'." |
81 |
["List files" log-edit-show-files |
["List files" log-edit-show-files |
82 |
:help "Show the list of relevant files."] |
:help "Show the list of relevant files."] |
83 |
"--" |
"--" |
84 |
["Previous comment" vc-previous-comment] |
["Previous comment" log-edit-previous-comment] |
85 |
["Next comment" vc-next-comment] |
["Next comment" log-edit-next-comment] |
86 |
["Search comment forward" vc-comment-search-forward] |
["Search comment forward" log-edit-comment-search-forward] |
87 |
["Search comment backward" vc-comment-search-reverse])) |
["Search comment backward" log-edit-comment-search-backward])) |
88 |
|
|
89 |
(defcustom log-edit-confirm 'changed |
(defcustom log-edit-confirm 'changed |
90 |
"*If non-nil, `log-edit-done' will request confirmation. |
"*If non-nil, `log-edit-done' will request confirmation. |
170 |
(defvar log-edit-listfun nil) |
(defvar log-edit-listfun nil) |
171 |
(defvar log-edit-parent-buffer nil) |
(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.5") |
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.5") |
287 |
|
(defalias 'vc-previous-comment 'log-edit-previous-comment) |
288 |
|
(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.5") |
289 |
|
(defalias 'vc-next-comment 'log-edit-next-comment) |
290 |
|
(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.5") |
291 |
|
(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward) |
292 |
|
(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.5") |
293 |
|
(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward) |
294 |
|
(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.5") |
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.5") |
297 |
|
|
298 |
;;; |
;;; |
299 |
;;; Actual code |
;;; Actual code |
300 |
;;; |
;;; |
337 |
commands (under C-x v for VC, for example). |
commands (under C-x v for VC, for example). |
338 |
|
|
339 |
\\{log-edit-mode-map}" |
\\{log-edit-mode-map}" |
340 |
(make-local-variable 'vc-comment-ring-index)) |
(make-local-variable 'log-edit-comment-ring-index)) |
341 |
|
|
342 |
(defun log-edit-hide-buf (&optional buf where) |
(defun log-edit-hide-buf (&optional buf where) |
343 |
(when (setq buf (get-buffer (or buf log-edit-files-buf))) |
(when (setq buf (get-buffer (or buf log-edit-files-buf))) |
366 |
(goto-char (point-max)) |
(goto-char (point-max)) |
367 |
(insert ?\n))) |
(insert ?\n))) |
368 |
(let ((comment (buffer-string))) |
(let ((comment (buffer-string))) |
369 |
(when (or (ring-empty-p vc-comment-ring) |
(when (or (ring-empty-p log-edit-comment-ring) |
370 |
(not (equal comment (ring-ref vc-comment-ring 0)))) |
(not (equal comment (ring-ref log-edit-comment-ring 0)))) |
371 |
(ring-insert vc-comment-ring comment))) |
(ring-insert log-edit-comment-ring comment))) |
372 |
(let ((win (get-buffer-window log-edit-files-buf))) |
(let ((win (get-buffer-window log-edit-files-buf))) |
373 |
(if (and log-edit-confirm |
(if (and log-edit-confirm |
374 |
(not (and (eq log-edit-confirm 'changed) |
(not (and (eq log-edit-confirm 'changed) |
443 |
"Show the list of files to be committed." |
"Show the list of files to be committed." |
444 |
(interactive) |
(interactive) |
445 |
(let* ((files (log-edit-files)) |
(let* ((files (log-edit-files)) |
|
(editbuf (current-buffer)) |
|
446 |
(buf (get-buffer-create log-edit-files-buf))) |
(buf (get-buffer-create log-edit-files-buf))) |
447 |
(with-current-buffer buf |
(with-current-buffer buf |
448 |
(log-edit-hide-buf buf 'all) |
(log-edit-hide-buf buf 'all) |
467 |
"Insert this log message into the appropriate ChangeLog file." |
"Insert this log message into the appropriate ChangeLog file." |
468 |
(interactive) |
(interactive) |
469 |
;; Yuck! |
;; Yuck! |
470 |
(unless (string= (buffer-string) (ring-ref vc-comment-ring 0)) |
(unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0)) |
471 |
(ring-insert vc-comment-ring (buffer-string))) |
(ring-insert log-edit-comment-ring (buffer-string))) |
472 |
(dolist (f (log-edit-files)) |
(dolist (f (log-edit-files)) |
473 |
(let ((buffer-file-name (expand-file-name f))) |
(let ((buffer-file-name (expand-file-name f))) |
474 |
(save-excursion |
(save-excursion |
475 |
(vc-comment-to-change-log))))) |
(log-edit-comment-to-change-log))))) |
476 |
|
|
477 |
;;;; |
;;;; |
478 |
;;;; functions for getting commit message from ChangeLog a file... |
;;;; functions for getting commit message from ChangeLog a file... |
564 |
(save-excursion |
(save-excursion |
565 |
(let ((changelog-file-name |
(let ((changelog-file-name |
566 |
(let ((default-directory |
(let ((default-directory |
567 |
(file-name-directory (expand-file-name file)))) |
(file-name-directory (expand-file-name file))) |
568 |
;; `find-change-log' uses `change-log-default-name' if set |
(visiting-buffer (find-buffer-visiting file))) |
569 |
;; and sets it before exiting, so we need to work around |
;; If there is a buffer visiting FILE, and it has a local |
570 |
;; that memoizing which is undesired here |
;; value for `change-log-default-name', use that. |
571 |
(setq change-log-default-name nil) |
(if (and visiting-buffer |
572 |
(find-change-log)))) |
(local-variable-p 'change-log-default-name |
573 |
|
visiting-buffer)) |
574 |
|
(save-excursion |
575 |
|
(set-buffer visiting-buffer) |
576 |
|
change-log-default-name) |
577 |
|
;; `find-change-log' uses `change-log-default-name' if set |
578 |
|
;; and sets it before exiting, so we need to work around |
579 |
|
;; that memoizing which is undesired here |
580 |
|
(setq change-log-default-name nil) |
581 |
|
(find-change-log))))) |
582 |
(set-buffer (find-file-noselect changelog-file-name)) |
(set-buffer (find-file-noselect changelog-file-name)) |
583 |
(unless (eq major-mode 'change-log-mode) (change-log-mode)) |
(unless (eq major-mode 'change-log-mode) (change-log-mode)) |
584 |
(goto-char (point-min)) |
(goto-char (point-min)) |
639 |
|
|
640 |
(provide 'log-edit) |
(provide 'log-edit) |
641 |
|
|
642 |
|
;;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc |
643 |
;;; log-edit.el ends here |
;;; log-edit.el ends here |