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  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: rcs sccs cvs log version-control
   7 ;; Revision: $Id: log-view.el,v 1.6 2000/12/18 03:17:31 monnier 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 ;; - add compatibility with cvs-log.el
  31 ;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
  32 ;; - remove references to cvs-*
  33
  34 ;;; Code:
  35
  36 (eval-when-compile (require 'cl))
  37 (require 'pcvs-util)
  38
  39
  40 (defgroup log-view nil
  41   "Major mode for browsing log output of RCS/CVS/SCCS."
  42   :group 'pcl-cvs
  43   :prefix "log-view-")
  44
  45 (easy-mmode-defmap log-view-mode-map
  46   '(("n" . log-view-msg-next)
  47     ("p" . log-view-msg-prev)
  48     ("N" . log-view-file-next)
  49     ("P" . log-view-file-prev)
  50     ("\M-n" . log-view-file-next)
  51     ("\M-p" . log-view-file-prev))
  52   "Log-View's keymap."
  53   :group 'log-view
  54   ;; Here I really need either buffer-local keymap-inheritance
  55   ;; or a minor-mode-map with lower precedence than the local map.
  56   :inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
  57
  58 (defvar log-view-mode-hook nil
  59   "Hook run at the end of `log-view-mode'.")
  60
  61 (defface log-view-file-face
  62   '((((class color) (background light))
  63      (:background "grey70" :bold t))
  64     (t (:bold t)))
  65   "Face for the file header line in `log-view-mode'."
  66   :group 'log-view)
  67 (defvar log-view-file-face 'log-view-file-face)
  68
  69 (defface log-view-message-face
  70   '((((class color) (background light))
  71      (:background "grey85"))
  72     (t (:bold t)))
  73   "Face for the message header line in `log-view-mode'."
  74   :group 'log-view)
  75 (defvar log-view-message-face 'log-view-message-face)
  76
  77 (defconst log-view-file-re
  78   (concat "^\\("
  79           "Working file: \\(.+\\)"
  80           "\\|SCCS/s\\.\\(.+\\):"
  81           "\\)\n"))
  82 (defconst log-view-message-re "^\\(revision \\([.0-9]+\\)\\|D \\([.0-9]+\\) .*\\)$")
  83
  84 (defconst log-view-font-lock-keywords
  85   `((,log-view-file-re
  86      (2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
  87      (3 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
  88      (0 log-view-file-face append))
  89     (,log-view-message-re . log-view-message-face)))
  90 (defconst log-view-font-lock-defaults
  91   '(log-view-font-lock-keywords t nil nil nil))
  92
  93 ;;;;
  94 ;;;; Actual code
  95 ;;;;
  96
  97 ;;;###autoload
  98 (define-derived-mode log-view-mode fundamental-mode "Log-View"
  99   "Major mode for browsing CVS log output."
 100   (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
 101   (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
 102
 103 ;;;;
 104 ;;;; Navigation
 105 ;;;;
 106
 107 ;; define log-view-{msg,file}-{next,prev}
 108 (easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
 109 (easy-mmode-define-navigation log-view-file log-view-file-re "file")
 110
 111 (defun log-view-goto-rev (rev)
 112   (goto-char (point-min))
 113   (ignore-errors
 114     (while (not (equal rev (log-view-current-tag)))
 115       (log-view-msg-next))
 116     t))
 117
 118 ;;;;
 119 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
 120 ;;;;
 121
 122 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
 123
 124 (defun log-view-current-file ()
 125   (save-excursion
 126     (forward-line 1)
 127     (or (re-search-backward log-view-file-re nil t)
 128         (re-search-forward log-view-file-re))
 129     (let* ((file (or (match-string 2) (match-string 3)))
 130            (cvsdir (and (re-search-backward log-view-dir-re nil t)
 131                         (match-string 1)))
 132            (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
 133                         (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 134                         (match-string 1)))
 135            (dir ""))
 136       (let ((default-directory ""))
 137         (when pcldir (setq dir (expand-file-name pcldir dir)))
 138         (when cvsdir (setq dir (expand-file-name cvsdir dir)))
 139         (expand-file-name file dir)))))
 140
 141 (defun log-view-current-tag ()
 142   (save-excursion
 143     (forward-line 1)
 144     (let ((pt (point)))
 145       (when (re-search-backward log-view-message-re nil t)
 146         (let ((rev (or (match-string 2) (match-string 3))))
 147           (unless (re-search-forward log-view-file-re pt t)
 148             rev))))))
 149
 150 (defun log-view-minor-wrap (buf f)
 151   (let ((data (with-current-buffer buf
 152                 (cons
 153                  (cons (log-view-current-file)
 154                        (log-view-current-tag))
 155                  (when mark-active
 156                    (save-excursion
 157                      (goto-char (mark))
 158                      (cons (log-view-current-file)
 159                            (log-view-current-tag))))))))
 160     (let ((cvs-branch-prefix (cdar data))
 161           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 162           (cvs-minor-current-files
 163            (cons (caar data)
 164                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 165                    (list (cadr data)))))
 166           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 167           (cvs-force-command "/F"))
 168       (funcall f))))
 169
 170 (provide 'log-view)
 171
 172 ;;; Change Log:
 173 ;; $Log: log-view.el,v $
 174 ;; Revision 1.6  2000/12/18 03:17:31  monnier
 175 ;; Remove useless Version.
 176 ;;
 177 ;; Revision 1.5  2000/12/06 19:49:40  fx
 178 ;; Fix copyright years.
 179 ;;
 180 ;; Revision 1.4  2000/05/21 02:12:34  monnier
 181 ;; Fix file description.
 182 ;; (log-view-mode-map): Unsatisfying fix for when cvs-mode-map is not
 183 ;; available.
 184 ;; (log-view-font-lock-keywords): Only use cvs-filename-face if present.
 185 ;; (log-view-current-file): Only use cvs-pcl-cvs-dirchange-re if present.
 186 ;;
 187 ;; Revision 1.3  2000/05/10 22:22:21  monnier
 188 ;; (log-view-goto-rev): New function for the new VC.
 189 ;; (log-view-minor-wrap): Use mark-active.
 190 ;;
 191 ;; Revision 1.2  2000/03/22 01:10:09  monnier
 192 ;; (log-view-(msg|file)-(prev|next)): Rename from
 193 ;; log-view-*-(message|file) and use easy-mmode-define-navigation.
 194 ;; (log-view-message-re): Match SCCS format as well.
 195 ;; And match the revision line rather than the dashed separator line.
 196 ;; (log-view-mode): Use the new define-derived-mode.
 197 ;; (log-view-current-tag): Fill in with an actual implementation.
 198 ;;
 199
 200 ;;; log-view.el ends here