lisp/log-view.el

   1 ;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output
   2
   3 ;; Copyright (C) 1999-2000  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: rcs sccs cvs log version-control
   7 ;; Version: $Name:  $
   8 ;; Revision: $Id: log-view.el,v 1.3 2000/05/10 22:22:21 monnier Exp $
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Todo:
  30
  31 ;; - add compatibility with cvs-log.el
  32 ;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
  33 ;; - remove references to cvs-*
  34
  35 ;;; Code:
  36
  37 (eval-when-compile (require 'cl))
  38 (require 'pcvs-util)
  39
  40
  41 (defgroup log-view nil
  42   "Major mode for browsing log output of RCS/CVS/SCCS."
  43   :group 'pcl-cvs
  44   :prefix "log-view-")
  45
  46 (easy-mmode-defmap log-view-mode-map
  47   '(("n" . log-view-msg-next)
  48     ("p" . log-view-msg-prev)
  49     ("N" . log-view-file-next)
  50     ("P" . log-view-file-prev)
  51     ("M-n" . log-view-file-next)
  52     ("M-p" . log-view-file-prev))
  53   "Log-View's keymap."
  54   :group 'log-view
  55   ;; Here I really need either buffer-local keymap-inheritance
  56   ;; or a minor-mode-map with lower precedence than the local map.
  57   :inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
  58
  59 (defvar log-view-mode-hook nil
  60   "Hook run at the end of `log-view-mode'.")
  61
  62 (defface log-view-file-face
  63   '((((class color) (background light))
  64      (:background "grey70" :bold t))
  65     (t (:bold t)))
  66   "Face for the file header line in `log-view-mode'."
  67   :group 'log-view)
  68 (defvar log-view-file-face 'log-view-file-face)
  69
  70 (defface log-view-message-face
  71   '((((class color) (background light))
  72      (:background "grey85"))
  73     (t (:bold t)))
  74   "Face for the message header line in `log-view-mode'."
  75   :group 'log-view)
  76 (defvar log-view-message-face 'log-view-message-face)
  77
  78 (defconst log-view-file-re
  79   (concat "^\\("
  80           "Working file: \\(.+\\)"
  81           "\\|SCCS/s\\.\\(.+\\):"
  82           "\\)\n"))
  83 (defconst log-view-message-re "^\\(revision \\([.0-9]+\\)\\|D \\([.0-9]+\\) .*\\)$")
  84
  85 (defconst log-view-font-lock-keywords
  86   `((,log-view-file-re
  87      (2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
  88      (3 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
  89      (0 log-view-file-face append))
  90     (,log-view-message-re . log-view-message-face)))
  91 (defconst log-view-font-lock-defaults
  92   '(log-view-font-lock-keywords t nil nil nil))
  93
  94 ;;;;
  95 ;;;; Actual code
  96 ;;;;
  97
  98 ;;;###autoload
  99 (define-derived-mode log-view-mode fundamental-mode "Log-View"
 100   "Major mode for browsing CVS log output."
 101   (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
 102   (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
 103
 104 ;;;;
 105 ;;;; Navigation
 106 ;;;;
 107
 108 ;; define log-view-{msg,file}-{next,prev}
 109 (easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
 110 (easy-mmode-define-navigation log-view-file log-view-file-re "file")
 111
 112 (defun log-view-goto-rev (rev)
 113   (goto-char (point-min))
 114   (ignore-errors
 115     (while (not (equal rev (log-view-current-tag)))
 116       (log-view-msg-next))
 117     t))
 118
 119 ;;;;
 120 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
 121 ;;;;
 122
 123 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
 124
 125 (defun log-view-current-file ()
 126   (save-excursion
 127     (forward-line 1)
 128     (or (re-search-backward log-view-file-re nil t)
 129         (re-search-forward log-view-file-re))
 130     (let* ((file (or (match-string 2) (match-string 3)))
 131            (cvsdir (and (re-search-backward log-view-dir-re nil t)
 132                         (match-string 1)))
 133            (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
 134                         (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 135                         (match-string 1)))
 136            (dir ""))
 137       (let ((default-directory ""))
 138         (when pcldir (setq dir (expand-file-name pcldir dir)))
 139         (when cvsdir (setq dir (expand-file-name cvsdir dir)))
 140         (expand-file-name file dir)))))
 141
 142 (defun log-view-current-tag ()
 143   (save-excursion
 144     (forward-line 1)
 145     (let ((pt (point)))
 146       (when (re-search-backward log-view-message-re nil t)
 147         (let ((rev (or (match-string 2) (match-string 3))))
 148           (unless (re-search-forward log-view-file-re pt t)
 149             rev))))))
 150
 151 (defun log-view-minor-wrap (buf f)
 152   (let ((data (with-current-buffer buf
 153                 (cons
 154                  (cons (log-view-current-file)
 155                        (log-view-current-tag))
 156                  (when mark-active
 157                    (save-excursion
 158                      (goto-char (mark))
 159                      (cons (log-view-current-file)
 160                            (log-view-current-tag))))))))
 161     (let ((cvs-branch-prefix (cdar data))
 162           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 163           (cvs-minor-current-files
 164            (cons (caar data)
 165                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 166                    (list (cadr data)))))
 167           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 168           (cvs-force-command "/F"))
 169       (funcall f))))
 170
 171 (provide 'log-view)
 172
 173 ;;; Change Log:
 174 ;; $Log: log-view.el,v $
 175 ;; Revision 1.3  2000/05/10 22:22:21  monnier
 176 ;; (log-view-goto-rev): New function for the new VC.
 177 ;; (log-view-minor-wrap): Use mark-active.
 178 ;;
 179 ;; Revision 1.2  2000/03/22 01:10:09  monnier
 180 ;; (log-view-(msg|file)-(prev|next)): Rename from
 181 ;; log-view-*-(message|file) and use easy-mmode-define-navigation.
 182 ;; (log-view-message-re): Match SCCS format as well.
 183 ;; And match the revision line rather than the dashed separator line.
 184 ;; (log-view-mode): Use the new define-derived-mode.
 185 ;; (log-view-current-tag): Fill in with an actual implementation.
 186 ;;
 187
 188 ;;; log-view.el ends here