Mercurial > emacs
comparison lisp/log-view.el @ 28088:b442dfc3cef0
*** empty log message ***
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sat, 11 Mar 2000 03:51:31 +0000 |
parents | |
children | 21d27711125f |
comparison
equal
deleted
inserted
replaced
28087:9ca294cf76c7 | 28088:b442dfc3cef0 |
---|---|
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.2 2000/03/03 20:58:09 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 ;; - extract version info in log-view-current-tag | |
32 ;; - add support for SCCS' output format | |
33 ;; - add compatibility with cvs-log.el | |
34 ;; - add ability to modify a log-entry (via cvs-mode-admin ;-) | |
35 | |
36 ;;; Code: | |
37 | |
38 (eval-when-compile (require 'cl)) | |
39 ;;(require 'pcvs-defs) | |
40 (require 'pcvs-util) | |
41 | |
42 | |
43 (defgroup log-view nil | |
44 "Major mode for browsing log output for PCL-CVS." | |
45 :group 'pcl-cvs | |
46 :prefix "log-view-") | |
47 | |
48 (easy-mmode-defmap log-view-mode-map | |
49 '(("n" . log-view-next-message) | |
50 ("N" . log-view-next-file) | |
51 ("M-n" . log-view-next-file) | |
52 ("p" . log-view-prev-message) | |
53 ("P" . log-view-prev-file) | |
54 ("M-p" . log-view-prev-file)) | |
55 "Log-View's keymap." | |
56 :group 'log-view | |
57 :inherit '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 "^----------------------------$") | |
84 | |
85 (defconst log-view-font-lock-keywords | |
86 `((,log-view-file-re | |
87 (2 'cvs-filename-face nil t) | |
88 (3 '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 (autoload 'log-view-mode "log-view" "Major mode for browsing CVS log output." t) | |
100 (eval-when-compile (autoload 'easy-mmode-define-derived-mode "easy-mmode")) | |
101 (easy-mmode-define-derived-mode log-view-mode fundamental-mode "Log-View" | |
102 "Major mode for browsing CVS log output." | |
103 (set (make-local-variable 'font-lock-defaults) log-view-font-lock-defaults) | |
104 (set (make-local-variable 'cvs-minor-wrap-function) 'log-view-minor-wrap)) | |
105 | |
106 ;;;; | |
107 ;;;; Navigation | |
108 ;;;; | |
109 | |
110 (defun log-view-next-message (&optional count) | |
111 "Move to next (COUNT'th) log message." | |
112 (interactive "p") | |
113 (unless count (setq count 1)) | |
114 (if (< count 0) (log-view-prev-message (- count)) | |
115 (when (looking-at log-view-message-re) (incf count)) | |
116 (re-search-forward log-view-message-re nil nil count) | |
117 (goto-char (match-beginning 0)))) | |
118 | |
119 (defun log-view-next-file (&optional count) | |
120 "Move to next (COUNT'th) file." | |
121 (interactive "p") | |
122 (unless count (setq count 1)) | |
123 (if (< count 0) (log-view-prev-file (- count)) | |
124 (when (looking-at log-view-file-re) (incf count)) | |
125 (re-search-forward log-view-file-re nil nil count) | |
126 (goto-char (match-beginning 0)))) | |
127 | |
128 (defun log-view-prev-message (&optional count) | |
129 "Move to previous (COUNT'th) log message." | |
130 (interactive "p") | |
131 (unless count (setq count 1)) | |
132 (if (< count 0) (log-view-next-message (- count)) | |
133 (re-search-backward log-view-message-re nil nil count))) | |
134 | |
135 (defun log-view-prev-file (&optional count) | |
136 "Move to previous (COUNT'th) file." | |
137 (interactive "p") | |
138 (unless count (setq count 1)) | |
139 (if (< count 0) (log-view-next-file (- count)) | |
140 (re-search-backward log-view-file-re nil nil count))) | |
141 | |
142 ;;;; | |
143 ;;;; Linkage to PCL-CVS (mostly copied from cvs-status.el) | |
144 ;;;; | |
145 | |
146 (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$") | |
147 | |
148 (defun log-view-current-file () | |
149 (save-excursion | |
150 (forward-line 1) | |
151 (or (re-search-backward log-view-file-re nil t) | |
152 (re-search-forward log-view-file-re)) | |
153 (let* ((file (or (match-string 2) (match-string 3))) | |
154 (cvsdir (and (re-search-backward log-view-dir-re nil t) | |
155 (match-string 1))) | |
156 (pcldir (and (re-search-backward cvs-pcl-cvs-dirchange-re nil t) | |
157 (match-string 1))) | |
158 (dir "")) | |
159 (let ((default-directory "")) | |
160 (when pcldir (setq dir (expand-file-name pcldir dir))) | |
161 (when cvsdir (setq dir (expand-file-name cvsdir dir))) | |
162 (expand-file-name file dir))))) | |
163 | |
164 (defun log-view-current-tag () | |
165 nil);; FIXME | |
166 | |
167 (defun log-view-minor-wrap (buf f) | |
168 (let ((data (with-current-buffer buf | |
169 (cons | |
170 (cons (log-view-current-file) | |
171 (log-view-current-tag)) | |
172 (when (ignore-errors (mark)) | |
173 ;; `mark-active' is not provided by XEmacs :-( | |
174 (save-excursion | |
175 (goto-char (mark)) | |
176 (cons (log-view-current-file) | |
177 (log-view-current-tag)))))))) | |
178 (let ((cvs-branch-prefix (cdar data)) | |
179 (cvs-secondary-branch-prefix (and (cdar data) (cddr data))) | |
180 (cvs-minor-current-files | |
181 (cons (caar data) | |
182 (when (and (cadr data) (not (equal (caar data) (cadr data)))) | |
183 (list (cadr data))))) | |
184 ;; FIXME: I need to force because the fileinfos are UNKNOWN | |
185 (cvs-force-command "/F")) | |
186 (funcall f)))) | |
187 | |
188 (provide 'log-view) | |
189 ;;; log-view.el ends here |