;;; vc-arch.el --- VC backend for the Arch version-control system
-;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; - C-x v u does not work.
;; - C-x v s does not work.
;; - C-x v r does not work.
-;; - VC-dired does not work.
+;; - VC directory listings do not work.
;; - And more...
;;; Code:
(eval-when-compile (require 'vc) (require 'cl))
+;;; Properties of the backend
+
+(defun vc-arch-revision-granularity () 'repository)
+(defun vc-arch-checkout-model (files) 'implicit)
+
;;;
;;; Customization options
;;;
-(defvar vc-arch-command
+;; It seems Arch diff does not accept many options, so this is not
+;; very useful. It exists mainly so that the VC backends are all
+;; consistent with regards to their treatment of diff switches.
+(defcustom vc-arch-diff-switches t
+ "String or list of strings specifying switches for Arch diff under VC.
+If nil, use the value of `vc-diff-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "23.1"
+ :group 'vc)
+
+(define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1")
+
+(defcustom vc-arch-program
(let ((candidates '("tla" "baz")))
(while (and candidates (not (executable-find (car candidates))))
(setq candidates (cdr candidates)))
- (or (car candidates) "tla")))
+ (or (car candidates) "tla"))
+ "Name of the Arch executable."
+ :type 'string
+ :group 'vc)
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
'names))))
(defun vc-arch-root (file)
- "Return the root directory of a Arch project, if any."
+ "Return the root directory of an Arch project, if any."
(or (vc-file-getprop file 'arch-root)
- (vc-file-setprop
- ;; Check the =tagging-method, in case someone naively manually
- ;; creates a {arch} directory somewhere.
- file 'arch-root (vc-find-root file "{arch}/=tagging-method"))))
+ ;; Check the =tagging-method, in case someone naively manually
+ ;; creates a {arch} directory somewhere.
+ (let ((root (vc-find-root file "{arch}/=tagging-method")))
+ (when root
+ (vc-file-setprop
+ file 'arch-root root)))))
(defun vc-arch-register (files &optional rev comment)
(if rev (error "Explicit initial revision not supported for Arch"))
(buffer-substring (point-min) (1- (point-max)))))))))
(defun vc-arch-workfile-unchanged-p (file)
- "Check if FILE is unchanged by diffing against the master version.
-Return non-nil if FILE is unchanged."
+ "Stub: arch workfiles are always considered to be in a changed state,"
nil)
(defun vc-arch-state (file)
'up-to-date
'edited)))))))))
+(defun vc-arch-dir-status (dir callback)
+ "Run 'tla inventory' for DIR and pass results to CALLBACK.
+CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
+`vc-dir-refresh'."
+ (let ((default-directory dir))
+ (vc-arch-command t 'async nil "changes"))
+ ;; The updating could be done asynchronously.
+ (vc-exec-after
+ `(vc-arch-after-dir-status ',callback)))
+
+(defun vc-arch-after-dir-status (callback)
+ (let* ((state-map '(("M " . edited)
+ ("Mb" . edited) ;binary
+ ("D " . removed)
+ ("D/" . removed) ;directory
+ ("A " . added)
+ ("A/" . added) ;directory
+ ("=>" . renamed)
+ ("/>" . renamed) ;directory
+ ("lf" . symlink-to-file)
+ ("fl" . file-to-symlink)
+ ("--" . permissions-changed)
+ ("-/" . permissions-changed) ;directory
+ ))
+ (state-map-regexp (regexp-opt (mapcar 'car state-map) t))
+ (entry-regexp (concat "^" state-map-regexp " \\(.*\\)$"))
+ result)
+ (goto-char (point-min))
+ ;;(message "Got %s" (buffer-string))
+ (while (re-search-forward entry-regexp nil t)
+ (let* ((state-string (match-string 1))
+ (state (cdr (assoc state-string state-map)))
+ (filename (match-string 2)))
+ (push (list filename state) result)))
+
+ (funcall callback result nil)))
+
(defun vc-arch-working-revision (file)
(let* ((root (expand-file-name "{arch}" (vc-arch-root file)))
(defbranch (vc-arch-default-version file)))
(setq rev (replace-match (cdr rule) t nil rev))))
(format "Arch%c%s"
(case (vc-state file)
- ((up-to-date needs-patch) ?-)
+ ((up-to-date needs-update) ?-)
(added ?@)
(t ?:))
rev)))
(save-excursion
(let ((rej (concat buffer-file-name ".rej")))
(when (and buffer-file-name (vc-arch-diff3-rej-p rej))
- (if (not (re-search-forward "^<<<<<<< " nil t))
- ;; The .rej file is obsolete.
- (condition-case nil (delete-file rej) (error nil)))))))
+ (unless (re-search-forward "^<<<<<<< " nil t)
+ ;; The .rej file is obsolete.
+ (condition-case nil (delete-file rej) (error nil))
+ ;; Remove the hook so that it is not called multiple times.
+ (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t))))))
(defun vc-arch-find-file-hook ()
(let ((rej (concat buffer-file-name ".rej")))
(message "There are unresolved conflicts in %s"
(file-name-nondirectory rej))))))
-(defun vc-arch-checkout-model (file) 'implicit)
-
-(defun vc-arch-checkin (files rev comment)
+(defun vc-arch-checkin (files rev comment &optional extra-args-ignored)
(if rev (error "Committing to a specific revision is unsupported"))
;; FIXME: This implementation probably only works for singleton filesets
(let ((summary (file-relative-name (car files) (vc-arch-root (car files)))))
(setq newvers nil))
(if newvers
(error "Diffing specific revisions not implemented")
- (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process)))
+ (let* (process-file-side-effects
+ (async (not vc-disable-async-diff))
;; Run the command from the root dir.
(default-directory (vc-arch-root file))
(status
(or buffer "*vc-diff*")
(if async 'async 1)
nil "file-diffs"
- ;; Arch does not support the typical flags.
- ;; (vc-switches 'Arch 'diff)
+ (vc-switches 'Arch 'diff)
(file-relative-name file)
(if (equal oldvers (vc-working-revision file))
nil
(defun vc-arch-command (buffer okstatus file &rest flags)
"A wrapper around `vc-do-command' for use in vc-arch.el."
- (apply 'vc-do-command buffer okstatus vc-arch-command file flags))
+ (apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags))
(defun vc-arch-init-revision () nil)
(defun vc-arch-trim-make-sentinel (revs)
(if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done"))
- `(lambda (proc msg)
- (message "VC-Arch trimming %s..." ',(file-name-nondirectory (car revs)))
- (rename-file ,(car revs) ,(concat (car revs) "*rm*"))
+ (lexical-let ((revs revs))
+ (lambda (proc msg)
+ (message "VC-Arch trimming %s..." (file-name-nondirectory (car revs)))
+ (rename-file (car revs) (concat (car revs) "*rm*"))
(setq proc (start-process "vc-arch-trim" nil
- "rm" "-rf" ',(concat (car revs) "*rm*")))
- (set-process-sentinel proc (vc-arch-trim-make-sentinel ',(cdr revs))))))
+ "rm" "-rf" (concat (car revs) "*rm*")))
+ (set-process-sentinel proc (vc-arch-trim-make-sentinel (cdr revs)))))))
(defun vc-arch-trim-one-revlib (dir)
"Delete half of the revisions in the revision library."
(interactive "Ddirectory: ")
+ (let ((garbage (directory-files dir 'full "\\`,," 'nosort)))
+ (when garbage
+ (funcall (vc-arch-trim-make-sentinel garbage) nil nil)))
(let ((revs
(sort (delq nil
(mapcar
"Delete half of the revisions in the revision library."
(interactive)
(let ((rl-dir (with-output-to-string
- (call-process vc-arch-command nil standard-output nil
+ (call-process vc-arch-program nil standard-output nil
"my-revision-library"))))
(while (string-match "\\(.*\\)\n" rl-dir)
(let ((dir (match-string 1 rl-dir)))
map))
(defun vc-arch-extra-menu () vc-arch-extra-menu-map)
-
+
;;; Less obvious implementations.
HCoop / bpt / emacs.git / blobdiff