code.delx.au - gnu-emacs/blob - 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,
   4 ;;   2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   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 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., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Major mode to browse revision log histories.
  29 ;; Currently supports the format output by:
  30 ;;  RCS, SCCS, CVS, Subversion.
  31
  32 ;; Examples of log output:
  33
  34 ;;;; RCS/CVS:
  35
  36 ;; ----------------------------
  37 ;; revision 1.35        locked by: turlutut
  38 ;; date: 2005-03-22 18:48:38 +0000;  author: monnier;  state: Exp;  lines: +6 -8
  39 ;; (gnus-display-time-event-handler):
  40 ;; Check display-time-timer at runtime rather than only at load time
  41 ;; in case display-time-mode is turned off in the mean time.
  42 ;; ----------------------------
  43 ;; revision 1.34
  44 ;; date: 2005-02-09 15:50:38 +0000;  author: kfstorm;  state: Exp;  lines: +7 -7
  45 ;; branches:  1.34.2;
  46 ;; Change release version from 21.4 to 22.1 throughout.
  47 ;; Change development version from 21.3.50 to 22.0.50.
  48
  49 ;;;; SCCS:
  50
  51 ;;;; Subversion:
  52
  53 ;;; Todo:
  54
  55 ;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
  56 ;; - remove references to cvs-*
  57 ;; - make it easier to add support for new backends without changing the code.
  58
  59 ;;; Code:
  60
  61 (eval-when-compile (require 'cl))
  62 (require 'pcvs-util)
  63 (autoload 'vc-find-version "vc")
  64 (autoload 'vc-version-diff "vc")
  65
  66 (defvar cvs-minor-wrap-function)
  67
  68 (defgroup log-view nil
  69   "Major mode for browsing log output of RCS/CVS/SCCS."
  70   :group 'pcl-cvs
  71   :prefix "log-view-")
  72
  73 (easy-mmode-defmap log-view-mode-map
  74   '(("q" . quit-window)
  75     ("z" . kill-this-buffer)
  76     ("m" . set-mark-command)
  77     ;; ("e" . cvs-mode-edit-log)
  78     ("d" . log-view-diff)
  79     ("f" . log-view-find-version)
  80     ("n" . log-view-msg-next)
  81     ("p" . log-view-msg-prev)
  82     ("N" . log-view-file-next)
  83     ("P" . log-view-file-prev)
  84     ("\M-n" . log-view-file-next)
  85     ("\M-p" . log-view-file-prev))
  86   "Log-View's keymap."
  87   :group 'log-view
  88   ;; Here I really need either buffer-local keymap-inheritance
  89   ;; or a minor-mode-map with lower precedence than the local map.
  90   :inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
  91
  92 (defvar log-view-mode-hook nil
  93   "Hook run at the end of `log-view-mode'.")
  94
  95 (defface log-view-file
  96   '((((class color) (background light))
  97      (:background "grey70" :weight bold))
  98     (t (:weight bold)))
  99   "Face for the file header line in `log-view-mode'."
 100   :group 'log-view)
 101 ;; backward-compatibility alias
 102 (put 'log-view-file-face 'face-alias 'log-view-file)
 103 (defvar log-view-file-face 'log-view-file)
 104
 105 (defface log-view-message
 106   '((((class color) (background light))
 107      (:background "grey85"))
 108     (t (:weight bold)))
 109   "Face for the message header line in `log-view-mode'."
 110   :group 'log-view)
 111 ;; backward-compatibility alias
 112 (put 'log-view-message-face 'face-alias 'log-view-message)
 113 (defvar log-view-message-face 'log-view-message)
 114
 115 (defconst log-view-file-re
 116   (concat "^\\(?:Working file: \\(.+\\)"                ;RCS and CVS.
 117           "\\|SCCS/s\\.\\(.+\\):"                       ;SCCS.
 118           "\\)\n"))                   ;Include the \n for font-lock reasons.
 119
 120 (defconst log-view-message-re
 121   (concat "^\\(?:revision \\([.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
 122           "\\|r\\([0-9]+\\) | .* | .*"                ; Subversion.
 123           "\\|D \\([.0-9]+\\) .*"                     ; SCCS.
 124           "\\)$"))
 125
 126 (defconst log-view-font-lock-keywords
 127   `((,log-view-file-re
 128      (1 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
 129      (2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
 130      (0 log-view-file-face append))
 131     (,log-view-message-re . log-view-message-face)))
 132 (defconst log-view-font-lock-defaults
 133   '(log-view-font-lock-keywords t nil nil nil))
 134
 135 ;;;;
 136 ;;;; Actual code
 137 ;;;;
 138
 139 ;;;###autoload
 140 (define-derived-mode log-view-mode fundamental-mode "Log-View"
 141   "Major mode for browsing CVS log output."
 142   (setq buffer-read-only t)
 143   (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
 144   (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
 145
 146 ;;;;
 147 ;;;; Navigation
 148 ;;;;
 149
 150 ;; define log-view-{msg,file}-{next,prev}
 151 (easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
 152 (easy-mmode-define-navigation log-view-file log-view-file-re "file")
 153
 154 (defun log-view-goto-rev (rev)
 155   (goto-char (point-min))
 156   (ignore-errors
 157     (while (not (equal rev (log-view-current-tag)))
 158       (log-view-msg-next))
 159     t))
 160
 161 ;;;;
 162 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
 163 ;;;;
 164
 165 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
 166
 167 (defun log-view-current-file ()
 168   (save-excursion
 169     (forward-line 1)
 170     (or (re-search-backward log-view-file-re nil t)
 171         (re-search-forward log-view-file-re))
 172     (let* ((file (or (match-string 1) (match-string 2)))
 173            (cvsdir (and (re-search-backward log-view-dir-re nil t)
 174                         (match-string 1)))
 175            (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
 176                         (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 177                         (match-string 1)))
 178            (dir ""))
 179       (let ((default-directory ""))
 180         (when pcldir (setq dir (expand-file-name pcldir dir)))
 181         (when cvsdir (setq dir (expand-file-name cvsdir dir))))
 182       (expand-file-name file dir))))
 183
 184 (defun log-view-current-tag (&optional where)
 185   (save-excursion
 186     (when where (goto-char where))
 187     (forward-line 1)
 188     (let ((pt (point)))
 189       (when (re-search-backward log-view-message-re nil t)
 190         (let (rev)
 191           ;; Find the subgroup that matched.
 192           (dotimes (i (/ (length (match-data 'integers)) 2))
 193             (setq rev (or rev (match-string (1+ i)))))
 194           (unless (re-search-forward log-view-file-re pt t)
 195             rev))))))
 196
 197 (defvar cvs-minor-current-files)
 198 (defvar cvs-branch-prefix)
 199 (defvar cvs-secondary-branch-prefix)
 200
 201 (defun log-view-minor-wrap (buf f)
 202   (let ((data (with-current-buffer buf
 203                 (cons
 204                  (cons (log-view-current-file)
 205                        (log-view-current-tag))
 206                  (when mark-active
 207                    (save-excursion
 208                      (goto-char (mark))
 209                      (cons (log-view-current-file)
 210                            (log-view-current-tag))))))))
 211     (let ((cvs-branch-prefix (cdar data))
 212           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 213           (cvs-minor-current-files
 214            (cons (caar data)
 215                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 216                    (list (cadr data)))))
 217           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 218           (cvs-force-command "/F"))
 219       (funcall f))))
 220
 221 (defun log-view-find-version (pos)
 222   "Visit the version at point."
 223   (interactive "d")
 224   (save-excursion
 225     (goto-char pos)
 226     (switch-to-buffer (vc-find-version (log-view-current-file)
 227                                        (log-view-current-tag)))))
 228
 229 ;;
 230 ;; diff
 231 ;;
 232
 233 (defun log-view-diff (beg end)
 234   "Get the diff between two revisions.
 235 If the mark is not active or the mark is on the revision at point,
 236 get the diff between the revision at point and its previous revision.
 237 Otherwise, get the diff between the revisions where the region starts
 238 and ends."
 239   (interactive
 240    (list (if mark-active (region-beginning) (point))
 241          (if mark-active (region-end) (point))))
 242   (let ((fr (log-view-current-tag beg))
 243         (to (log-view-current-tag end)))
 244     (when (string-equal fr to)
 245       (save-excursion
 246         (goto-char end)
 247         (log-view-msg-next)
 248         (setq to (log-view-current-tag))))
 249     (vc-version-diff (log-view-current-file) to fr)))
 250
 251 (provide 'log-view)
 252
 253 ;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f
 254 ;;; log-view.el ends here