code.delx.au - gnu-emacs/blob - lisp/log-edit.el

   1 ;;; log-edit.el --- Major mode for editing CVS commit messages
   2
   3 ;; Copyright (C) 1999, 2000  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: pcl-cvs cvs commit log
   7 ;; Revision: $Id: log-edit.el,v 1.18 2003/02/04 11:34:12 lektu Exp $
   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 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Todo:
  29
  30 ;; - Move in VC's code
  31 ;; - Add compatibility for VC's hook variables
  32
  33 ;;; Code:
  34
  35 (eval-when-compile (require 'cl))
  36 (require 'add-log)                      ; for all the ChangeLog goodies
  37 (require 'pcvs-util)
  38 (require 'ring)
  39 (require 'vc)
  40
  41 ;;;;
  42 ;;;; Global Variables
  43 ;;;;
  44
  45 (defgroup log-edit nil
  46   "Major mode for editing RCS and CVS commit messages."
  47   :group 'pcl-cvs
  48   :group 'vc                            ; It's used by VC.
  49   :version "21.1"
  50   :prefix "log-edit-")
  51
  52 ;; compiler pacifiers
  53 (defvar cvs-buffer)
  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-f" . log-edit-show-files)
  59     ("\C-c?" . log-edit-mode-help))
  60   "Keymap for the `log-edit-mode' (to edit version control log messages)."
  61   :group 'log-edit
  62   :inherit (if (boundp 'vc-log-entry-mode) vc-log-entry-mode
  63              (if (boundp 'vc-log-mode-map) vc-log-mode-map)))
  64
  65 (easy-menu-define log-edit-menu log-edit-mode-map
  66   "Menu used for `log-edit-mode'."
  67   '("Log-Edit"
  68     ["Done" log-edit-done
  69      :help "Exit log-edit and proceed with the actual action."]
  70     "--"
  71     ["Insert ChangeLog" log-edit-insert-changelog]
  72     ["Add to ChangeLog" log-edit-add-to-changelog]
  73     "--"
  74     ["List files" log-edit-show-files
  75      :help "Show the list of relevant files."]
  76     "--"
  77     ["Previous comment" vc-previous-comment]
  78     ["Next comment" vc-next-comment]
  79     ["Search comment forward" vc-comment-search-forward]
  80     ["Search comment backward" vc-comment-search-reverse]))
  81
  82 (defcustom log-edit-confirm 'changed
  83   "*If non-nil, `log-edit-done' will request confirmation.
  84 If 'changed, only request confirmation if the list of files has
  85   changed since the beginning of the log-edit session."
  86   :group 'log-edit
  87   :type '(choice (const changed) (const t) (const nil)))
  88
  89 (defcustom log-edit-keep-buffer nil
  90   "*If non-nil, don't hide the buffer after `log-edit-done'."
  91   :group 'log-edit
  92   :type 'boolean)
  93
  94 (defvar cvs-commit-buffer-require-final-newline t)
  95 (make-obsolete-variable 'cvs-commit-buffer-require-final-newline
  96                         'log-edit-require-final-newline)
  97
  98 (defcustom log-edit-require-final-newline
  99   cvs-commit-buffer-require-final-newline
 100   "*Enforce a newline at the end of commit log messages.
 101 Enforce it silently if t, query if non-nil and don't do anything if nil."
 102   :group 'log-edit
 103   :type '(choice (const ask) (const t) (const nil)))
 104
 105 (defcustom log-edit-setup-invert nil
 106   "*Non-nil means `log-edit' should invert the meaning of its SETUP arg.
 107 If SETUP is 'force, this variable has no effect."
 108   :group 'log-edit
 109   :type 'boolean)
 110
 111 (defcustom log-edit-hook '(log-edit-insert-cvs-template
 112                            log-edit-insert-changelog)
 113   "*Hook run at the end of `log-edit'."
 114   :group 'log-edit
 115   :type '(hook :options (log-edit-insert-cvs-template
 116                          log-edit-insert-changelog)))
 117
 118 (defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook)
 119   "*Hook run when entering `log-edit-mode'."
 120   :group 'log-edit
 121   :type 'hook)
 122
 123 (defcustom log-edit-done-hook nil
 124   "*Hook run before doing the actual commit.
 125 This hook can be used to cleanup the message, enforce various
 126 conventions, or to allow recording the message in some other database,
 127 such as a bug-tracking system.  The list of files about to be committed
 128 can be obtained from `log-edit-files'."
 129   :group 'log-edit
 130   :type '(hook :options (log-edit-set-common-indentation
 131                          log-edit-add-to-changelog)))
 132
 133 (defvar cvs-changelog-full-paragraphs t)
 134 (make-obsolete-variable 'cvs-changelog-full-paragraphs
 135                         'log-edit-changelog-full-paragraphs)
 136
 137 (defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs
 138   "*If non-nil, include full ChangeLog paragraphs in the log.
 139 This may be set in the ``local variables'' section of a ChangeLog, to
 140 indicate the policy for that ChangeLog.
 141
 142 A ChangeLog paragraph is a bunch of log text containing no blank lines;
 143 a paragraph usually describes a set of changes with a single purpose,
 144 but perhaps spanning several functions in several files.  Changes in
 145 different paragraphs are unrelated.
 146
 147 You could argue that the log entry for a file should contain the
 148 full ChangeLog paragraph mentioning the change to the file, even though
 149 it may mention other files, because that gives you the full context you
 150 need to understand the change.  This is the behaviour you get when this
 151 variable is set to t.
 152
 153 On the other hand, you could argue that the log entry for a change
 154 should contain only the text for the changes which occurred in that
 155 file, because the log is per-file.  This is the behaviour you get
 156 when this variable is set to nil.")
 157
 158 ;;;; Internal global or buffer-local vars
 159
 160 (defconst log-edit-files-buf "*log-edit-files*")
 161 (defvar log-edit-initial-files nil)
 162 (defvar log-edit-callback nil)
 163 (defvar log-edit-listfun nil)
 164 (defvar log-edit-parent-buffer nil)
 165
 166 ;;;
 167 ;;; Actual code
 168 ;;;
 169
 170 ;;;###autoload
 171 (defun log-edit (callback &optional setup listfun buffer &rest ignore)
 172   "Setup a buffer to enter a log message.
 173 \\<log-edit-mode-map>The buffer will be put in `log-edit-mode'.
 174 If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run.
 175 Mark and point will be set around the entire contents of the
 176 buffer so that it is easy to kill the contents of the buffer with \\[kill-region].
 177 Once you're done editing the message, pressing \\[log-edit-done] will call
 178 `log-edit-done' which will end up calling CALLBACK to do the actual commit.
 179 LISTFUN if non-nil is a function of no arguments returning the list of files
 180   that are concerned by the current operation (using relative names).
 181 If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the
 182   log message and go back to the current buffer when done.  Otherwise, it
 183   uses the current buffer."
 184   (let ((parent (current-buffer)))
 185     (if buffer (pop-to-buffer buffer))
 186     (when (and log-edit-setup-invert (not (eq setup 'force)))
 187       (setq setup (not setup)))
 188     (when setup (erase-buffer))
 189     (log-edit-mode)
 190     (set (make-local-variable 'log-edit-callback) callback)
 191     (set (make-local-variable 'log-edit-listfun) listfun)
 192     (if buffer (set (make-local-variable 'log-edit-parent-buffer) parent))
 193     (set (make-local-variable 'log-edit-initial-files) (log-edit-files))
 194     (when setup (run-hooks 'log-edit-hook))
 195     (goto-char (point-min)) (push-mark (point-max))
 196     (message (substitute-command-keys
 197               "Press \\[log-edit-done] when you are done editing."))))
 198
 199 (define-derived-mode log-edit-mode text-mode "Log-Edit"
 200   "Major mode for editing version-control log messages.
 201 When done editing the log entry, just type \\[log-edit-done] which
 202 will trigger the actual commit of the file(s).
 203 Several other handy support commands are provided of course and
 204 the package from which this is used might also provide additional
 205 commands (under C-x v for VC, for example).
 206
 207 \\{log-edit-mode-map}"
 208   (make-local-variable 'vc-comment-ring-index))
 209
 210 (defun log-edit-hide-buf (&optional buf where)
 211   (when (setq buf (get-buffer (or buf log-edit-files-buf)))
 212     (let ((win (get-buffer-window buf where)))
 213       (if win (ignore-errors (delete-window win))))
 214     (bury-buffer buf)))
 215
 216 (defun log-edit-done ()
 217   "Finish editing the log message and commit the files.
 218 If you want to abort the commit, simply delete the buffer."
 219   (interactive)
 220   ;; Get rid of trailing empty lines
 221   (goto-char (point-max))
 222   (skip-syntax-backward " ")
 223   (when (equal (char-after) ?\n) (forward-char 1))
 224   (delete-region (point) (point-max))
 225   ;; Check for final newline
 226   (if (and (> (point-max) (point-min))
 227            (/= (char-before (point-max)) ?\n)
 228            (or (eq log-edit-require-final-newline t)
 229                (and log-edit-require-final-newline
 230                     (y-or-n-p
 231                      (format "Buffer %s does not end in newline.  Add one? "
 232                              (buffer-name))))))
 233       (save-excursion
 234         (goto-char (point-max))
 235         (insert ?\n)))
 236   (let ((comment (buffer-string)))
 237     (when (or (ring-empty-p vc-comment-ring)
 238               (not (equal comment (ring-ref vc-comment-ring 0))))
 239       (ring-insert vc-comment-ring comment)))
 240   (let ((win (get-buffer-window log-edit-files-buf)))
 241     (if (and log-edit-confirm
 242              (not (and (eq log-edit-confirm 'changed)
 243                        (equal (log-edit-files) log-edit-initial-files)))
 244              (progn
 245                (log-edit-show-files)
 246                (not (y-or-n-p "Really commit ? "))))
 247         (progn (when (not win) (log-edit-hide-buf))
 248                (message "Oh, well!  Later maybe?"))
 249       (run-hooks 'log-edit-done-hook)
 250       (log-edit-hide-buf)
 251       (unless (or log-edit-keep-buffer (not log-edit-parent-buffer))
 252         (cvs-bury-buffer (current-buffer) log-edit-parent-buffer))
 253       (call-interactively log-edit-callback))))
 254
 255 (defun log-edit-files ()
 256   "Return the list of files that are about to be committed."
 257   (ignore-errors (funcall log-edit-listfun)))
 258
 259
 260 (defun log-edit-insert-changelog ()
 261   "Insert a log message by looking at the ChangeLog.
 262 The idea is to write your ChangeLog entries first, and then use this
 263 command to commit your changes.
 264
 265 To select default log text, we:
 266 - find the ChangeLog entries for the files to be checked in,
 267 - verify that the top entry in the ChangeLog is on the current date
 268   and by the current user; if not, we don't provide any default text,
 269 - search the ChangeLog entry for paragraphs containing the names of
 270   the files we're checking in, and finally
 271 - use those paragraphs as the log text."
 272   (interactive)
 273   (log-edit-insert-changelog-entries (log-edit-files))
 274   (log-edit-set-common-indentation)
 275   (goto-char (point-min))
 276   (when (looking-at "\\*\\s-+")
 277     (forward-line 1)
 278     (when (not (re-search-forward "^\\*\\s-+" nil t))
 279       (goto-char (point-min))
 280       (skip-chars-forward "^():")
 281       (skip-chars-forward ": ")
 282       (delete-region (point-min) (point)))))
 283
 284 (defun log-edit-mode-help ()
 285   "Provide help for the `log-edit-mode-map'."
 286   (interactive)
 287   (if (eq last-command 'log-edit-mode-help)
 288       (describe-function major-mode)
 289     (message
 290      (substitute-command-keys
 291       "Type `\\[log-edit-done]' to finish commit.  Try `\\[describe-function] log-edit-done' for more help."))))
 292
 293 (defcustom log-edit-common-indent 0
 294   "Minimum indentation to use in `log-edit-set-common-indentation'."
 295   :group 'log-edit
 296   :type 'integer)
 297
 298 (defun log-edit-set-common-indentation ()
 299   "(Un)Indent the current buffer rigidly to `log-edit-common-indent'."
 300   (save-excursion
 301     (let ((common (point-max)))
 302       (goto-char (point-min))
 303       (while (< (point) (point-max))
 304         (if (not (looking-at "^[ \t]*$"))
 305             (setq common (min common (current-indentation))))
 306         (forward-line 1))
 307       (indent-rigidly (point-min) (point-max)
 308                       (- log-edit-common-indent common)))))
 309
 310 (defun log-edit-show-files ()
 311   "Show the list of files to be committed."
 312   (interactive)
 313   (let* ((files (log-edit-files))
 314          (editbuf (current-buffer))
 315          (buf (get-buffer-create log-edit-files-buf)))
 316     (with-current-buffer buf
 317       (log-edit-hide-buf buf 'all)
 318       (setq buffer-read-only nil)
 319       (erase-buffer)
 320       (cvs-insert-strings files)
 321       (setq buffer-read-only t)
 322       (goto-char (point-min))
 323       (save-selected-window
 324         (cvs-pop-to-buffer-same-frame buf)
 325         (shrink-window-if-larger-than-buffer)
 326         (selected-window)))))
 327
 328 (defun log-edit-insert-cvs-template ()
 329   "Insert the template specified by the CVS administrator, if any."
 330   (interactive)
 331   (when (file-readable-p "CVS/Template")
 332     (insert-file-contents "CVS/Template")))
 333
 334
 335 (defun log-edit-add-to-changelog ()
 336   "Insert this log message into the appropriate ChangeLog file."
 337   (interactive)
 338   ;; Yuck!
 339   (unless (string= (buffer-string) (ring-ref vc-comment-ring 0))
 340     (ring-insert vc-comment-ring (buffer-string)))
 341   (dolist (f (log-edit-files))
 342     (let ((buffer-file-name (expand-file-name f)))
 343       (save-excursion
 344         (vc-comment-to-change-log)))))
 345
 346 ;;;;
 347 ;;;; functions for getting commit message from ChangeLog a file...
 348 ;;;; Courtesy Jim Blandy
 349 ;;;;
 350
 351 (defun log-edit-narrow-changelog ()
 352   "Narrow to the top page of the current buffer, a ChangeLog file.
 353 Actually, the narrowed region doesn't include the date line.
 354 A \"page\" in a ChangeLog file is the area between two dates."
 355   (or (eq major-mode 'change-log-mode)
 356       (error "log-edit-narrow-changelog: current buffer isn't a ChangeLog"))
 357
 358   (goto-char (point-min))
 359
 360   ;; Skip date line and subsequent blank lines.
 361   (forward-line 1)
 362   (if (looking-at "[ \t\n]*\n")
 363       (goto-char (match-end 0)))
 364
 365   (let ((start (point)))
 366     (forward-page 1)
 367     (narrow-to-region start (point))
 368     (goto-char (point-min))))
 369
 370 (defun log-edit-changelog-paragraph ()
 371   "Return the bounds of the ChangeLog paragraph containing point.
 372 If we are between paragraphs, return the previous paragraph."
 373   (save-excursion
 374     (beginning-of-line)
 375     (if (looking-at "^[ \t]*$")
 376         (skip-chars-backward " \t\n" (point-min)))
 377     (list (progn
 378             (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit)
 379                 (goto-char (match-end 0)))
 380             (point))
 381           (if (re-search-forward "^[ \t\n]*$" nil t)
 382               (match-beginning 0)
 383             (point)))))
 384
 385 (defun log-edit-changelog-subparagraph ()
 386   "Return the bounds of the ChangeLog subparagraph containing point.
 387 A subparagraph is a block of non-blank lines beginning with an asterisk.
 388 If we are between sub-paragraphs, return the previous subparagraph."
 389   (save-excursion
 390     (end-of-line)
 391     (if (search-backward "*" nil t)
 392         (list (progn (beginning-of-line) (point))
 393               (progn
 394                 (forward-line 1)
 395                 (if (re-search-forward "^[ \t]*[\n*]" nil t)
 396                     (match-beginning 0)
 397                   (point-max))))
 398       (list (point) (point)))))
 399
 400 (defun log-edit-changelog-entry ()
 401   "Return the bounds of the ChangeLog entry containing point.
 402 The variable `log-edit-changelog-full-paragraphs' decides whether an
 403 \"entry\" is a paragraph or a subparagraph; see its documentation string
 404 for more details."
 405   (if log-edit-changelog-full-paragraphs
 406       (log-edit-changelog-paragraph)
 407     (log-edit-changelog-subparagraph)))
 408
 409 (defvar user-full-name)
 410 (defvar user-mail-address)
 411 (defun log-edit-changelog-ours-p ()
 412   "See if ChangeLog entry at point is for the current user, today.
 413 Return non-nil iff it is."
 414   ;; Code adapted from add-change-log-entry.
 415   (let ((name (or (and (boundp 'add-log-full-name) add-log-full-name)
 416                   (and (fboundp 'user-full-name) (user-full-name))
 417                   (and (boundp 'user-full-name) user-full-name)))
 418         (mail (or (and (boundp 'add-log-mailing-address) add-log-mailing-address)
 419                   ;;(and (fboundp 'user-mail-address) (user-mail-address))
 420                   (and (boundp 'user-mail-address) user-mail-address)))
 421         (time (or (and (boundp 'add-log-time-format)
 422                        (functionp add-log-time-format)
 423                        (funcall add-log-time-format))
 424                   (format-time-string "%Y-%m-%d"))))
 425     (looking-at (regexp-quote (format "%s  %s  <%s>" time name mail)))))
 426
 427 (defun log-edit-changelog-entries (file)
 428   "Return the ChangeLog entries for FILE, and the ChangeLog they came from.
 429 The return value looks like this:
 430   (LOGBUFFER (ENTRYSTART . ENTRYEND) ...)
 431 where LOGBUFFER is the name of the ChangeLog buffer, and each
 432 \(ENTRYSTART . ENTRYEND\) pair is a buffer region."
 433   (save-excursion
 434     (let ((changelog-file-name
 435            (let ((default-directory
 436                    (file-name-directory (expand-file-name file))))
 437              ;; `find-change-log' uses `change-log-default-name' if set
 438              ;; and sets it before exiting, so we need to work around
 439              ;; that memoizing which is undesired here
 440              (setq change-log-default-name nil)
 441              (find-change-log))))
 442       (set-buffer (find-file-noselect changelog-file-name))
 443       (unless (eq major-mode 'change-log-mode) (change-log-mode))
 444       (goto-char (point-min))
 445       (if (looking-at "\\s-*\n") (goto-char (match-end 0)))
 446       (if (not (log-edit-changelog-ours-p))
 447           (list (current-buffer))
 448         (save-restriction
 449           (log-edit-narrow-changelog)
 450           (goto-char (point-min))
 451
 452           ;; Search for the name of FILE relative to the ChangeLog.  If that
 453           ;; doesn't occur anywhere, they're not using full relative
 454           ;; filenames in the ChangeLog, so just look for FILE; we'll accept
 455           ;; some false positives.
 456           (let ((pattern (file-relative-name
 457                           file (file-name-directory changelog-file-name))))
 458             (if (or (string= pattern "")
 459                     (not (save-excursion
 460                            (search-forward pattern nil t))))
 461                 (setq pattern (file-name-nondirectory file)))
 462
 463             (let (texts)
 464               (while (search-forward pattern nil t)
 465                 (let ((entry (log-edit-changelog-entry)))
 466                   (push entry texts)
 467                   (goto-char (elt entry 1))))
 468
 469               (cons (current-buffer) texts))))))))
 470
 471 (defun log-edit-changelog-insert-entries (buffer regions)
 472   "Insert those regions in BUFFER specified in REGIONS.
 473 Sort REGIONS front-to-back first."
 474   (let ((regions (sort regions 'car-less-than-car))
 475         (last))
 476     (dolist (region regions)
 477       (when (and last (< last (car region))) (newline))
 478       (setq last (elt region 1))
 479       (apply 'insert-buffer-substring buffer region))))
 480
 481 (defun log-edit-insert-changelog-entries (files)
 482   "Given a list of files FILES, insert the ChangeLog entries for them."
 483   (let ((buffer-entries nil))
 484
 485     ;; Add each buffer to buffer-entries, and associate it with the list
 486     ;; of entries we want from that file.
 487     (dolist (file files)
 488       (let* ((entries (log-edit-changelog-entries file))
 489              (pair (assq (car entries) buffer-entries)))
 490         (if pair
 491             (setcdr pair (cvs-union (cdr pair) (cdr entries)))
 492           (push entries buffer-entries))))
 493
 494     ;; Now map over each buffer in buffer-entries, sort the entries for
 495     ;; each buffer, and extract them as strings.
 496     (dolist (buffer-entry buffer-entries)
 497       (log-edit-changelog-insert-entries (car buffer-entry) (cdr buffer-entry))
 498       (when (cdr buffer-entry) (newline)))))
 499
 500 (provide 'log-edit)
 501
 502 ;;; log-edit.el ends here