lisp/log-view.el

   1 ;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
   4 ;;   2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   7 ;; Keywords: rcs sccs cvs log version-control
   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 ;; Major mode to browse revision log histories.
  27 ;; Currently supports the format output by:
  28 ;;  RCS, SCCS, CVS, Subversion, and DaRCS.
  29
  30 ;; Examples of log output:
  31
  32 ;;;; RCS/CVS:
  33
  34 ;; ----------------------------
  35 ;; revision 1.35        locked by: turlutut
  36 ;; date: 2005-03-22 18:48:38 +0000;  author: monnier;  state: Exp;  lines: +6 -8
  37 ;; (gnus-display-time-event-handler):
  38 ;; Check display-time-timer at runtime rather than only at load time
  39 ;; in case display-time-mode is turned off in the mean time.
  40 ;; ----------------------------
  41 ;; revision 1.34
  42 ;; date: 2005-02-09 15:50:38 +0000;  author: kfstorm;  state: Exp;  lines: +7 -7
  43 ;; branches:  1.34.2;
  44 ;; Change release version from 21.4 to 22.1 throughout.
  45 ;; Change development version from 21.3.50 to 22.0.50.
  46
  47 ;;;; SCCS:
  48
  49 ;;;; Subversion:
  50
  51 ;; ------------------------------------------------------------------------
  52 ;; r4622 | ckuethe | 2007-12-23 18:18:01 -0500 (Sun, 23 Dec 2007) | 2 lines
  53 ;;
  54 ;; uBlox AEK-4T in binary mode. Added to unstable because it breaks gpsfake
  55 ;;
  56 ;; ------------------------------------------------------------------------
  57 ;; r4621 | ckuethe | 2007-12-23 16:48:11 -0500 (Sun, 23 Dec 2007) | 3 lines
  58 ;;
  59 ;; Add a note about requiring usbfs to use the garmin gps18 (usb)
  60 ;; Mention firmware testing the AC12 with firmware BQ00 and BQ04
  61 ;;
  62 ;; ------------------------------------------------------------------------
  63 ;; r4620 | ckuethe | 2007-12-23 15:52:34 -0500 (Sun, 23 Dec 2007) | 1 line
  64 ;;
  65 ;; add link to latest hardware reference
  66 ;; ------------------------------------------------------------------------
  67 ;; r4619 | ckuethe | 2007-12-23 14:37:31 -0500 (Sun, 23 Dec 2007) | 1 line
  68 ;;
  69 ;; there is now a regression test for AC12 without raw data output
  70
  71 ;;;; Darcs:
  72
  73 ;; Changes to darcsum.el:
  74 ;;
  75 ;; Mon Nov 28 15:19:38 GMT 2005  Dave Love <fx@gnu.org>
  76 ;;   * Abstract process startup into darcsum-start-process.  Use TERM=dumb.
  77 ;;   TERM=dumb avoids escape characters, at least, for any old darcs that
  78 ;;   doesn't understand DARCS_DONT_COLOR & al.
  79 ;;
  80 ;; Thu Nov 24 15:20:45 GMT 2005  Dave Love <fx@gnu.org>
  81 ;;   * darcsum-mode-related changes.
  82 ;;   Don't call font-lock-mode (unnecessary) or use-local-map (redundant).
  83 ;;   Use mode-class 'special.  Add :group.
  84 ;;   Add trailing-whitespace option to mode hook and fix
  85 ;;   darcsum-display-changeset not to use trailing whitespace.
  86
  87 ;;;; Mercurial
  88
  89 ;; changeset:   11:8ff1a4166444
  90 ;; tag:         tip
  91 ;; user:        Eric S. Raymond <esr@thyrsus.com>
  92 ;; date:        Wed Dec 26 12:18:58 2007 -0500
  93 ;; summary:     Explain keywords.  Add markup fixes.
  94 ;;
  95 ;; changeset:   10:20abc7ab09c3
  96 ;; user:        Eric S. Raymond <esr@thyrsus.com>
  97 ;; date:        Wed Dec 26 11:37:28 2007 -0500
  98 ;; summary:     Typo fixes.
  99 ;;
 100 ;; changeset:   9:ada9f4da88aa
 101 ;; user:        Eric S. Raymond <esr@thyrsus.com>
 102 ;; date:        Wed Dec 26 11:23:00 2007 -0500
 103 ;; summary:     Add RCS example session.
 104
 105 ;;; Todo:
 106
 107 ;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
 108 ;; - remove references to cvs-*
 109 ;; - make it easier to add support for new backends without changing the code.
 110
 111 ;;; Code:
 112
 113 (eval-when-compile (require 'cl))
 114 (require 'pcvs-util)
 115 (autoload 'vc-find-revision "vc")
 116 (autoload 'vc-version-diff "vc")
 117
 118 (defvar cvs-minor-wrap-function)
 119
 120 (defgroup log-view nil
 121   "Major mode for browsing log output of RCS/CVS/SCCS."
 122   :group 'pcl-cvs
 123   :prefix "log-view-")
 124
 125 (easy-mmode-defmap log-view-mode-map
 126   '(("q" . quit-window)
 127     ("z" . kill-this-buffer)
 128     ("m" . log-view-toggle-mark-entry)
 129     ("e" . log-view-modify-change-comment)
 130     ("d" . log-view-diff)
 131     ("a" . log-view-annotate-version)
 132     ("f" . log-view-find-revision)
 133     ("n" . log-view-msg-next)
 134     ("p" . log-view-msg-prev)
 135     ("\t" . log-view-msg-next)
 136     ([backtab] . log-view-msg-prev)
 137     ("N" . log-view-file-next)
 138     ("P" . log-view-file-prev)
 139     ("\M-n" . log-view-file-next)
 140     ("\M-p" . log-view-file-prev))
 141   "Log-View's keymap."
 142   :group 'log-view
 143   ;; Here I really need either buffer-local keymap-inheritance
 144   ;; or a minor-mode-map with lower precedence than the local map.
 145   :inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
 146
 147 (easy-menu-define log-view-mode-menu log-view-mode-map
 148   "Log-View Display Menu"
 149   `("Log-View"
 150     ;; XXX Do we need menu entries for these?
 151     ;; ["Quit"  quit-window]
 152     ;; ["Kill This Buffer"  kill-this-buffer]
 153     ["Mark Log Entry for Diff"  set-mark-command
 154      :help ""]
 155     ["Diff Revisions"  log-view-diff
 156      :help "Get the diff between two revisions"]
 157     ["Visit Version"  log-view-find-revision
 158      :help "Visit the version at point"]
 159     ["Annotate Version"  log-view-annotate-version
 160      :help "Annotate the version at point"]
 161     ["Modify Log Comment" log-view-modify-change-comment
 162      :help "Edit the change comment displayed at point"]
 163     "-----"
 164     ["Next Log Entry"  log-view-msg-next
 165      :help "Go to the next count'th log message"]
 166     ["Previous Log Entry"  log-view-msg-prev
 167      :help "Go to the previous count'th log message"]
 168     ["Next File"  log-view-file-next
 169      :help "Go to the next count'th file"]
 170     ["Previous File"  log-view-file-prev
 171      :help "Go to the previous count'th file"]))
 172
 173 (defvar log-view-mode-hook nil
 174   "Hook run at the end of `log-view-mode'.")
 175
 176 (defface log-view-file
 177   '((((class color) (background light))
 178      (:background "grey70" :weight bold))
 179     (t (:weight bold)))
 180   "Face for the file header line in `log-view-mode'."
 181   :group 'log-view)
 182 ;; backward-compatibility alias
 183 (put 'log-view-file-face 'face-alias 'log-view-file)
 184 (defvar log-view-file-face 'log-view-file)
 185
 186 (defface log-view-message
 187   '((((class color) (background light))
 188      (:background "grey85"))
 189     (t (:weight bold)))
 190   "Face for the message header line in `log-view-mode'."
 191   :group 'log-view)
 192 ;; backward-compatibility alias
 193 (put 'log-view-message-face 'face-alias 'log-view-message)
 194 (defvar log-view-message-face 'log-view-message)
 195
 196 (defvar log-view-file-re
 197   (concat "^\\(?:Working file: \\(?1:.+\\)"                ;RCS and CVS.
 198           ;; Subversion has no such thing??
 199           "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(?1:.+\\):" ;SCCS and Darcs.
 200           "\\)\n")                    ;Include the \n for font-lock reasons.
 201   "Regexp matching the text identifying the file.
 202 The match group number 1 should match the file name itself.")
 203
 204 (defvar log-view-message-re
 205   (concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
 206           "\\|r\\(?1:[0-9]+\\) | .* | .*"                ; Subversion.
 207           "\\|D \\(?1:[.0-9]+\\) .*"                     ; SCCS.
 208           ;; Darcs doesn't have revision names.  VC-darcs uses patch names
 209           ;; instead.  Darcs patch names are hashcodes, which do not appear
 210           ;; in the log output :-(, but darcs accepts any prefix of the log
 211           ;; message as a patch name, so we match the first line of the log
 212           ;; message.
 213           ;; First loosely match the date format.
 214           (concat "\\|[^ \n].*[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].*[^ \n]"
 215                   ;;Email of user and finally Msg, used as revision name.
 216                   "  .*@.*\n\\(?:  \\* \\(?1:.*\\)\\)?")
 217           "\\)$")
 218   "Regexp matching the text identifying a revision.
 219 The match group number 1 should match the revision number itself.")
 220
 221 (defvar log-view-font-lock-keywords
 222   ;; We use `eval' so as to use the buffer-local value of log-view-file-re
 223   ;; and log-view-message-re, if applicable.
 224   '((eval . `(,log-view-file-re
 225               (1 (if (boundp 'cvs-filename-face) cvs-filename-face))
 226               (0 log-view-file-face append)))
 227     (eval . `(,log-view-message-re . log-view-message-face))))
 228
 229 (defconst log-view-font-lock-defaults
 230   '(log-view-font-lock-keywords t nil nil nil))
 231
 232 ;;;;
 233 ;;;; Actual code
 234 ;;;;
 235
 236 ;;;###autoload
 237 (define-derived-mode log-view-mode fundamental-mode "Log-View"
 238   "Major mode for browsing CVS log output."
 239   (setq buffer-read-only t)
 240   (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
 241   (set (make-local-variable 'beginning-of-defun-function)
 242        'log-view-beginning-of-defun)
 243   (set (make-local-variable 'end-of-defun-function)
 244        'log-view-end-of-defun)
 245   (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
 246
 247 ;;;;
 248 ;;;; Navigation
 249 ;;;;
 250
 251 ;; define log-view-{msg,file}-{next,prev}
 252 (easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
 253 (easy-mmode-define-navigation log-view-file log-view-file-re "file")
 254
 255 (defun log-view-goto-rev (rev)
 256   (goto-char (point-min))
 257   (ignore-errors
 258     (while (not (equal rev (log-view-current-tag)))
 259       (log-view-msg-next))
 260     t))
 261
 262 ;;;;
 263 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
 264 ;;;;
 265
 266 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
 267
 268 (defun log-view-current-file ()
 269   (save-excursion
 270     (forward-line 1)
 271     (or (re-search-backward log-view-file-re nil t)
 272         (re-search-forward log-view-file-re nil t)
 273         (error "Unable to determine the current file"))
 274     (let* ((file (match-string 1))
 275            (cvsdir (and (re-search-backward log-view-dir-re nil t)
 276                         (match-string 1)))
 277            (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
 278                         (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 279                         (match-string 1)))
 280            (dir ""))
 281       (let ((default-directory ""))
 282         (when pcldir (setq dir (expand-file-name pcldir dir)))
 283         (when cvsdir (setq dir (expand-file-name cvsdir dir))))
 284       (expand-file-name file dir))))
 285
 286 (defun log-view-current-tag (&optional where)
 287   (save-excursion
 288     (when where (goto-char where))
 289     (forward-line 1)
 290     (let ((pt (point)))
 291       (when (re-search-backward log-view-message-re nil t)
 292         (let ((rev (match-string-no-properties 1)))
 293           (unless (re-search-forward log-view-file-re pt t)
 294             rev))))))
 295
 296 (defun log-view-toggle-mark-entry ()
 297   "Toggle the marked state for the log entry at point.
 298 Individual log entries can be marked and unmarked. The marked
 299 entries are denoted by changing their background color.
 300 `log-view-get-marked' returns the list of tags for the marked
 301 log entries."
 302   (interactive)
 303   (save-excursion
 304     (forward-line 1)
 305     (let ((pt (point)))
 306       (when (re-search-backward log-view-message-re nil t)
 307         (let ((beg (match-beginning 0))
 308               end ov ovlist found tag)
 309           (unless (re-search-forward log-view-file-re pt t)
 310             ;; Look to see if the current entry is marked.
 311             (setq found (get-char-property (point) 'log-view-self))
 312             (if found
 313                 (delete-overlay found)
 314               ;; Create an overlay that covers this entry and change
 315               ;; its color.
 316               (setq tag (log-view-current-tag (point)))
 317               (forward-line 1)
 318               (setq end
 319                     (if (re-search-forward log-view-message-re nil t)
 320                         (match-beginning 0)
 321                       (point-max)))
 322               (setq ov (make-overlay beg end))
 323               (overlay-put ov 'face 'log-view-file)
 324               ;; This is used to check if the overlay is present.
 325               (overlay-put ov 'log-view-self ov)
 326               (overlay-put ov 'log-view-marked tag))))))))
 327
 328 (defun log-view-get-marked ()
 329   "Return the list of tags for the marked log entries."
 330   (save-excursion
 331     (let ((pos (point-min))
 332           marked-list ov)
 333       (while (setq pos (next-single-property-change pos 'face))
 334         (when (setq ov (get-char-property pos 'log-view-self))
 335           (push (overlay-get ov 'log-view-marked) marked-list)
 336           (setq pos (overlay-end ov))))
 337       marked-list)))
 338
 339 (defun log-view-beginning-of-defun ()
 340   ;; This assumes that a log entry starts with a line matching
 341   ;; `log-view-message-re'.  Modes that derive from `log-view-mode'
 342   ;; for which this assumption is not valid will have to provide
 343   ;; another implementation of this function.  `log-view-msg-prev'
 344   ;; does a similar job to this function, we can't use it here
 345   ;; directly because it prints messages that are not appropriate in
 346   ;; this context and it does not move to the beginning of the buffer
 347   ;; when the point is before the first log entry.
 348
 349   ;; `log-view-beginning-of-defun' and `log-view-end-of-defun' have
 350   ;; been checked to work with logs produced by RCS, CVS, git,
 351   ;; mercurial and subversion.
 352
 353   (re-search-backward log-view-message-re nil 'move))
 354
 355 (defun log-view-end-of-defun ()
 356   ;; The idea in this function is to search for the beginning of the
 357   ;; next log entry using `log-view-message-re' and then go back one
 358   ;; line when finding it.  Modes that derive from `log-view-mode' for
 359   ;; which this assumption is not valid will have to provide another
 360   ;; implementation of this function.
 361
 362   ;; Look back and if there is no entry there it means we are before
 363   ;; the first log entry, so go forward until finding one.
 364   (unless (save-excursion (re-search-backward log-view-message-re nil t))
 365     (re-search-forward log-view-message-re nil t))
 366
 367   ;; In case we are at the end of log entry going forward a line will
 368   ;; make us find the next entry when searching. If we are inside of
 369   ;; an entry going forward a line will still keep the point inside
 370   ;; the same entry.
 371   (forward-line 1)
 372
 373   ;; In case we are at the beginning of an entry, move past it.
 374   (when (looking-at log-view-message-re)
 375     (goto-char (match-end 0))
 376     (forward-line 1))
 377
 378   ;; Search for the start of the next log entry.  Go to the end of the
 379   ;; buffer if we could not find a next entry.
 380   (when (re-search-forward log-view-message-re nil 'move)
 381     (goto-char (match-beginning 0))
 382     (forward-line -1)))
 383
 384 (defvar cvs-minor-current-files)
 385 (defvar cvs-branch-prefix)
 386 (defvar cvs-secondary-branch-prefix)
 387
 388 (defun log-view-minor-wrap (buf f)
 389   (let ((data (with-current-buffer buf
 390                 (let* ((beg (point))
 391                        (end (if mark-active (mark) (point)))
 392                        (fr (log-view-current-tag beg))
 393                        (to (log-view-current-tag end)))
 394                   (when (string-equal fr to)
 395                     (save-excursion
 396                       (goto-char end)
 397                       (log-view-msg-next)
 398                       (setq to (log-view-current-tag))))
 399                   (cons
 400                    ;; The first revision has to be the one at point, for
 401                    ;; operations that only take one revision
 402                    ;; (e.g. cvs-mode-edit).
 403                    (cons (log-view-current-file) fr)
 404                    (cons (log-view-current-file) to))))))
 405     (let ((cvs-branch-prefix (cdar data))
 406           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 407           (cvs-minor-current-files
 408            (cons (caar data)
 409                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 410                    (list (cadr data)))))
 411           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 412           (cvs-force-command "/F"))
 413       (funcall f))))
 414
 415 (defun log-view-find-revision (pos)
 416   "Visit the version at point."
 417   (interactive "d")
 418   (save-excursion
 419     (goto-char pos)
 420     (switch-to-buffer (vc-find-revision (log-view-current-file)
 421                                        (log-view-current-tag)))))
 422
 423
 424 (defun log-view-extract-comment ()
 425   "Parse comment from around the current point in the log."
 426   (save-excursion
 427     (let (st en (backend (vc-backend (log-view-current-file))))
 428       (log-view-end-of-defun)
 429       (cond ((eq backend 'SVN)
 430              (forward-line -1)))
 431       (setq en (point))
 432       (log-view-beginning-of-defun)
 433       (cond ((memq backend '(SCCS RCS CVS MCVS SVN))
 434              (forward-line 2))
 435             ((eq backend 'Hg)
 436              (forward-line 4)
 437              (re-search-forward "summary: *" nil t)))
 438       (setq st (point))
 439       (buffer-substring st en))))
 440
 441 (declare-function vc-modify-change-comment "vc" (files rev oldcomment))
 442
 443 (defun log-view-modify-change-comment ()
 444   "Edit the change comment displayed at point."
 445   (interactive)
 446   (vc-modify-change-comment (list (log-view-current-file))
 447                           (log-view-current-tag)
 448                           (log-view-extract-comment)))
 449
 450 (defun log-view-annotate-version (pos)
 451   "Annotate the version at point."
 452   (interactive "d")
 453   (save-excursion
 454     (goto-char pos)
 455     (switch-to-buffer (vc-annotate (log-view-current-file)
 456                                    (log-view-current-tag)))))
 457
 458 ;;
 459 ;; diff
 460 ;;
 461
 462 (defun log-view-diff (beg end)
 463   "Get the diff between two revisions.
 464 If the mark is not active or the mark is on the revision at point,
 465 get the diff between the revision at point and its previous revision.
 466 Otherwise, get the diff between the revisions where the region starts
 467 and ends."
 468   (interactive
 469    (list (if mark-active (region-beginning) (point))
 470          (if mark-active (region-end) (point))))
 471   (let ((fr (log-view-current-tag beg))
 472         (to (log-view-current-tag end)))
 473     (when (string-equal fr to)
 474       (save-excursion
 475         (goto-char end)
 476         (log-view-msg-next)
 477         (setq to (log-view-current-tag))))
 478     (vc-version-diff (list (log-view-current-file)) to fr)))
 479
 480 (provide 'log-view)
 481
 482 ;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f
 483 ;;; log-view.el ends here