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