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