HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix comment typo.
[bpt/emacs.git]
/
lisp
/
vc-arch.el
diff --git
a/lisp/vc-arch.el
b/lisp/vc-arch.el
index
58a3bd0
..
cc8c8ae
100644
(file)
--- a/
lisp/vc-arch.el
+++ b/
lisp/vc-arch.el
@@
-7,10
+7,10
@@
;; This file is part of GNU Emacs.
;; 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
;; 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 Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@
-18,9
+18,7
@@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; 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:
;;; Commentary:
@@
-50,13
+48,18
@@
;; - C-x v u does not work.
;; - C-x v s does not work.
;; - C-x v r does not work.
;; - 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))
;; - 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
;;;
;;;
;;; Customization options
;;;
@@
-329,7
+332,7
@@
Return non-nil if FILE is unchanged."
(setq rev (replace-match (cdr rule) t nil rev))))
(format "Arch%c%s"
(case (vc-state 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)))
(added ?@)
(t ?:))
rev)))
@@
-369,8
+372,6
@@
Return non-nil if FILE is unchanged."
(message "There are unresolved conflicts in %s"
(file-name-nondirectory 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)
(if rev (error "Committing to a specific revision is unsupported"))
;; FIXME: This implementation probably only works for singleton filesets
(defun vc-arch-checkin (files rev comment)
(if rev (error "Committing to a specific revision is unsupported"))
;; FIXME: This implementation probably only works for singleton filesets
@@
-425,7
+426,7
@@
Return non-nil if FILE is unchanged."
(defun vc-arch-command (buffer okstatus file &rest flags)
"A wrapper around `vc-do-command' for use in vc-arch.el."
(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-command file flags))
(defun vc-arch-init-revision () nil)
(defun vc-arch-init-revision () nil)
@@
-487,16
+488,20
@@
Return non-nil if FILE is unchanged."
(defun vc-arch-trim-make-sentinel (revs)
(if (null revs) (lambda (proc msg) (message "VC-Arch trimming ... done"))
(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
(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: ")
(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
(let ((revs
(sort (delq nil
(mapcar