Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; pcvs-info.el --- internal representation of a fileinfo entry |
5b467bf4 | 2 | |
45ce5942 | 3 | ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, |
ae940284 | 4 | ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 |
cd6ef82d | 5 | ;; Free Software Foundation, Inc. |
5b467bf4 | 6 | |
cc1eecfd | 7 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> |
5b467bf4 | 8 | ;; Keywords: pcl-cvs |
5b467bf4 SM |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
eb3fa2cf | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
5b467bf4 | 13 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
5b467bf4 SM |
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 | |
eb3fa2cf | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
5b467bf4 SM |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; The cvs-fileinfo data structure: | |
28 | ;; | |
29 | ;; When the `cvs update' is ready we parse the output. Every file | |
30 | ;; that is affected in some way is added to the cookie collection as | |
31 | ;; a "fileinfo" (as defined below in cvs-create-fileinfo). | |
32 | ||
33 | ;;; Code: | |
34 | ||
35 | (eval-when-compile (require 'cl)) | |
36 | (require 'pcvs-util) | |
37 | ;;(require 'pcvs-defs) | |
38 | ||
39 | ;;;; | |
40 | ;;;; config variables | |
41 | ;;;; | |
42 | ||
82061ebf JB |
43 | (define-obsolete-variable-alias 'cvs-display-full-path |
44 | 'cvs-display-full-name "22.1") | |
cd6ef82d | 45 | |
03de06da | 46 | (defcustom cvs-display-full-name t |
9201cc28 | 47 | "Specifies how the filenames should be displayed in the listing. |
03de06da SM |
48 | If non-nil, their full filename name will be displayed, else only the |
49 | non-directory part." | |
5b467bf4 SM |
50 | :group 'pcl-cvs |
51 | :type '(boolean)) | |
52 | ||
5b467bf4 | 53 | (defcustom cvs-allow-dir-commit nil |
9201cc28 | 54 | "Allow `cvs-mode-commit' on directories. |
5b467bf4 SM |
55 | If you commit without any marked file and with the cursor positioned |
56 | on a directory entry, cvs would commit the whole directory. This seems | |
57 | to confuse some users sometimes." | |
58 | :group 'pcl-cvs | |
59 | :type '(boolean)) | |
60 | ||
5b467bf4 SM |
61 | ;;;; |
62 | ;;;; Faces for fontification | |
63 | ;;;; | |
64 | ||
2058218e | 65 | (defface cvs-header |
5b467bf4 | 66 | '((((class color) (background dark)) |
58b64ac7 | 67 | (:foreground "lightyellow" :weight bold)) |
5b467bf4 | 68 | (((class color) (background light)) |
58b64ac7 RS |
69 | (:foreground "blue4" :weight bold)) |
70 | (t (:weight bold))) | |
5b467bf4 SM |
71 | "PCL-CVS face used to highlight directory changes." |
72 | :group 'pcl-cvs) | |
c4f6e489 | 73 | (define-obsolete-face-alias 'cvs-header-face 'cvs-header "22.1") |
5b467bf4 | 74 | |
2058218e | 75 | (defface cvs-filename |
5b467bf4 SM |
76 | '((((class color) (background dark)) |
77 | (:foreground "lightblue")) | |
78 | (((class color) (background light)) | |
79 | (:foreground "blue4")) | |
80 | (t ())) | |
81 | "PCL-CVS face used to highlight file names." | |
82 | :group 'pcl-cvs) | |
c4f6e489 | 83 | (define-obsolete-face-alias 'cvs-filename-face 'cvs-filename "22.1") |
5b467bf4 | 84 | |
2058218e | 85 | (defface cvs-unknown |
5b467bf4 | 86 | '((((class color) (background dark)) |
5183d4c9 | 87 | (:foreground "red1")) |
5b467bf4 | 88 | (((class color) (background light)) |
5183d4c9 | 89 | (:foreground "red1")) |
58b64ac7 | 90 | (t (:slant italic))) |
5b467bf4 SM |
91 | "PCL-CVS face used to highlight unknown file status." |
92 | :group 'pcl-cvs) | |
c4f6e489 | 93 | (define-obsolete-face-alias 'cvs-unknown-face 'cvs-unknown "22.1") |
5b467bf4 | 94 | |
2058218e | 95 | (defface cvs-handled |
5b467bf4 SM |
96 | '((((class color) (background dark)) |
97 | (:foreground "pink")) | |
98 | (((class color) (background light)) | |
99 | (:foreground "pink")) | |
100 | (t ())) | |
101 | "PCL-CVS face used to highlight handled file status." | |
102 | :group 'pcl-cvs) | |
c4f6e489 | 103 | (define-obsolete-face-alias 'cvs-handled-face 'cvs-handled "22.1") |
5b467bf4 | 104 | |
2058218e | 105 | (defface cvs-need-action |
5b467bf4 SM |
106 | '((((class color) (background dark)) |
107 | (:foreground "orange")) | |
108 | (((class color) (background light)) | |
109 | (:foreground "orange")) | |
58b64ac7 | 110 | (t (:slant italic))) |
5b467bf4 SM |
111 | "PCL-CVS face used to highlight status of files needing action." |
112 | :group 'pcl-cvs) | |
c4f6e489 | 113 | (define-obsolete-face-alias 'cvs-need-action-face 'cvs-need-action "22.1") |
5b467bf4 | 114 | |
2058218e | 115 | (defface cvs-marked |
ea81d57e DN |
116 | '((((min-colors 88) (class color) (background dark)) |
117 | (:foreground "green1" :weight bold)) | |
118 | (((class color) (background dark)) | |
58b64ac7 | 119 | (:foreground "green" :weight bold)) |
5b467bf4 | 120 | (((class color) (background light)) |
58b64ac7 RS |
121 | (:foreground "green3" :weight bold)) |
122 | (t (:weight bold))) | |
5b467bf4 SM |
123 | "PCL-CVS face used to highlight marked file indicator." |
124 | :group 'pcl-cvs) | |
c4f6e489 | 125 | (define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1") |
5b467bf4 | 126 | |
2058218e | 127 | (defface cvs-msg |
58b64ac7 | 128 | '((t (:slant italic))) |
5b467bf4 SM |
129 | "PCL-CVS face used to highlight CVS messages." |
130 | :group 'pcl-cvs) | |
c4f6e489 | 131 | (define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1") |
5b467bf4 | 132 | |
2058218e MB |
133 | (defvar cvs-fi-up-to-date-face 'cvs-handled) |
134 | (defvar cvs-fi-unknown-face 'cvs-unknown) | |
53921158 | 135 | (defvar cvs-fi-conflict-face 'font-lock-warning-face) |
5b467bf4 SM |
136 | |
137 | ;; There is normally no need to alter the following variable, but if | |
138 | ;; your site has installed CVS in a non-standard way you might have | |
139 | ;; to change it. | |
140 | ||
141 | (defvar cvs-bakprefix ".#" | |
142 | "The prefix that CVS prepends to files when rcsmerge'ing.") | |
143 | ||
5b467bf4 | 144 | (easy-mmode-defmap cvs-status-map |
1a8bd90a | 145 | '(([(mouse-2)] . cvs-mode-toggle-mark)) |
1fe28d30 | 146 | "Local keymap for text properties of status") |
5b467bf4 SM |
147 | |
148 | ;; Constructor: | |
149 | ||
150 | (defstruct (cvs-fileinfo | |
151 | (:constructor nil) | |
152 | (:copier nil) | |
153 | (:constructor -cvs-create-fileinfo (type dir file full-log | |
154 | &key marked subtype | |
155 | merge | |
156 | base-rev | |
157 | head-rev)) | |
158 | (:conc-name cvs-fileinfo->)) | |
159 | marked ;; t/nil. | |
160 | type ;; See below | |
161 | subtype ;; See below | |
162 | dir ;; Relative directory the file resides in. | |
163 | ;; (concat dir file) should give a valid path. | |
164 | file ;; The file name sans the directory. | |
165 | base-rev ;; During status: This is the revision that the | |
166 | ;; working file is based on. | |
167 | head-rev ;; During status: This is the highest revision in | |
168 | ;; the repository. | |
169 | merge ;; A cons cell containing the (ancestor . head) revisions | |
170 | ;; of the merge that resulted in the current file. | |
171 | ;;removed ;; t if the file no longer exists. | |
172 | full-log ;; The output from cvs, unparsed. | |
173 | ;;mod-time ;; Not used. | |
174 | ||
175 | ;; In addition to the above, the following values can be extracted: | |
176 | ||
177 | ;; handled ;; t if this file doesn't require further action. | |
03de06da | 178 | ;; full-name ;; The complete relative filename. |
5b467bf4 SM |
179 | ;; pp-name ;; The printed file name |
180 | ;; backup-file;; For MERGED and CONFLICT files after a \"cvs update\", | |
181 | ;; this is a full path to the backup file where the | |
182 | ;; untouched version resides. | |
183 | ||
184 | ;; The meaning of the type field: | |
f1180544 | 185 | |
5b467bf4 SM |
186 | ;; Value ---Used by--- Explanation |
187 | ;; update status | |
188 | ;; NEED-UPDATE x file needs update | |
189 | ;; MODIFIED x x modified by you, unchanged in repository | |
190 | ;; MERGED x x successful merge | |
191 | ;; ADDED x x added by you, not yet committed | |
192 | ;; MISSING x rm'd, but not yet `cvs remove'd | |
193 | ;; REMOVED x x removed by you, not yet committed | |
194 | ;; NEED-MERGE x need merge | |
195 | ;; CONFLICT x conflict when merging | |
196 | ;; ;;MOD-CONFLICT x removed locally, changed in repository. | |
197 | ;; DIRCHANGE x x A change of directory. | |
198 | ;; UNKNOWN x An unknown file. | |
199 | ;; UP-TO-DATE x The file is up-to-date. | |
200 | ;; UPDATED x x file copied from repository | |
201 | ;; PATCHED x x diff applied from repository | |
202 | ;; COMMITTED x x cvs commit'd | |
203 | ;; DEAD An entry that should be removed | |
204 | ;; MESSAGE x x This is a special fileinfo that is used | |
205 | ;; to display a text that should be in | |
206 | ;; full-log." | |
207 | ;; TEMP A temporary message that should be removed | |
5b467bf4 SM |
208 | ) |
209 | (defun cvs-create-fileinfo (type dir file msg &rest keys) | |
210 | (cvs-check-fileinfo (apply #'-cvs-create-fileinfo type dir file msg keys))) | |
211 | ||
212 | ;; Fake selectors: | |
213 | ||
03de06da | 214 | (defun cvs-fileinfo->full-name (fileinfo) |
5b467bf4 SM |
215 | "Return the full path for the file that is described in FILEINFO." |
216 | (let ((dir (cvs-fileinfo->dir fileinfo))) | |
217 | (if (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE) | |
218 | (if (string= dir "") "." (directory-file-name dir)) | |
219 | ;; Here, I use `concat' rather than `expand-file-name' because I want | |
220 | ;; the resulting path to stay relative if `dir' is relative. | |
5b467bf4 | 221 | (concat dir (cvs-fileinfo->file fileinfo))))) |
82061ebf JB |
222 | (define-obsolete-function-alias 'cvs-fileinfo->full-path |
223 | 'cvs-fileinfo->full-name "22.1") | |
5b467bf4 SM |
224 | |
225 | (defun cvs-fileinfo->pp-name (fi) | |
226 | "Return the filename of FI as it should be displayed." | |
03de06da SM |
227 | (if cvs-display-full-name |
228 | (cvs-fileinfo->full-name fi) | |
5b467bf4 SM |
229 | (cvs-fileinfo->file fi))) |
230 | ||
231 | (defun cvs-fileinfo->backup-file (fileinfo) | |
232 | "Construct the file name of the backup file for FILEINFO." | |
233 | (let* ((dir (cvs-fileinfo->dir fileinfo)) | |
234 | (file (cvs-fileinfo->file fileinfo)) | |
235 | (default-directory (file-name-as-directory (expand-file-name dir))) | |
236 | (files (directory-files "." nil | |
449b6104 SM |
237 | (concat "\\`" (regexp-quote cvs-bakprefix) |
238 | (regexp-quote file) "\\(\\.[0-9]+\\.[0-9]+\\)+\\'"))) | |
5b467bf4 | 239 | bf) |
03de06da | 240 | (dolist (f files) |
5b467bf4 SM |
241 | (when (and (file-readable-p f) |
242 | (or (null bf) (file-newer-than-file-p f bf))) | |
03de06da SM |
243 | (setq bf f))) |
244 | (concat dir bf))) | |
5b467bf4 SM |
245 | |
246 | ;; (defun cvs-fileinfo->handled (fileinfo) | |
247 | ;; "Tell if this requires further action" | |
248 | ;; (memq (cvs-fileinfo->type fileinfo) '(UP-TO-DATE DEAD))) | |
249 | ||
250 | \f | |
251 | ;; Predicate: | |
252 | ||
5b467bf4 SM |
253 | (defun cvs-check-fileinfo (fi) |
254 | "Check FI's conformance to some conventions." | |
255 | (let ((check 'none) | |
256 | (type (cvs-fileinfo->type fi)) | |
257 | (subtype (cvs-fileinfo->subtype fi)) | |
258 | (marked (cvs-fileinfo->marked fi)) | |
259 | (dir (cvs-fileinfo->dir fi)) | |
260 | (file (cvs-fileinfo->file fi)) | |
261 | (base-rev (cvs-fileinfo->base-rev fi)) | |
262 | (head-rev (cvs-fileinfo->head-rev fi)) | |
263 | (full-log (cvs-fileinfo->full-log fi))) | |
9d4b3027 | 264 | (if (and (setq check 'marked) (memq marked '(t nil)) |
5b467bf4 SM |
265 | (setq check 'base-rev) (or (null base-rev) (stringp base-rev)) |
266 | (setq check 'head-rev) (or (null head-rev) (stringp head-rev)) | |
267 | (setq check 'full-log) (stringp full-log) | |
268 | (setq check 'dir) | |
269 | (and (stringp dir) | |
270 | (not (file-name-absolute-p dir)) | |
271 | (or (string= dir "") | |
272 | (string= dir (file-name-as-directory dir)))) | |
273 | (setq check 'file) | |
274 | (and (stringp file) | |
275 | (string= file (file-name-nondirectory file))) | |
276 | (setq check 'type) (symbolp type) | |
277 | (setq check 'consistency) | |
278 | (case type | |
279 | (DIRCHANGE (and (null subtype) (string= "." file))) | |
280 | ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE | |
281 | REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE) | |
282 | t))) | |
283 | fi | |
284 | (error "Invalid :%s in cvs-fileinfo %s" check fi)))) | |
285 | ||
286 | \f | |
f1180544 | 287 | ;;;; |
5b467bf4 | 288 | ;;;; State table to indicate what you can do when. |
f1180544 | 289 | ;;;; |
5b467bf4 SM |
290 | |
291 | (defconst cvs-states | |
45ce5942 | 292 | `((NEED-UPDATE update diff ignore) |
5b467bf4 SM |
293 | (UP-TO-DATE update nil remove diff safe-rm revert) |
294 | (MODIFIED update commit undo remove diff merge diff-base) | |
295 | (ADDED update commit remove) | |
296 | (MISSING remove undo update safe-rm revert) | |
297 | (REMOVED commit add undo safe-rm) | |
298 | (NEED-MERGE update undo diff diff-base) | |
299 | (CONFLICT merge remove undo commit diff diff-base) | |
300 | (DIRCHANGE remove update diff ,(if cvs-allow-dir-commit 'commit) tag) | |
301 | (UNKNOWN ignore add remove) | |
302 | (DEAD ) | |
303 | (MESSAGE)) | |
304 | "Fileinfo state descriptions for pcl-cvs. | |
305 | This is an assoc list. Each element consists of (STATE . FUNS) | |
306 | - STATE (described in `cvs-create-fileinfo') is the key | |
307 | - FUNS is the list of applicable operations. | |
308 | The first one (if any) should be the \"default\" action. | |
309 | Most of the actions have the obvious meaning. | |
310 | `safe-rm' indicates that the file can be removed without losing | |
311 | any information.") | |
312 | ||
313 | ;;;; | |
314 | ;;;; Utility functions | |
315 | ;;;; | |
316 | ||
5b467bf4 SM |
317 | (defun cvs-applicable-p (fi-or-type func) |
318 | "Check if FUNC is applicable to FI-OR-TYPE. | |
319 | If FUNC is nil, always return t. | |
320 | FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo." | |
321 | (let ((type (if (symbolp fi-or-type) fi-or-type | |
322 | (cvs-fileinfo->type fi-or-type)))) | |
323 | (and (not (eq type 'MESSAGE)) | |
324 | (eq (car (memq func (cdr (assq type cvs-states)))) func)))) | |
325 | ||
db1f981d | 326 | (defun cvs-add-face (str face &optional keymap &rest props) |
c8bc0b5f SM |
327 | (when keymap |
328 | (when (keymapp keymap) | |
329 | (setq props (list* 'keymap keymap props))) | |
330 | (setq props (list* 'mouse-face 'highlight props))) | |
331 | (add-text-properties 0 (length str) (list* 'font-lock-face face props) str) | |
5b467bf4 SM |
332 | str) |
333 | ||
5b467bf4 SM |
334 | (defun cvs-fileinfo-pp (fileinfo) |
335 | "Pretty print FILEINFO. Insert a printed representation in current buffer. | |
336 | For use by the cookie package." | |
337 | (cvs-check-fileinfo fileinfo) | |
338 | (let ((type (cvs-fileinfo->type fileinfo)) | |
339 | (subtype (cvs-fileinfo->subtype fileinfo))) | |
340 | (insert | |
341 | (case type | |
342 | (DIRCHANGE (concat "In directory " | |
03de06da | 343 | (cvs-add-face (cvs-fileinfo->full-name fileinfo) |
2058218e | 344 | 'cvs-header t 'cvs-goal-column t) |
5b467bf4 SM |
345 | ":")) |
346 | (MESSAGE | |
cb3430a1 | 347 | (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) |
2058218e | 348 | 'cvs-msg)) |
5b467bf4 SM |
349 | (t |
350 | (let* ((status (if (cvs-fileinfo->marked fileinfo) | |
2058218e | 351 | (cvs-add-face "*" 'cvs-marked) |
5b467bf4 SM |
352 | " ")) |
353 | (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo) | |
2058218e | 354 | 'cvs-filename t 'cvs-goal-column t)) |
5b467bf4 SM |
355 | (base (or (cvs-fileinfo->base-rev fileinfo) "")) |
356 | (head (cvs-fileinfo->head-rev fileinfo)) | |
357 | (type | |
358 | (let ((str (case type | |
359 | ;;(MOD-CONFLICT "Not Removed") | |
360 | (DEAD "") | |
361 | (t (capitalize (symbol-name type))))) | |
1fe28d30 SM |
362 | (face (let ((sym (intern |
363 | (concat "cvs-fi-" | |
364 | (downcase (symbol-name type)) | |
365 | "-face")))) | |
366 | (or (and (boundp sym) (symbol-value sym)) | |
2058218e | 367 | 'cvs-need-action)))) |
5b467bf4 SM |
368 | (cvs-add-face str face cvs-status-map))) |
369 | (side (or | |
370 | ;; maybe a subtype | |
371 | (when subtype (downcase (symbol-name subtype))) | |
372 | ;; or the head-rev | |
373 | (when (and head (not (string= head base))) head) | |
374 | ;; or nothing | |
cb3430a1 | 375 | ""))) |
6efa25a1 | 376 | (format "%-11s %s %-11s %-11s %s" |
438dd27d TTN |
377 | side status type base file)))) |
378 | "\n"))) | |
5b467bf4 SM |
379 | |
380 | ||
381 | (defun cvs-fileinfo-update (fi fi-new) | |
382 | "Update FI with the information provided in FI-NEW." | |
383 | (let ((type (cvs-fileinfo->type fi-new)) | |
384 | (merge (cvs-fileinfo->merge fi-new))) | |
385 | (setf (cvs-fileinfo->type fi) type) | |
386 | (setf (cvs-fileinfo->subtype fi) (cvs-fileinfo->subtype fi-new)) | |
387 | (setf (cvs-fileinfo->full-log fi) (cvs-fileinfo->full-log fi-new)) | |
388 | (setf (cvs-fileinfo->base-rev fi) (cvs-fileinfo->base-rev fi-new)) | |
389 | (setf (cvs-fileinfo->head-rev fi) (cvs-fileinfo->head-rev fi-new)) | |
390 | (cond | |
391 | (merge (setf (cvs-fileinfo->merge fi) merge)) | |
392 | ((memq type '(UP-TO-DATE NEED-UPDATE)) | |
393 | (setf (cvs-fileinfo->merge fi) nil))))) | |
394 | ||
5b467bf4 SM |
395 | (defun cvs-fileinfo< (a b) |
396 | "Compare fileinfo A with fileinfo B and return t if A is `less'. | |
397 | The ordering defined by this function is such that directories are | |
398 | sorted alphabetically, and inside every directory the DIRCHANGE | |
399 | fileinfo will appear first, followed by all files (alphabetically)." | |
400 | (let ((subtypea (cvs-fileinfo->subtype a)) | |
401 | (subtypeb (cvs-fileinfo->subtype b))) | |
402 | (cond | |
5b467bf4 SM |
403 | ;; Sort according to directories. |
404 | ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t) | |
405 | ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil) | |
406 | ||
407 | ;; The DIRCHANGE entry is always first within the directory. | |
408 | ((eq (cvs-fileinfo->type b) 'DIRCHANGE) nil) | |
409 | ((eq (cvs-fileinfo->type a) 'DIRCHANGE) t) | |
410 | ||
411 | ;; All files are sorted by file name. | |
412 | ((string< (cvs-fileinfo->file a) (cvs-fileinfo->file b)))))) | |
413 | ||
1fe28d30 SM |
414 | ;;; |
415 | ;;; Look at CVS/Entries to quickly find a first approximation of the status | |
416 | ;;; | |
417 | ||
418 | (defun cvs-fileinfo-from-entries (dir &optional all) | |
419 | "List of fileinfos for DIR, extracted from CVS/Entries. | |
420 | Unless ALL is optional, returns only the files that are not up-to-date. | |
421 | DIR can also be a file." | |
422 | (let* ((singlefile | |
423 | (cond | |
424 | ((equal dir "") nil) | |
425 | ((file-directory-p dir) (setq dir (file-name-as-directory dir)) nil) | |
426 | (t (prog1 (file-name-nondirectory dir) | |
427 | (setq dir (or (file-name-directory dir) "")))))) | |
428 | (file (expand-file-name "CVS/Entries" dir)) | |
429 | (fis nil)) | |
430 | (if (not (file-readable-p file)) | |
431 | (push (cvs-create-fileinfo (if singlefile 'UNKNOWN 'DIRCHANGE) | |
432 | dir (or singlefile ".") "") fis) | |
433 | (with-temp-buffer | |
434 | (insert-file-contents file) | |
435 | (goto-char (point-min)) | |
436 | ;; Select the single file entry in case we're only interested in a file. | |
437 | (cond | |
438 | ((not singlefile) | |
439 | (push (cvs-create-fileinfo 'DIRCHANGE dir "." "") fis)) | |
440 | ((re-search-forward | |
441 | (concat "^[^/]*/" (regexp-quote singlefile) "/.*") nil t) | |
442 | (setq all t) | |
443 | (goto-char (match-beginning 0)) | |
444 | (narrow-to-region (point) (match-end 0))) | |
445 | (t | |
446 | (push (cvs-create-fileinfo 'UNKNOWN dir singlefile "") fis) | |
447 | (narrow-to-region (point-min) (point-min)))) | |
448 | (while (looking-at "\\([^/]*\\)/\\([^/]*\\)/\\([^/]*\\)/\\([^/]*\\)/") | |
449 | (if (/= (match-beginning 1) (match-end 1)) | |
450 | (setq fis (append (cvs-fileinfo-from-entries | |
451 | (concat dir (file-name-as-directory | |
452 | (match-string 2))) | |
453 | all) | |
454 | fis)) | |
455 | (let ((f (match-string 2)) | |
456 | (rev (match-string 3)) | |
457 | (date (match-string 4)) | |
458 | timestamp | |
459 | (type 'MODIFIED) | |
460 | (subtype nil)) | |
461 | (cond | |
462 | ((equal (substring rev 0 1) "-") | |
463 | (setq type 'REMOVED rev (substring rev 1))) | |
464 | ((not (file-exists-p (concat dir f))) (setq type 'MISSING)) | |
465 | ((equal rev "0") (setq type 'ADDED rev nil)) | |
466 | ((equal date "Result of merge") (setq subtype 'MERGED)) | |
467 | ((let ((mtime (nth 5 (file-attributes (concat dir f)))) | |
468 | (system-time-locale "C")) | |
38fdf6aa SM |
469 | (setq timestamp (format-time-string "%c" mtime 'utc)) |
470 | ;; Solaris sometimes uses "Wed Sep 05", not "Wed Sep 5". | |
471 | ;; See "grep '[^a-z_]ctime' cvs/src/*.c" for reference. | |
472 | (if (= (aref timestamp 8) ?0) | |
473 | (setq timestamp (concat (substring timestamp 0 8) | |
474 | " " (substring timestamp 9)))) | |
475 | (equal timestamp date)) | |
1fe28d30 SM |
476 | (setq type (if all 'UP-TO-DATE))) |
477 | ((equal date (concat "Result of merge+" timestamp)) | |
478 | (setq type 'CONFLICT))) | |
479 | (when type | |
480 | (push (cvs-create-fileinfo type dir f "" | |
481 | :base-rev rev :subtype subtype) | |
482 | fis)))) | |
483 | (forward-line 1)))) | |
484 | fis)) | |
485 | ||
5b467bf4 SM |
486 | (provide 'pcvs-info) |
487 | ||
45ce5942 | 488 | ;; arch-tag: d85dde07-bdc2-400a-882f-92f398c7b0ba |
3afbc435 | 489 | ;;; pcvs-info.el ends here |