X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/32ccc8a5747ec380a9375251e1285264356b8866..3a0f6aac0db3b1961c759a278d2bc67b501ddd0a:/lisp/vc-arch.el diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index eb55506ed6..cc8c8ae3c1 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -1,16 +1,16 @@ ;;; 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 ;; 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 2, 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 @@ -18,9 +18,7 @@ ;; 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 . ;;; 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. -;; - 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 ;;; @@ -193,10 +196,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 +270,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 +288,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,13 +326,13 @@ 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)))) (format "Arch%c%s" (case (vc-state file) - ((up-to-date needs-patch) ?-) + ((up-to-date needs-update) ?-) (added ?@) (t ?:)) rev))) @@ -345,9 +350,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 +372,10 @@ 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 +394,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 +411,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. @@ -426,9 +426,9 @@ 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." - (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-version () nil) +(defun vc-arch-init-revision () nil) ;;; Completion of versions and revisions. @@ -447,11 +447,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))))) @@ -488,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")) - `(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 @@ -552,10 +556,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