[bpt/emacs.git] / lisp / log-view.el

;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output

;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;;   2006, 2007 Free Software Foundation, Inc.

;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: rcs sccs cvs log version-control

;; 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 3, 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
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; Major mode to browse revision log histories.
;; Currently supports the format output by:
;;  RCS, SCCS, CVS, Subversion, and DaRCS.

;; 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:

;;;; 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.

;;; Todo:

;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
;; - remove references to cvs-*
;; - make it easier to add support for new backends without changing the code.

;;; Code:

(eval-when-compile (require 'cl))
(require 'pcvs-util)
(autoload 'vc-find-version "vc")
(autoload 'vc-version-diff "vc")

(defvar cvs-minor-wrap-function)

(defgroup log-view nil
  "Major mode for browsing log output of RCS/CVS/SCCS."
  :group 'pcl-cvs
  :prefix "log-view-")

(easy-mmode-defmap log-view-mode-map
  '(("q" . quit-window)
    ("z" . kill-this-buffer)
    ("m" . log-view-toggle-mark-entry)
    ;; ("e" . cvs-mode-edit-log)
    ("d" . log-view-diff)
    ("f" . log-view-find-version)
    ("n" . log-view-msg-next)
    ("p" . log-view-msg-prev)
    ("N" . log-view-file-next)
    ("P" . log-view-file-prev)
    ("\M-n" . log-view-file-next)
    ("\M-p" . log-view-file-prev))
  "Log-View's keymap."
  :group 'log-view
  ;; 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))

(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]))

(defvar log-view-mode-hook nil
  "Hook run at the end of `log-view-mode'.")

(defface log-view-file
  '((((class color) (background light))
     (:background "grey70" :weight bold))
    (t (:weight bold)))
  "Face for the file header line in `log-view-mode'."
  :group 'log-view)
