| 1 | ;;; pcvs-info.el --- internal representation of a fileinfo entry |
| 2 | |
| 3 | ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, |
| 4 | ;; 2000, 2004, 2005 Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Stefan Monnier <monnier@cs.yale.edu> |
| 7 | ;; Keywords: pcl-cvs |
| 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 |
| 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 24 | ;; Boston, MA 02111-1307, USA. |
| 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 | |
| 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." |
| 48 | :group 'pcl-cvs |
| 49 | :type '(boolean)) |
| 50 | (define-obsolete-variable-alias 'cvs-display-full-path 'cvs-display-full-name) |
| 51 | |
| 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 | |
| 60 | ;;;; |
| 61 | ;;;; Faces for fontification |
| 62 | ;;;; |
| 63 | |
| 64 | (defface cvs-header |
| 65 | '((((class color) (background dark)) |
| 66 | (:foreground "lightyellow" :weight bold)) |
| 67 | (((class color) (background light)) |
| 68 | (:foreground "blue4" :weight bold)) |
| 69 | (t (:weight bold))) |
| 70 | "PCL-CVS face used to highlight directory changes." |
| 71 | :group 'pcl-cvs) |
| 72 | ;; backward-compatibility alias |
| 73 | (put 'cvs-header-face 'face-alias 'cvs-header) |
| 74 | |
| 75 | (defface cvs-filename |
| 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) |
| 83 | ;; backward-compatibility alias |
| 84 | (put 'cvs-filename-face 'face-alias 'cvs-filename) |
| 85 | |
| 86 | (defface cvs-unknown |
| 87 | '((((class color) (background dark)) |
| 88 | (:foreground "red")) |
| 89 | (((class color) (background light)) |
| 90 | (:foreground "red")) |
| 91 | (t (:slant italic))) |
| 92 | "PCL-CVS face used to highlight unknown file status." |
| 93 | :group 'pcl-cvs) |
| 94 | ;; backward-compatibility alias |
| 95 | (put 'cvs-unknown-face 'face-alias 'cvs-unknown) |
| 96 | |
| 97 | (defface cvs-handled |
| 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) |
| 105 | ;; backward-compatibility alias |
| 106 | (put 'cvs-handled-face 'face-alias 'cvs-handled) |
| 107 | |
| 108 | (defface cvs-need-action |
| 109 | '((((class color) (background dark)) |
| 110 | (:foreground "orange")) |
| 111 | (((class color) (background light)) |
| 112 | (:foreground "orange")) |
| 113 | (t (:slant italic))) |
| 114 | "PCL-CVS face used to highlight status of files needing action." |
| 115 | :group 'pcl-cvs) |
| 116 | ;; backward-compatibility alias |
| 117 | (put 'cvs-need-action-face 'face-alias 'cvs-need-action) |
| 118 | |
| 119 | (defface cvs-marked |
| 120 | '((((min-colors 88) (class color) (background dark)) |
| 121 | (:foreground "green1" :weight bold)) |
| 122 | (((class color) (background dark)) |
| 123 | (:foreground "green" :weight bold)) |
| 124 | (((class color) (background light)) |
| 125 | (:foreground "green3" :weight bold)) |
| 126 | (t (:weight bold))) |
| 127 | "PCL-CVS face used to highlight marked file indicator." |
| 128 | :group 'pcl-cvs) |
| 129 | ;; backward-compatibility alias |
| 130 | (put 'cvs-marked-face 'face-alias 'cvs-marked) |
| 131 | |
| 132 | (defface cvs-msg |
| 133 | '((t (:slant italic))) |
| 134 | "PCL-CVS face used to highlight CVS messages." |
| 135 | :group 'pcl-cvs) |
| 136 | ;; backward-compatibility alias |
| 137 | (put 'cvs-msg-face 'face-alias 'cvs-msg) |
| 138 | |
| 139 | (defvar cvs-fi-up-to-date-face 'cvs-handled) |
| 140 | (defvar cvs-fi-unknown-face 'cvs-unknown) |
| 141 | (defvar cvs-fi-conflict-face 'font-lock-warning-face) |
| 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 | |
| 150 | (easy-mmode-defmap cvs-status-map |
| 151 | '(([(mouse-2)] . cvs-mode-toggle-mark)) |
| 152 | "Local keymap for text properties of status") |
| 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. |
| 184 | ;; full-name ;; The complete relative filename. |
| 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: |
| 191 | |
| 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 |
| 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 | |
| 220 | (defun cvs-fileinfo->full-name (fileinfo) |
| 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. |
| 227 | (concat dir (cvs-fileinfo->file fileinfo))))) |
| 228 | (define-obsolete-function-alias 'cvs-fileinfo->full-path 'cvs-fileinfo->full-name) |
| 229 | |
| 230 | (defun cvs-fileinfo->pp-name (fi) |
| 231 | "Return the filename of FI as it should be displayed." |
| 232 | (if cvs-display-full-name |
| 233 | (cvs-fileinfo->full-name fi) |
| 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 |
| 242 | (concat "\\`" (regexp-quote cvs-bakprefix) |
| 243 | (regexp-quote file) "\\(\\.[0-9]+\\.[0-9]+\\)+\\'"))) |
| 244 | bf) |
| 245 | (dolist (f files) |
| 246 | (when (and (file-readable-p f) |
| 247 | (or (null bf) (file-newer-than-file-p f bf))) |
| 248 | (setq bf f))) |
| 249 | (concat dir bf))) |
| 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 | |
| 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))) |
| 269 | (if (and (setq check 'marked) (memq marked '(t nil)) |
| 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 |
| 292 | ;;;; |
| 293 | ;;;; State table to indicate what you can do when. |
| 294 | ;;;; |
| 295 | |
| 296 | (defconst cvs-states |
| 297 | `((NEED-UPDATE update diff ignore) |
| 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 | |
| 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 | |
| 331 | (defun cvs-add-face (str face &optional keymap &rest props) |
| 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) |
| 337 | str) |
| 338 | |
| 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 " |
| 348 | (cvs-add-face (cvs-fileinfo->full-name fileinfo) |
| 349 | 'cvs-header t 'cvs-goal-column t) |
| 350 | ":")) |
| 351 | (MESSAGE |
| 352 | (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) |
| 353 | 'cvs-msg)) |
| 354 | (t |
| 355 | (let* ((status (if (cvs-fileinfo->marked fileinfo) |
| 356 | (cvs-add-face "*" 'cvs-marked) |
| 357 | " ")) |
| 358 | (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo) |
| 359 | 'cvs-filename t 'cvs-goal-column t)) |
| 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))))) |
| 367 | (face (let ((sym (intern |
| 368 | (concat "cvs-fi-" |
| 369 | (downcase (symbol-name type)) |
| 370 | "-face")))) |
| 371 | (or (and (boundp sym) (symbol-value sym)) |
| 372 | 'cvs-need-action)))) |
| 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 |
| 380 | ""))) |
| 381 | (format "%-11s %s %-11s %-11s %s" |
| 382 | side status type base file))))))) |
| 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 | |
| 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 |
| 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 | |
| 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")) |
| 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)) |
| 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 | |
| 490 | (provide 'pcvs-info) |
| 491 | |
| 492 | ;; arch-tag: d85dde07-bdc2-400a-882f-92f398c7b0ba |
| 493 | ;;; pcvs-info.el ends here |