log-view.el 10.1 KB
Newer Older
Stefan Monnier's avatar
Stefan Monnier committed
1
;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output
Stefan Monnier's avatar
Stefan Monnier committed
2

3
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2006, 2007 Free Software Foundation, Inc.
Stefan Monnier's avatar
Stefan Monnier committed
5

Stefan Monnier's avatar
Stefan Monnier committed
6
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
Stefan Monnier's avatar
Stefan Monnier committed
7
;; Keywords: rcs sccs cvs log version-control
Stefan Monnier's avatar
Stefan Monnier committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Stefan Monnier's avatar
Stefan Monnier committed
25 26 27

;;; Commentary:

28 29
;; Major mode to browse revision log histories.
;; Currently supports the format output by:
30
;;  RCS, SCCS, CVS, Subversion, and DaRCS.
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

;; Examples of log output:

;;;; RCS/CVS:

;; ----------------------------
;; revision 1.35	locked by: turlutut
;; date: 2005-03-22 18:48:38 +0000;  author: monnier;  state: Exp;  lines: +6 -8
;; (gnus-display-time-event-handler):
;; Check display-time-timer at runtime rather than only at load time
;; in case display-time-mode is turned off in the mean time.
;; ----------------------------
;; revision 1.34
;; date: 2005-02-09 15:50:38 +0000;  author: kfstorm;  state: Exp;  lines: +7 -7
;; branches:  1.34.2;
;; Change release version from 21.4 to 22.1 throughout.
;; Change development version from 21.3.50 to 22.0.50.

;;;; SCCS:

;;;; Subversion:

53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
;;;; Darcs:

;; Changes to darcsum.el:
;; 
;; Mon Nov 28 15:19:38 GMT 2005  Dave Love <fx@gnu.org>
;;   * Abstract process startup into darcsum-start-process.  Use TERM=dumb.
;;   TERM=dumb avoids escape characters, at least, for any old darcs that 
;;   doesn't understand DARCS_DONT_COLOR & al.
;; 
;; Thu Nov 24 15:20:45 GMT 2005  Dave Love <fx@gnu.org>
;;   * darcsum-mode-related changes.
;;   Don't call font-lock-mode (unnecessary) or use-local-map (redundant).
;;   Use mode-class 'special.  Add :group.
;;   Add trailing-whitespace option to mode hook and fix
;;   darcsum-display-changeset not to use trailing whitespace.

69
;;; Todo:
Stefan Monnier's avatar
Stefan Monnier committed
70 71

;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
Stefan Monnier's avatar
Stefan Monnier committed
72
;; - remove references to cvs-*
73
;; - make it easier to add support for new backends without changing the code.
Stefan Monnier's avatar
Stefan Monnier committed
74 75 76 77 78

;;; Code:

(eval-when-compile (require 'cl))
(require 'pcvs-util)
79
(autoload 'vc-find-version "vc")
80
(autoload 'vc-version-diff "vc")
Stefan Monnier's avatar
Stefan Monnier committed
81

82 83
(defvar cvs-minor-wrap-function)

Stefan Monnier's avatar
Stefan Monnier committed
84
(defgroup log-view nil
Stefan Monnier's avatar
Stefan Monnier committed
85
  "Major mode for browsing log output of RCS/CVS/SCCS."
Stefan Monnier's avatar
Stefan Monnier committed
86 87 88 89
  :group 'pcl-cvs
  :prefix "log-view-")

(easy-mmode-defmap log-view-mode-map
90 91 92
  '(("q" . quit-window)
    ("z" . kill-this-buffer)
    ("m" . set-mark-command)
93
    ;; ("e" . cvs-mode-edit-log)
94
    ("d" . log-view-diff)
95
    ("f" . log-view-find-version)
96
    ("n" . log-view-msg-next)
97 98 99
    ("p" . log-view-msg-prev)
    ("N" . log-view-file-next)
    ("P" . log-view-file-prev)
100 101
    ("\M-n" . log-view-file-next)
    ("\M-p" . log-view-file-prev))
Stefan Monnier's avatar
Stefan Monnier committed
102 103
  "Log-View's keymap."
  :group 'log-view
Stefan Monnier's avatar
Stefan Monnier committed
104 105 106
  ;; Here I really need either buffer-local keymap-inheritance
  ;; or a minor-mode-map with lower precedence than the local map.
  :inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
Stefan Monnier's avatar
Stefan Monnier committed
107

108 109 110 111 112 113 114 115 116 117 118 119 120 121
(easy-menu-define log-view-mode-menu log-view-mode-map
  "Log-View Display Menu"
  `("Log-View"
    ;; XXX Do we need menu entries for these?
    ;; ["Quit"  quit-window]
    ;; ["Kill This Buffer"  kill-this-buffer]
    ["Mark Log Entry for Diff"  set-mark-command]
    ["Diff Revisions"  log-view-diff]
    ["Visit Version"  log-view-find-version]
    ["Next Log Entry"  log-view-msg-next]
    ["Previous Log Entry"  log-view-msg-prev]
    ["Next File"  log-view-file-next]
    ["Previous File"  log-view-file-prev]))

Stefan Monnier's avatar
Stefan Monnier committed
122 123 124
(defvar log-view-mode-hook nil
  "Hook run at the end of `log-view-mode'.")

125
(defface log-view-file
Stefan Monnier's avatar
Stefan Monnier committed
126
  '((((class color) (background light))
127 128
     (:background "grey70" :weight bold))
    (t (:weight bold)))
Stefan Monnier's avatar
Stefan Monnier committed
129 130
  "Face for the file header line in `log-view-mode'."
  :group 'log-view)
131 132 133
;; backward-compatibility alias
(put 'log-view-file-face 'face-alias 'log-view-file)
(defvar log-view-file-face 'log-view-file)
Stefan Monnier's avatar
Stefan Monnier committed
134

135
(defface log-view-message
Stefan Monnier's avatar
Stefan Monnier committed
136 137
  '((((class color) (background light))
     (:background "grey85"))
138
    (t (:weight bold)))
Stefan Monnier's avatar
Stefan Monnier committed
139 140
  "Face for the message header line in `log-view-mode'."
  :group 'log-view)
141 142 143
;; backward-compatibility alias
(put 'log-view-message-face 'face-alias 'log-view-message)
(defvar log-view-message-face 'log-view-message)
Stefan Monnier's avatar
Stefan Monnier committed
144 145

(defconst log-view-file-re
146
  (concat "^\\(?:Working file: \\(.+\\)"                ;RCS and CVS.
147
          "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(.+\\):" ;SCCS and Darcs.
148 149 150 151 152 153
	  "\\)\n"))                   ;Include the \n for font-lock reasons.

(defconst log-view-message-re
  (concat "^\\(?:revision \\([.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
          "\\|r\\([0-9]+\\) | .* | .*"                ; Subversion.
          "\\|D \\([.0-9]+\\) .*"                     ; SCCS.
154 155 156 157 158 159 160 161 162
          ;; Darcs doesn't have revision names.  VC-darcs uses patch names
          ;; instead.  Darcs patch names are hashcodes, which do not appear
          ;; in the log output :-(, but darcs accepts any prefix of the log
          ;; message as a patch name, so we match the first line of the log
          ;; message.
          ;; First loosely match the date format.
          (concat "\\|[^ \n].*[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].*[^ \n]"
                  ;;Email of user and finally Msg, used as revision name.
                  "  .*@.*\n\\(?:  \\* \\(.*\\)\\)?")
163
          "\\)$"))
Stefan Monnier's avatar
Stefan Monnier committed
164 165 166

(defconst log-view-font-lock-keywords
  `((,log-view-file-re
167
     (1 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
Stefan Monnier's avatar
Stefan Monnier committed
168 169
     (2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
     (0 log-view-file-face append))
Stefan Monnier's avatar
Stefan Monnier committed
170 171 172 173
    (,log-view-message-re . log-view-message-face)))
(defconst log-view-font-lock-defaults
  '(log-view-font-lock-keywords t nil nil nil))

Sam Steingold's avatar
Sam Steingold committed
174
;;;;
Stefan Monnier's avatar
Stefan Monnier committed
175
;;;; Actual code
Sam Steingold's avatar
Sam Steingold committed
176
;;;;
Stefan Monnier's avatar
Stefan Monnier committed
177 178

;;;###autoload
179
(define-derived-mode log-view-mode fundamental-mode "Log-View"
Stefan Monnier's avatar
Stefan Monnier committed
180
  "Major mode for browsing CVS log output."
181
  (setq buffer-read-only t)
Stefan Monnier's avatar
Stefan Monnier committed
182 183 184 185 186 187 188
  (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
  (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))

;;;;
;;;; Navigation
;;;;

189 190 191
;; define log-view-{msg,file}-{next,prev}
(easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
(easy-mmode-define-navigation log-view-file log-view-file-re "file")
Stefan Monnier's avatar
Stefan Monnier committed
192

193 194 195 196 197 198 199
(defun log-view-goto-rev (rev)
  (goto-char (point-min))
  (ignore-errors
    (while (not (equal rev (log-view-current-tag)))
      (log-view-msg-next))
    t))

Stefan Monnier's avatar
Stefan Monnier committed
200 201 202 203 204 205 206 207 208 209 210
;;;;
;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
;;;;

(defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")

(defun log-view-current-file ()
  (save-excursion
    (forward-line 1)
    (or (re-search-backward log-view-file-re nil t)
	(re-search-forward log-view-file-re))
211
    (let* ((file (or (match-string 1) (match-string 2)))
Stefan Monnier's avatar
Stefan Monnier committed
212 213
	   (cvsdir (and (re-search-backward log-view-dir-re nil t)
			(match-string 1)))
Stefan Monnier's avatar
Stefan Monnier committed
214 215
	   (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
			(re-search-backward cvs-pcl-cvs-dirchange-re nil t)
Stefan Monnier's avatar
Stefan Monnier committed
216 217 218 219
			(match-string 1)))
	   (dir ""))
      (let ((default-directory ""))
	(when pcldir (setq dir (expand-file-name pcldir dir)))
220 221
	(when cvsdir (setq dir (expand-file-name cvsdir dir))))
      (expand-file-name file dir))))
Stefan Monnier's avatar
Stefan Monnier committed
222

223
(defun log-view-current-tag (&optional where)
224
  (save-excursion
225
    (when where (goto-char where))
226 227 228
    (forward-line 1)
    (let ((pt (point)))
      (when (re-search-backward log-view-message-re nil t)
229 230
        (let (rev)
          ;; Find the subgroup that matched.
231
          (dotimes (i (/ (length (match-data 'integers)) 2))
232
            (setq rev (or rev (match-string (1+ i)))))
233 234
	  (unless (re-search-forward log-view-file-re pt t)
	    rev))))))
Stefan Monnier's avatar
Stefan Monnier committed
235

236 237 238 239
(defvar cvs-minor-current-files)
(defvar cvs-branch-prefix)
(defvar cvs-secondary-branch-prefix)

Stefan Monnier's avatar
Stefan Monnier committed
240 241
(defun log-view-minor-wrap (buf f)
  (let ((data (with-current-buffer buf
242 243
		(let* ((beg (point))
		       (end (if mark-active (mark) (point)))
244 245 246 247 248 249 250 251
		       (fr (log-view-current-tag beg))
		       (to (log-view-current-tag end)))
		  (when (string-equal fr to)
		    (save-excursion
		      (goto-char end)
		      (log-view-msg-next)
		      (setq to (log-view-current-tag))))
		  (cons
252 253 254 255 256
                   ;; The first revision has to be the one at point, for
                   ;; operations that only take one revision
                   ;; (e.g. cvs-mode-edit).
		   (cons (log-view-current-file) fr)
		   (cons (log-view-current-file) to))))))
Stefan Monnier's avatar
Stefan Monnier committed
257 258 259 260 261 262 263 264 265 266
    (let ((cvs-branch-prefix (cdar data))
	  (cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
	  (cvs-minor-current-files
	   (cons (caar data)
		 (when (and (cadr data) (not (equal (caar data) (cadr data))))
		   (list (cadr data)))))
	  ;; FIXME:  I need to force because the fileinfos are UNKNOWN
	  (cvs-force-command "/F"))
      (funcall f))))

267 268 269 270 271
(defun log-view-find-version (pos)
  "Visit the version at point."
  (interactive "d")
  (save-excursion
    (goto-char pos)
272
    (switch-to-buffer (vc-find-version (log-view-current-file)
273 274
                                       (log-view-current-tag)))))

275 276 277
;;
;; diff
;;
278 279

(defun log-view-diff (beg end)
Juri Linkov's avatar
Juri Linkov committed
280 281 282 283 284
  "Get the diff between two revisions.
If the mark is not active or the mark is on the revision at point,
get the diff between the revision at point and its previous revision.
Otherwise, get the diff between the revisions where the region starts
and ends."
285 286 287
  (interactive
   (list (if mark-active (region-beginning) (point))
         (if mark-active (region-end) (point))))
288 289 290 291 292 293 294 295 296
  (let ((fr (log-view-current-tag beg))
        (to (log-view-current-tag end)))
    (when (string-equal fr to)
      (save-excursion
        (goto-char end)
        (log-view-msg-next)
        (setq to (log-view-current-tag))))
    (vc-version-diff (log-view-current-file) to fr)))

Stefan Monnier's avatar
Stefan Monnier committed
297
(provide 'log-view)
298

299
;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f
Stefan Monnier's avatar
Stefan Monnier committed
300
;;; log-view.el ends here