;; backward-compatibility alias
(put 'log-view-file-face 'face-alias 'log-view-file)
(defvar log-view-file-face 'log-view-file)

(defface log-view-message
  '((((class color) (background light))
     (:background "grey85"))
    (t (:weight bold)))
  "Face for the message header line in `log-view-mode'."
  :group 'log-view)
;; backward-compatibility alias
(put 'log-view-message-face 'face-alias 'log-view-message)
(defvar log-view-message-face 'log-view-message)

(defvar log-view-file-re
  (concat "^\\(?:Working file: \\(?1:.+\\)"                ;RCS and CVS.
          ;; Subversion has no such thing??
          "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(?1:.+\\):" ;SCCS and Darcs.
	  "\\)\n")                    ;Include the \n for font-lock reasons.
  "Regexp matching the text identifying the file.
The match group number 1 should match the file name itself.")

(defvar log-view-message-re
  (concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
          "\\|r\\(?1:[0-9]+\\) | .* | .*"                ; Subversion.
          "\\|D \\(?1:[.0-9]+\\) .*"                     ; SCCS.
          ;; 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\\(?:  \\* \\(?1:.*\\)\\)?")
          "\\)$")
  "Regexp matching the text identifying a revision.
The match group number 1 should match the revision number itself.")

(defvar log-view-font-lock-keywords
  ;; We use `eval' so as to use the buffer-local value of log-view-file-re
  ;; and log-view-message-re, if applicable.
  '((eval . `(,log-view-file-re
              (1 (if (boundp 'cvs-filename-face) cvs-filename-face))
              (0 log-view-file-face append)))
    (eval . `(,log-view-message-re . log-view-message-face))))

(defconst log-view-font-lock-defaults
  '(log-view-font-lock-keywords t nil nil nil))

;;;;
;;;; Actual code
;;;;

;;;###autoload
(define-derived-mode log-view-mode fundamental-mode "Log-View"
  "Major mode for browsing CVS log output."
  (setq buffer-read-only t)
  (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
;;;;

;; 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")

(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))

;;;;
;;;; 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 nil t)
	(error "Unable to determine the current file"))
    (let* ((file (match-string 1))
	   (cvsdir (and (re-search-backward log-view-dir-re nil t)
			(match-string 1)))
	   (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
			(re-search-backward cvs-pcl-cvs-dirchange-re nil t)
			(match-string 1)))
	   (dir ""))
      (let ((default-directory ""))
	(when pcldir (setq dir (expand-file-name pcldir dir)))
	(when cvsdir (setq dir (expand-file-name cvsdir dir))))
      (expand-file-name file dir))))

(defun log-view-current-tag (&optional where)
  (save-excursion
    (when where (goto-char where))
    (forward-line 1)
    (let ((pt (point)))
      (when (re-search-backward log-view-message-re nil t)
	(let ((rev (match-string-no-properties 1)))
	  (unless (re-search-forward log-view-file-re pt t)
	    rev))))))

(defun log-view-toggle-mark-entry ()
  "Toggle the marked state for the log entry at point.
Individual log entries can be marked and unmarked. The marked
entries are denoted by changing their background color.
`log-view-get-marked' returns the list of tags for the marked
log entries."
  (interactive)
  (save-excursion
    (forward-line 1)
    (let ((pt (point)))
      (when (re-search-backward log-view-message-re nil t)
	(let ((beg (match-beginning 0))
	      end ov ovlist found tag)
	  (unless (re-search-forward log-view-file-re pt t)
	    ;; Look to see if the current entry is marked.
	    (setq found (get-char-property (point) 'log-view-self))
	    (if found
		(delete-overlay found)
	      ;; Create an overlay that covers this entry and change
	      ;; it's color.
	      (setq tag (log-view-current-tag (point)))
	      (forward-line 1)
	      (setq end
		    (if (re-search-forward log-view-message-re nil t)
			(match-beginning 0)
		      (point-max)))
	      (setq ov (make-overlay beg end))
	      (overlay-put ov 'face 'log-view-file)
	      ;; This is used to check if the overlay is present.
	      (overlay-put ov 'log-view-self ov)
	      (overlay-put ov 'log-view-marked tag))))))))

(defun log-view-get-marked ()
  "Return the list of tags for the marked log entries."
  (save-excursion
    (let ((pos (point-min))
	  marked-list ov)
      (while (setq pos (next-single-property-change pos 'face))
	(when (setq ov (get-char-property pos 'log-view-self))
	  (push (overlay-get ov 'log-view-marked) marked-list)
	  (setq pos (overlay-end ov))))
      marked-list)))

(defvar cvs-minor-current-files)
(defvar cvs-branch-prefix)
(defvar cvs-secondary-branch-prefix)

(defun log-view-minor-wrap (buf f)
  (let ((data (with-current-buffer buf
		(let* ((beg (point))
		       (end (if mark-active (mark) (point)))
		       (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
                   ;; 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))))))
    (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))))

(defun log-view-find-version (pos)
  "Visit the version at point."
  (interactive "d")
  (save-excursion
    (goto-char pos)
    (switch-to-buffer (vc-find-version (log-view-current-file)
                                       (log-view-current-tag)))))

;;
;; diff
;;

(defun log-view-diff (beg end)
  "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."
  (interactive
   (list (if mark-active (region-beginning) (point))
         (if mark-active (region-end) (point))))
  (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)))

(provide 'log-view)

;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f
;;; log-view.el ends here
Commit	Line	Data
e57a1038	1	;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output
5b467bf4	2
aaef169d	3	;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
d7a0267c	4	;; 2006, 2007 Free Software Foundation, Inc.
5b467bf4	5
cc1eecfd	6	;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
e57a1038	7	;; Keywords: rcs sccs cvs log version-control
5b467bf4 SM	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
b4aa6026	13	;; the Free Software Foundation; either version 3, or (at your option)
5b467bf4 SM	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
086add15 LK	23	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
086add15 LK	24	;; Boston, MA 02110-1301, USA.
5b467bf4 SM	25
	26	;;; Commentary:
	27
aa230d94 SM	28	;; Major mode to browse revision log histories.
aa230d94 SM	29	;; Currently supports the format output by:
62c5f375	30	;; RCS, SCCS, CVS, Subversion, and DaRCS.
aa230d94 SM	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
62c5f375 SM	53	;;;; Darcs:
	54
	55	;; Changes to darcsum.el:
	56	;;
	57	;; Mon Nov 28 15:19:38 GMT 2005 Dave Love <fx@gnu.org>
	58	;; * Abstract process startup into darcsum-start-process. Use TERM=dumb.
	59	;; TERM=dumb avoids escape characters, at least, for any old darcs that
	60	;; doesn't understand DARCS_DONT_COLOR & al.
	61	;;
	62	;; Thu Nov 24 15:20:45 GMT 2005 Dave Love <fx@gnu.org>
	63	;; * darcsum-mode-related changes.
	64	;; Don't call font-lock-mode (unnecessary) or use-local-map (redundant).
	65	;; Use mode-class 'special. Add :group.
	66	;; Add trailing-whitespace option to mode hook and fix
	67	;; darcsum-display-changeset not to use trailing whitespace.
	68
aa230d94	69	;;; Todo:
5b467bf4	70
5b467bf4	71	;; - add ability to modify a log-entry (via cvs-mode-admin ;-)
e57a1038	72	;; - remove references to cvs-*
aa230d94	73	;; - make it easier to add support for new backends without changing the code.
5b467bf4 SM	74
	75	;;; Code:
	76
	77	(eval-when-compile (require 'cl))
5b467bf4	78	(require 'pcvs-util)
efa7e86f	79	(autoload 'vc-find-version "vc")
99cb8c8b	80	(autoload 'vc-version-diff "vc")
5b467bf4	81
71f6f911 JB	82	(defvar cvs-minor-wrap-function)
71f6f911 JB	83
5b467bf4	84	(defgroup log-view nil
e57a1038	85	"Major mode for browsing log output of RCS/CVS/SCCS."
5b467bf4 SM	86	:group 'pcl-cvs
	87	:prefix "log-view-")
	88
	89	(easy-mmode-defmap log-view-mode-map
99cb8c8b SS	90	'(("q" . quit-window)
99cb8c8b SS	91	("z" . kill-this-buffer)
83db937c	92	("m" . log-view-toggle-mark-entry)
2a673b03	93	;; ("e" . cvs-mode-edit-log)
99cb8c8b	94	("d" . log-view-diff)
c0313667	95	("f" . log-view-find-version)
99cb8c8b	96	("n" . log-view-msg-next)
cdbb990f SM	97	("p" . log-view-msg-prev)
	98	("N" . log-view-file-next)
	99	("P" . log-view-file-prev)
e2c2a3e2 KG	100	("\M-n" . log-view-file-next)
e2c2a3e2 KG	101	("\M-p" . log-view-file-prev))
5b467bf4 SM	102	"Log-View's keymap."
5b467bf4 SM	103	:group 'log-view
e57a1038 SM	104	;; Here I really need either buffer-local keymap-inheritance
	105	;; or a minor-mode-map with lower precedence than the local map.
	106	:inherit (if (boundp 'cvs-mode-map) cvs-mode-map))
5b467bf4	107
d621bc0a DN	108	(easy-menu-define log-view-mode-menu log-view-mode-map
	109	"Log-View Display Menu"
	110	`("Log-View"
	111	;; XXX Do we need menu entries for these?
	112	;; ["Quit" quit-window]
	113	;; ["Kill This Buffer" kill-this-buffer]
	114	["Mark Log Entry for Diff" set-mark-command]
	115	["Diff Revisions" log-view-diff]
	116	["Visit Version" log-view-find-version]
	117	["Next Log Entry" log-view-msg-next]
	118	["Previous Log Entry" log-view-msg-prev]
	119	["Next File" log-view-file-next]
	120	["Previous File" log-view-file-prev]))
	121
5b467bf4 SM	122	(defvar log-view-mode-hook nil
	123	"Hook run at the end of `log-view-mode'.")
	124
d842de85	125	(defface log-view-file
5b467bf4	126	'((((class color) (background light))
1fd714a4 RS	127	(:background "grey70" :weight bold))
1fd714a4 RS	128	(t (:weight bold)))
5b467bf4 SM	129	"Face for the file header line in `log-view-mode'."
5b467bf4 SM	130	:group 'log-view)
d842de85 MB	131	;; backward-compatibility alias
	132	(put 'log-view-file-face 'face-alias 'log-view-file)
	133	(defvar log-view-file-face 'log-view-file)
5b467bf4	134
d842de85	135	(defface log-view-message
5b467bf4 SM	136	'((((class color) (background light))
5b467bf4 SM	137	(:background "grey85"))
1fd714a4	138	(t (:weight bold)))
5b467bf4 SM	139	"Face for the message header line in `log-view-mode'."
5b467bf4 SM	140	:group 'log-view)
d842de85 MB	141	;; backward-compatibility alias
	142	(put 'log-view-message-face 'face-alias 'log-view-message)
	143	(defvar log-view-message-face 'log-view-message)
5b467bf4	144
18b2e5b9	145	(defvar log-view-file-re
95588f91 SM	146	(concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS.
	147	;; Subversion has no such thing??
	148	"\\\|\\(?:SCCS/s\\.\\\|Changes to \\)\\(?1:.+\\):" ;SCCS and Darcs.
2ef3b3fe SM	149	"\\)\n") ;Include the \n for font-lock reasons.
	150	"Regexp matching the text identifying the file.
	151	The match group number 1 should match the file name itself.")
aa230d94	152
18b2e5b9	153	(defvar log-view-message-re
95588f91 SM	154	(concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
	155	"\\\|r\\(?1:[0-9]+\\) \| .* \| .*" ; Subversion.
	156	"\\\|D \\(?1:[.0-9]+\\) .*" ; SCCS.
62c5f375 SM	157	;; Darcs doesn't have revision names. VC-darcs uses patch names
	158	;; instead. Darcs patch names are hashcodes, which do not appear
	159	;; in the log output :-(, but darcs accepts any prefix of the log
	160	;; message as a patch name, so we match the first line of the log
	161	;; message.
	162	;; First loosely match the date format.
	163	(concat "\\\|[^ \n].[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].[^ \n]"
	164	;;Email of user and finally Msg, used as revision name.
95588f91	165	" .@.\n\\(?: \\* \\(?1:.*\\)\\)?")
2ef3b3fe SM	166	"\\)$")
	167	"Regexp matching the text identifying a revision.
	168	The match group number 1 should match the revision number itself.")
5b467bf4	169
18b2e5b9 SM	170	(defvar log-view-font-lock-keywords
	171	;; We use `eval' so as to use the buffer-local value of log-view-file-re
	172	;; and log-view-message-re, if applicable.
	173	'((eval . `(,log-view-file-re
	174	(1 (if (boundp 'cvs-filename-face) cvs-filename-face))
	175	(0 log-view-file-face append)))
	176	(eval . `(,log-view-message-re . log-view-message-face))))
5bdc71d0	177
5b467bf4 SM	178	(defconst log-view-font-lock-defaults
	179	'(log-view-font-lock-keywords t nil nil nil))
	180
edb33387	181	;;;;
5b467bf4	182	;;;; Actual code
edb33387	183	;;;;
5b467bf4 SM	184
5b467bf4 SM	185	;;;###autoload
cdbb990f	186	(define-derived-mode log-view-mode fundamental-mode "Log-View"
5b467bf4	187	"Major mode for browsing CVS log output."
99cb8c8b	188	(setq buffer-read-only t)
5b467bf4 SM	189	(set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults)
	190	(set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap))
	191
	192	;;;;
	193	;;;; Navigation
	194	;;;;
	195
cdbb990f SM	196	;; define log-view-{msg,file}-{next,prev}
	197	(easy-mmode-define-navigation log-view-msg log-view-message-re "log message")
	198	(easy-mmode-define-navigation log-view-file log-view-file-re "file")
5b467bf4	199
3e87f5fc SM	200	(defun log-view-goto-rev (rev)
	201	(goto-char (point-min))
	202	(ignore-errors
	203	(while (not (equal rev (log-view-current-tag)))
	204	(log-view-msg-next))
	205	t))
	206
5b467bf4 SM	207	;;;;
	208	;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el)
	209	;;;;
	210
	211	(defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
	212
	213	(defun log-view-current-file ()
	214	(save-excursion
	215	(forward-line 1)
	216	(or (re-search-backward log-view-file-re nil t)
22f4e5c1	217	(re-search-forward log-view-file-re nil t)
ccf89694	218	(error "Unable to determine the current file"))
95588f91	219	(let* ((file (match-string 1))
5b467bf4 SM	220	(cvsdir (and (re-search-backward log-view-dir-re nil t)
5b467bf4 SM	221	(match-string 1)))
e57a1038 SM	222	(pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
e57a1038 SM	223	(re-search-backward cvs-pcl-cvs-dirchange-re nil t)
5b467bf4 SM	224	(match-string 1)))
	225	(dir ""))
	226	(let ((default-directory ""))
	227	(when pcldir (setq dir (expand-file-name pcldir dir)))
99cb8c8b SS	228	(when cvsdir (setq dir (expand-file-name cvsdir dir))))
99cb8c8b SS	229	(expand-file-name file dir))))
5b467bf4	230
99cb8c8b	231	(defun log-view-current-tag (&optional where)
cdbb990f	232	(save-excursion
99cb8c8b	233	(when where (goto-char where))
cdbb990f SM	234	(forward-line 1)
	235	(let ((pt (point)))
	236	(when (re-search-backward log-view-message-re nil t)
3a44b2ae	237	(let ((rev (match-string-no-properties 1)))
cdbb990f SM	238	(unless (re-search-forward log-view-file-re pt t)
cdbb990f SM	239	rev))))))
5b467bf4	240
83db937c	241	(defun log-view-toggle-mark-entry ()
a0902360 DN	242	"Toggle the marked state for the log entry at point.
	243	Individual log entries can be marked and unmarked. The marked
	244	entries are denoted by changing their background color.
	245	`log-view-get-marked' returns the list of tags for the marked
	246	log entries."
83db937c DN	247	(interactive)
	248	(save-excursion
	249	(forward-line 1)
	250	(let ((pt (point)))
	251	(when (re-search-backward log-view-message-re nil t)
	252	(let ((beg (match-beginning 0))
	253	end ov ovlist found tag)
	254	(unless (re-search-forward log-view-file-re pt t)
3a44b2ae DN	255	;; Look to see if the current entry is marked.
3a44b2ae DN	256	(setq found (get-char-property (point) 'log-view-self))
83db937c	257	(if found
3a44b2ae DN	258	(delete-overlay found)
	259	;; Create an overlay that covers this entry and change
	260	;; it's color.
83db937c	261	(setq tag (log-view-current-tag (point)))
83db937c	262	(forward-line 1)
3a44b2ae	263	(setq end
83db937c DN	264	(if (re-search-forward log-view-message-re nil t)
	265	(match-beginning 0)
	266	(point-max)))
	267	(setq ov (make-overlay beg end))
	268	(overlay-put ov 'face 'log-view-file)
3a44b2ae DN	269	;; This is used to check if the overlay is present.
3a44b2ae DN	270	(overlay-put ov 'log-view-self ov)
83db937c DN	271	(overlay-put ov 'log-view-marked tag))))))))
83db937c DN	272
3a44b2ae	273	(defun log-view-get-marked ()
a0902360	274	"Return the list of tags for the marked log entries."
3a44b2ae DN	275	(save-excursion
	276	(let ((pos (point-min))
	277	marked-list ov)
	278	(while (setq pos (next-single-property-change pos 'face))
	279	(when (setq ov (get-char-property pos 'log-view-self))
	280	(push (overlay-get ov 'log-view-marked) marked-list)
	281	(setq pos (overlay-end ov))))
	282	marked-list)))
	283
aa230d94 SM	284	(defvar cvs-minor-current-files)
	285	(defvar cvs-branch-prefix)
	286	(defvar cvs-secondary-branch-prefix)
	287
5b467bf4 SM	288	(defun log-view-minor-wrap (buf f)
5b467bf4 SM	289	(let ((data (with-current-buffer buf
243afed7 SM	290	(let* ((beg (point))
243afed7 SM	291	(end (if mark-active (mark) (point)))
cbc98273 JL	292	(fr (log-view-current-tag beg))
	293	(to (log-view-current-tag end)))
	294	(when (string-equal fr to)
	295	(save-excursion
	296	(goto-char end)
	297	(log-view-msg-next)
	298	(setq to (log-view-current-tag))))
	299	(cons
243afed7 SM	300	;; The first revision has to be the one at point, for
	301	;; operations that only take one revision
	302	;; (e.g. cvs-mode-edit).
	303	(cons (log-view-current-file) fr)
	304	(cons (log-view-current-file) to))))))
5b467bf4 SM	305	(let ((cvs-branch-prefix (cdar data))
	306	(cvs-secondary-branch-prefix (and (cdar data) (cddr data)))
	307	(cvs-minor-current-files
	308	(cons (caar data)
	309	(when (and (cadr data) (not (equal (caar data) (cadr data))))
	310	(list (cadr data)))))
	311	;; FIXME: I need to force because the fileinfos are UNKNOWN
	312	(cvs-force-command "/F"))
	313	(funcall f))))
	314
c0313667 AS	315	(defun log-view-find-version (pos)
	316	"Visit the version at point."
	317	(interactive "d")
	318	(save-excursion
	319	(goto-char pos)
f1180544	320	(switch-to-buffer (vc-find-version (log-view-current-file)
c0313667 AS	321	(log-view-current-tag)))))
c0313667 AS	322
467ee23f SM	323	;;
	324	;; diff
	325	;;
99cb8c8b SS	326
99cb8c8b SS	327	(defun log-view-diff (beg end)
e8171d36 JL	328	"Get the diff between two revisions.
	329	If the mark is not active or the mark is on the revision at point,
	330	get the diff between the revision at point and its previous revision.
	331	Otherwise, get the diff between the revisions where the region starts
	332	and ends."
da4ae7d3 JL	333	(interactive
	334	(list (if mark-active (region-beginning) (point))
	335	(if mark-active (region-end) (point))))
99cb8c8b SS	336	(let ((fr (log-view-current-tag beg))
	337	(to (log-view-current-tag end)))
	338	(when (string-equal fr to)
	339	(save-excursion
	340	(goto-char end)
	341	(log-view-msg-next)
	342	(setq to (log-view-current-tag))))
	343	(vc-version-diff (log-view-current-file) to fr)))
	344
5b467bf4	345	(provide 'log-view)
cdbb990f	346
9be92b96	347	;; arch-tag: 0d64220b-ce7e-4f62-9c2a-6b04c2f81f4f
5b467bf4	348	;;; log-view.el ends here