Function: vc-arch-state

vc-arch-state is a byte-compiled function defined in vc-arch.el.gz.

Signature

(vc-arch-state FILE)

Source Code

;; Defined in /usr/src/emacs/lisp/obsolete/vc-arch.el.gz
(defun vc-arch-state (file)
  ;; There's no checkout operation and merging is not done from VC
  ;; so the only operation that's state dependent that VC supports is commit
  ;; which is only activated if the file is `edited'.
  (let* ((root (vc-arch-root file))
	 (ver (vc-arch-default-version file))
	 (pat (concat "\\`" (subst-char-in-string ?/ ?% ver)))
	 (dir (expand-file-name ",,inode-sigs/"
				(expand-file-name "{arch}" root)))
	 (sigfile nil))
    (dolist (f (if (file-directory-p dir) (directory-files dir t pat)))
      (if (or (not sigfile) (file-newer-than-file-p f sigfile))
	  (setq sigfile f)))
    (if (not sigfile)
	'edited				;We know nothing.
      (let ((id (vc-arch-file-id file)))
	(setq id (replace-regexp-in-string "[ \t]" "_" id))
	(with-current-buffer (find-file-noselect sigfile)
	  (goto-char (point-min))
	  (while (and (search-forward id nil 'move)
		      (save-excursion
			(goto-char (- (match-beginning 0) 2))
			;; For `names', the lines start with `?./foo/bar'.
			;; For others there's 2 chars before the ./foo/bar.
			(or (not (or (bolp) (looking-at "\n?")))
			    ;; Ignore E_ entries used for foo.id files.
			    (looking-at "E_")))))
	  (if (eobp)
	      ;; ID not found.
	      (if (equal (file-name-nondirectory sigfile)
			 (subst-char-in-string
			  ?/ ?% (vc-arch-working-revision file)))
		  'added
		;; Might be `added' or `up-to-date' as well.
		;; FIXME: Check in the patch logs to find out.
		'edited)
	    ;; Found the ID, let's check the inode.
	    (if (not (re-search-forward
		      "\t.*mtime=\\([0-9]+\\):size=\\([0-9]+\\)"
		      (line-end-position) t))
		;; Buh?  Unexpected format.
		'edited
	      (let ((ats (file-attributes file)))
		(if (and (eq (file-attribute-size ats) (string-to-number (match-string 2)))
			 (equal (format-time-string
				 "%s" (file-attribute-modification-time ats))
				(match-string 1)))
		    'up-to-date
		  'edited)))))))))