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-version-diff "vc")
  64
  65 (defvar cvs-minor-wrap-function)
  66
  67 (defgroup log-view nil
  68   "Major mode for browsing log output of RCS/CVS/SCCS."
  69   :group 'pcl-cvs
  70   :prefix "log-view-")
  71
  72 (easy-mmode-defmap log-view-mode-map
  73   '(("q" . quit-window)
  74     ("z" . kill-this-buffer)
  75     ("m" . set-mark-command)
  76     ;; ("e" . cvs-mode-edit-log)
  77     ("d" . log-view-diff)
  78     ("f" . log-view-find-version)
  79     ("n" . log-view-msg-next)
  80     ("p" . log-view-msg-prev)
  81     ("N" . log-view-file-next)
  82     ("P" . log-view-file-prev)
  83     ("\M-n" . log-view-file-next)
  84     ("\M-p" . log-view-file-prev))
  85   "Log-View's keymap."
  86   :group 'log-view
  87   ;; Here I really need either buffer-local keymap-inheritance
  88   ;; or a minor-mode-map with lower precedence than the local map.
  89   :inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
  90
  91 (defvar log-view-mode-hook nil
  92   "Hook run at the end of `log-view-mode'.")
  93
  94 (defface log-view-file
  95   '((((class color) (background light))
  96      (:background "grey70" :weight bold))
  97     (t (:weight bold)))
  98   "Face for the file header line in `log-view-mode'."
  99   :group 'log-view)
 100 ;; backward-compatibility alias
 101 (put 'log-view-file-face 'face-alias 'log-view-file)
 102 (defvar log-view-file-face 'log-view-file)
 103
 104 (defface log-view-message
 105   '((((class color) (background light))
 106      (:background "grey85"))
 107     (t (:weight bold)))
 108   "Face for the message header line in `log-view-mode'."
 109   :group 'log-view)
 110 ;; backward-compatibility alias
 111 (put 'log-view-message-face 'face-alias 'log-view-message)
 112 (defvar log-view-message-face 'log-view-message)
 113
 114 (defconst log-view-file-re
 115   (concat "^\\(?:Working file: \\(.+\\)"                ;RCS and CVS.
 116           "\\|SCCS/s\\.\\(.+\\):"                       ;SCCS.
 117           "\\)\n"))                   ;Include the \n for font-lock reasons.
 118
 119 (defconst log-view-message-re
 120   (concat "^\\(?:revision \\([.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
 121           "\\|r\\([0-9]+\\) | .* | .*"                ; Subversion.
 122           "\\|D \\([.0-9]+\\) .*"                     ; SCCS.
 123           "\\)$"))
 124
 125 (defconst log-view-font-lock-keywords
 126   `((,log-view-file-re
 127      (1 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
 128      (2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
 129      (0 log-view-file-face append))
 130     (,log-view-message-re . log-view-message-face)))
 131 (defconst log-view-font-lock-defaults
 132   '(log-view-font-lock-keywords t nil nil nil))
 133
 134 ;;;;
 135 ;;;; Actual code
 136 ;;;;
 137
 138 ;;;###autoload
 139 (define-derived-mode log-view-mode fundamental-mode "Log-View"
 140   "Major mode for browsing CVS log output."
 141   (setq buffer-read-only t)
 142   (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
 143   (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
 144
 145 ;;;;
 146 ;;;; Navigation
 147 ;;;;
 148
 149 ;; define log-view-{msg,file}-{next,prev}
 150 (easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
 151 (easy-mmode-define-navigation log-view-file log-view-file-re "file")
 152
 153 (defun log-view-goto-rev (rev)
 154   (goto-char (point-min))
 155   (ignore-errors
 156     (while (not (equal rev (log-view-current-tag)))
 157       (log-view-msg-next))
 158     t))
 159
 160 ;;;;
 161 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
 162 ;;;;
 163
 164 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
 165
 166 (defun log-view-current-file ()
 167   (save-excursion
 168     (forward-line 1)
 169     (or (re-search-backward log-view-file-re nil t)
 170         (re-search-forward log-view-file-re))
 171     (let* ((file (or (match-string 2) (match-string 3)))
 172            (cvsdir (and (re-search-backward log-view-dir-re nil t)
 173                         (match-string 1)))
 174            (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
 175                         (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 176                         (match-string 1)))
 177            (dir ""))
 178       (let ((default-directory ""))
 179         (when pcldir (setq dir (expand-file-name pcldir dir)))
 180         (when cvsdir (setq dir (expand-file-name cvsdir dir))))
 181       (expand-file-name file dir))))
 182
 183 (defun log-view-current-tag (&optional where)
 184   (save-excursion
 185     (when where (goto-char where))
 186     (forward-line 1)
 187     (let ((pt (point)))
 188       (when (re-search-backward log-view-message-re nil t)
 189         (let (rev)
 190           ;; Find the subgroup that matched.
 191           (dotimes (i (/ (match-data 'integers) 2))
 192             (setq rev (or rev (match-string (1+ i)))))
 193           (unless (re-search-forward log-view-file-re pt t)
 194             rev))))))
 195
 196 (defvar cvs-minor-current-files)
 197 (defvar cvs-branch-prefix)
 198 (defvar cvs-secondary-branch-prefix)
 199
 200 (defun log-view-minor-wrap (buf f)
 201   (let ((data (with-current-buffer buf
 202                 (cons
 203                  (cons (log-view-current-file)
 204                        (log-view-current-tag))
 205                  (when mark-active
 206                    (save-excursion
 207                      (goto-char (mark))
 208                      (cons (log-view-current-file)
 209                            (log-view-current-tag))))))))
 210     (let ((cvs-branch-prefix (cdar data))
 211           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 212           (cvs-minor-current-files
 213            (cons (caar data)
 214                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 215                    (list (cadr data)))))
 216           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 217           (cvs-force-command "/F"))
 218       (funcall f))))
 219
 220 (defun log-view-find-version (pos)
 221   "Visit the version at point."
 222   (interactive "d")
 223   (save-excursion
 224     (goto-char pos)
 225     (switch-to-buffer (vc-find-version (log-view-current-file)
 226                                        (log-view-current-tag)))))
 227
 228 ;;
 229 ;; diff
 230 ;;
 231
 232 (defun log-view-diff (beg end)
 233   "Get the diff between two revisions.
 234 If the mark is not active or the mark is on the revision at point,
 235 get the diff between the revision at point and its previous revision.
 236 Otherwise, get the diff between the revisions where the region starts
 237 and ends."
 238   (interactive
 239    (list (if mark-active (region-beginning) (point))
 240          (if mark-active (region-end) (point))))
 241   (let ((fr (log-view-current-tag beg))
 242         (to (log-view-current-tag end)))
 243     (when (string-equal fr to)
 244       (save-excursion
 245         (goto-char end)
 246         (log-view-msg-next)
 247         (setq to (log-view-current-tag))))
 248     (vc-version-diff (log-view-current-file) to fr)))
 249
 250 (provide 'log-view)
 251
 252 ;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f
 253 ;;; log-view.el ends here