/[emacs]/emacs/lisp/log-edit.el
ViewVC logotype

Diff of /emacs/lisp/log-edit.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17.4.1 by miles, Fri Apr 4 06:20:09 2003 UTC revision 1.17.4.2 by miles, Tue Oct 14 23:51:16 2003 UTC
# Line 1  Line 1 
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    
# Line 36  Line 35 
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
# Line 52  Line 50 
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'."
# Line 74  Line 81 
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.
# Line 163  when this variable is set to nil.") Line 170  when this variable is set to nil.")
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  ;;;  ;;;
# Line 205  the package from which this is used migh Line 337  the package from which this is used migh
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)))
# Line 234  If you want to abort the commit, simply Line 366  If you want to abort the commit, simply
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)
# Line 311  To select default log text, we: Line 443  To select default log text, we:
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)
# Line 336  To select default log text, we: Line 467  To select default log text, we:
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...
# Line 433  where LOGBUFFER is the name of the Chang Line 564  where LOGBUFFER is the name of the Chang
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))
# Line 499  Sort REGIONS front-to-back first." Line 639  Sort REGIONS front-to-back first."
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

Legend:
Removed from v.1.17.4.1  
changed lines
  Added in v.1.17.4.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26