X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/9b75c1e26efe96f0ed327ee06b0e046a9e5724ed..8292beddd591f8acd2a349d8356f77d19ca72e66:/lisp/vc-arch.el diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index eb55506ed6..58a3bd0183 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -1,6 +1,6 @@ ;;; 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 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier @@ -9,7 +9,7 @@ ;; 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 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -193,10 +193,12 @@ Only the value `maybe' can be trusted :-(." (defun vc-arch-root (file) "Return the root directory of a 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")) @@ -265,7 +267,7 @@ Return non-nil if FILE is unchanged." ;; ID not found. (if (equal (file-name-nondirectory sigfile) (subst-char-in-string - ?/ ?% (vc-arch-workfile-version file))) + ?/ ?% (vc-arch-working-revision file))) 'added ;; Might be `added' or `up-to-date' as well. ;; FIXME: Check in the patch logs to find out. @@ -283,7 +285,7 @@ Return non-nil if FILE is unchanged." 'up-to-date 'edited))))))))) -(defun vc-arch-workfile-version (file) +(defun vc-arch-working-revision (file) (let* ((root (expand-file-name "{arch}" (vc-arch-root file))) (defbranch (vc-arch-default-version file))) (when (and defbranch (string-match "\\`\\(.+@[^/\n]+\\)/\\(\\(\\(.*?\\)\\(?:--.*\\)?\\)--.*\\)\\'" defbranch)) @@ -321,7 +323,7 @@ Return non-nil if FILE is unchanged." (defun vc-arch-mode-line-string (file) "Return string for placement in modeline by `vc-mode-line' for FILE." - (let ((rev (vc-workfile-version file))) + (let ((rev (vc-working-revision file))) (dolist (rule vc-arch-mode-line-rewrite) (if (string-match (car rule) rev) (setq rev (replace-match (cdr rule) t nil rev)))) @@ -345,9 +347,11 @@ Return non-nil if FILE is unchanged." (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"))) @@ -365,17 +369,12 @@ Return non-nil if FILE is unchanged." (message "There are unresolved conflicts in %s" (file-name-nondirectory rej)))))) -(defun vc-arch-find-file-not-found-hook () - ;; Do nothing. We are not sure whether the file is `source' or not, - ;; so we shouldn't ask the user whether she wants to check it out. - ) - (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 - (let ((summary (file-relative-name (car file) (vc-arch-root (car files))))) + (let ((summary (file-relative-name (car files) (vc-arch-root (car files))))) ;; Extract a summary from the comment. (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment) (string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment)) @@ -394,13 +393,13 @@ Return non-nil if FILE is unchanged." (let ((file (car files))) (if (and newvers (vc-up-to-date-p file) - (equal newvers (vc-workfile-version file))) + (equal newvers (vc-working-revision file))) ;; Newvers is the base revision and the current file is unchanged, ;; so we can diff with the current file. (setq newvers nil)) (if newvers (error "Diffing specific revisions not implemented") - (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) + (let* ((async (not vc-disable-async-diff)) ;; Run the command from the root dir. (default-directory (vc-arch-root file)) (status @@ -411,7 +410,7 @@ Return non-nil if FILE is unchanged." ;; Arch does not support the typical flags. ;; (vc-switches 'Arch 'diff) (file-relative-name file) - (if (equal oldvers (vc-workfile-version file)) + (if (equal oldvers (vc-working-revision file)) nil oldvers)))) (if async 1 status))))) ; async diff, pessimistic assumption. @@ -428,7 +427,7 @@ Return non-nil if FILE is unchanged." "A wrapper around `vc-do-command' for use in vc-arch.el." (apply 'vc-do-command buffer okstatus vc-arch-command file flags)) -(defun vc-arch-init-version () nil) +(defun vc-arch-init-revision () nil) ;;; Completion of versions and revisions. @@ -447,11 +446,11 @@ Return non-nil if FILE is unchanged." (concat "*/" string)) "*")))))) -(defun vc-arch-revision-completion-table (file) - (lexical-let ((file file)) +(defun vc-arch-revision-completion-table (files) + (lexical-let ((files files)) (lambda (string pred action) ;; FIXME: complete revision patches as well. - (let* ((root (expand-file-name "{arch}" (vc-arch-root file))) + (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files)))) (table (vc-arch--version-completion-table root string))) (complete-with-action action table string pred))))) @@ -552,10 +551,19 @@ Return non-nil if FILE is unchanged." branches)))) (mapc 'vc-arch-trim-one-revlib versions)) )) - + +(defvar vc-arch-extra-menu-map + (let ((map (make-sparse-keymap))) + (define-key map [add-tagline] + '(menu-item "Add tagline" vc-arch-add-tagline)) + map)) + +(defun vc-arch-extra-menu () vc-arch-extra-menu-map) + + ;;; Less obvious implementations. -(defun vc-arch-find-version (file rev buffer) +(defun vc-arch-find-revision (file rev buffer) (let ((out (make-temp-file "vc-out"))) (unwind-protect (progn