lisp/log-view.el

   1 ;;; log-view.el --- Major mode for browsing CVS log output
   2
   3 ;; Copyright (C) 1999-2000  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
   6 ;; Keywords: pcl-cvs cvs log
   7 ;; Version: $Name:  $
   8 ;; Revision: $Id: log-view.el,v 1.1 2000/03/11 03:42:28 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
  34 ;;; Code:
  35
  36 (eval-when-compile (require 'cl))
  37 ;;(require 'pcvs-defs)
  38 (require 'pcvs-util)
  39
  40
  41 (defgroup log-view nil
  42   "Major mode for browsing log output for PCL-CVS."
  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   :inherit 'cvs-mode-map)
  56
  57 (defvar log-view-mode-hook nil
  58   "Hook run at the end of `log-view-mode'.")
  59
  60 (defface log-view-file-face
  61   '((((class color) (background light))
  62      (:background "grey70" :bold t))
  63     (t (:bold t)))
  64   "Face for the file header line in `log-view-mode'."
  65   :group 'log-view)
  66 (defvar log-view-file-face 'log-view-file-face)
  67
  68 (defface log-view-message-face
  69   '((((class color) (background light))
  70      (:background "grey85"))
  71     (t (:bold t)))
  72   "Face for the message header line in `log-view-mode'."
  73   :group 'log-view)
  74 (defvar log-view-message-face 'log-view-message-face)
  75
  76 (defconst log-view-file-re
  77   (concat "^\\("
  78           "Working file: \\(.+\\)"
  79           "\\|SCCS/s\\.\\(.+\\):"
  80           "\\)\n"))
  81 (defconst log-view-message-re "^\\(revision \\([.0-9]+\\)\\|D \\([.0-9]+\\) .*\\)$")
  82
  83 (defconst log-view-font-lock-keywords
  84   `((,log-view-file-re
  85      (2 'cvs-filename-face nil t)
  86      (3 'cvs-filename-face nil t)
  87      (0 'log-view-file-face append))
  88     (,log-view-message-re . log-view-message-face)))
  89 (defconst log-view-font-lock-defaults
  90   '(log-view-font-lock-keywords t nil nil nil))
  91
  92 ;;;;
  93 ;;;; Actual code
  94 ;;;;
  95
  96 ;;;###autoload
  97 (define-derived-mode log-view-mode fundamental-mode "Log-View"
  98   "Major mode for browsing CVS log output."
  99   (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
 100   (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
 101
 102 ;;;;
 103 ;;;; Navigation
 104 ;;;;
 105
 106 ;; define log-view-{msg,file}-{next,prev}
 107 (easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
 108 (easy-mmode-define-navigation log-view-file log-view-file-re "file")
 109
 110 ;;;;
 111 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
 112 ;;;;
 113
 114 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
 115
 116 (defun log-view-current-file ()
 117   (save-excursion
 118     (forward-line 1)
 119     (or (re-search-backward log-view-file-re nil t)
 120         (re-search-forward log-view-file-re))
 121     (let* ((file (or (match-string 2) (match-string 3)))
 122            (cvsdir (and (re-search-backward log-view-dir-re nil t)
 123                         (match-string 1)))
 124            (pcldir (and (re-search-backward cvs-pcl-cvs-dirchange-re nil t)
 125                         (match-string 1)))
 126            (dir ""))
 127       (let ((default-directory ""))
 128         (when pcldir (setq dir (expand-file-name pcldir dir)))
 129         (when cvsdir (setq dir (expand-file-name cvsdir dir)))
 130         (expand-file-name file dir)))))
 131
 132 (defun log-view-current-tag ()
 133   (save-excursion
 134     (forward-line 1)
 135     (let ((pt (point)))
 136       (when (re-search-backward log-view-message-re nil t)
 137         (let ((rev (or (match-string 2) (match-string 3))))
 138           (unless (re-search-forward log-view-file-re pt t)
 139             rev))))))
 140
 141 (defun log-view-minor-wrap (buf f)
 142   (let ((data (with-current-buffer buf
 143                 (cons
 144                  (cons (log-view-current-file)
 145                        (log-view-current-tag))
 146                  (when (ignore-errors (mark))
 147                    ;; `mark-active' is not provided by XEmacs :-(
 148                    (save-excursion
 149                      (goto-char (mark))
 150                      (cons (log-view-current-file)
 151                            (log-view-current-tag))))))))
 152     (let ((cvs-branch-prefix (cdar data))
 153           (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
 154           (cvs-minor-current-files
 155            (cons (caar data)
 156                  (when (and (cadr data) (not (equal (caar data) (cadr data))))
 157                    (list (cadr data)))))
 158           ;; FIXME:  I need to force because the fileinfos are UNKNOWN
 159           (cvs-force-command "/F"))
 160       (funcall f))))
 161
 162 (provide 'log-view)
 163
 164 ;;; Change Log:
 165 ;; $Log$
 166
 167 ;;; log-view.el ends here