X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/360cf7bc8899964e8699550eb3d755909f4af606..94cc397c541f50af6b049af6c42806daa2be2709:/lisp/vc-bzr.el diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index 23ce0d9c17..56fada271d 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -1,21 +1,16 @@ ;;; vc-bzr.el --- VC backend for the bzr revision control system -;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. - -;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el, -;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el -;; I could not get in touch with Dave Love by email, so -;; I am releasing my changes separately. -- Riccardo +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Dave Love , Riccardo Murri ;; Keywords: tools ;; Created: Sept 2006 -;; Version: 2007-05-24 +;; Version: 2008-01-04 (Bzr revno 25) ;; URL: http://launchpad.net/vc-bzr ;; This file 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. ;; This file is distributed in the hope that it will be useful, @@ -31,16 +26,11 @@ ;;; Commentary: -;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el, -;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el - -;; See concerning bzr. - -;; Load this library to register bzr support in VC. It covers basic VC -;; functionality, but was only lightly exercised with a few Emacs/bzr -;; version combinations, namely those current on the authors' PCs. -;; See various Fixmes below. +;; See concerning bzr. See +;; for alternate development +;; branches of `vc-bzr'. +;; Load this library to register bzr support in VC. ;; Known bugs ;; ========== @@ -63,11 +53,11 @@ ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. -(put 'BZR 'vc-functions nil) +(put 'Bzr 'vc-functions nil) (defgroup vc-bzr nil "VC bzr backend." -;; :version "22" + :version "22.2" :group 'vc) (defcustom vc-bzr-program "bzr" @@ -75,12 +65,6 @@ :group 'vc-bzr :type 'string) -;; Fixme: there's probably no call for this. -(defcustom vc-bzr-program-args nil - "List of global arguments to pass to `vc-bzr-program'." - :group 'vc-bzr - :type '(repeat string)) - (defcustom vc-bzr-diff-switches nil "String/list of strings specifying extra switches for bzr diff under VC." :type '(choice (const :tag "None" nil) @@ -88,170 +72,225 @@ (repeat :tag "Argument List" :value ("") string)) :group 'vc-bzr) -(defvar vc-bzr-version nil - "Internal use.") - -;; Could be used for compatibility checks if bzr changes. -(defun vc-bzr-version () - "Return a three-numeric element list with components of the bzr version. -This is of the form (X Y Z) for revision X.Y.Z. The elements are zero -if running `vc-bzr-program' doesn't produce the expected output." - (or vc-bzr-version - (setq vc-bzr-version - (let ((s (shell-command-to-string - (concat (shell-quote-argument vc-bzr-program) - " --version")))) - (if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s) - (list (string-to-number (match-string 1 s)) - (string-to-number (match-string 2 s)) - (string-to-number (match-string 3 s))) - '(0 0 0)))))) - -(defun vc-bzr-at-least-version (vers) - "Return t if the bzr command reports being a least version VERS. -First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'." - (version-list-<= vers (vc-bzr-version))) +(defcustom vc-bzr-log-switches nil + "String/list of strings specifying extra switches for `bzr log' under VC." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" :value ("") string)) + :group 'vc-bzr) ;; since v0.9, bzr supports removing the progress indicators ;; by setting environment variable BZR_PROGRESS_BAR to "none". -(defun vc-bzr-command (bzr-command buffer okstatus file &rest args) +(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args) "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. -Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." +Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and +`LC_MESSAGES=C' to the environment." (let ((process-environment (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9) - "LC_ALL=C" ; Force English output - process-environment)) - ;; bzr may attempt some kind of user interaction if its stdin/stdout - ;; is connected to a PTY; therefore, ask Emacs to use a pipe to - ;; communicate with it. - ;; This is redundant because vc-do-command does it already. --Stef - (process-connection-type nil)) + "LC_MESSAGES=C" ; Force English output + process-environment))) (apply 'vc-do-command buffer okstatus vc-bzr-program - file bzr-command (append vc-bzr-program-args args)))) - -(unless (vc-bzr-at-least-version '(0 9)) - ;; For older versions, we fall back to washing the log buffer - ;; when all output has been gathered. - (defun vc-bzr-post-command-function (command file flags) - "`vc-post-command-functions' function to remove progress messages." - ;; Note that using this requires that the vc command is run - ;; synchronously. Otherwise, the ^Ms in the leading progress - ;; message on stdout cause the stream to be interpreted as having - ;; DOS line endings, losing the ^Ms, so the search fails. I don't - ;; know how this works under Windows. - (when (equal command vc-bzr-program) - (save-excursion - (goto-char (point-min)) - (if (looking-at "^\\(\r.*\r\\)[^\r]+$") - (replace-match "" nil nil nil 1))) - (save-excursion - (goto-char (point-min)) - ;; This is inserted by bzr 0.11 `log', at least - (while (looking-at "read knit.*\n") - (replace-match ""))))) - - (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function)) + file-or-list bzr-command args))) + ;;;###autoload -(defconst vc-bzr-admin-dirname ".bzr") ; FIXME: "_bzr" on w32? +(defconst vc-bzr-admin-dirname ".bzr" + "Name of the directory containing Bzr repository status files.") +;;;###autoload +(defconst vc-bzr-admin-checkout-format-file + (concat vc-bzr-admin-dirname "/checkout/format")) +(defconst vc-bzr-admin-dirstate + (concat vc-bzr-admin-dirname "/checkout/dirstate")) +(defconst vc-bzr-admin-branch-format-file + (concat vc-bzr-admin-dirname "/branch/format")) +(defconst vc-bzr-admin-revhistory + (concat vc-bzr-admin-dirname "/branch/revision-history")) +(defconst vc-bzr-admin-lastrev + (concat vc-bzr-admin-dirname "/branch/last-revision")) ;;;###autoload (defun vc-bzr-registered (file) -;;;###autoload (if (vc-find-root file vc-bzr-admin-dirname) +;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file) ;;;###autoload (progn ;;;###autoload (load "vc-bzr") ;;;###autoload (vc-bzr-registered file)))) -(defun vc-bzr-root-dir (file) - "Return the root directory in the hierarchy above FILE. -Return nil if there isn't one." - (vc-find-root file vc-bzr-admin-dirname)) +(defun vc-bzr-root (file) + "Return the root directory of the bzr repository containing FILE." + ;; Cache technique copied from vc-arch.el. + (or (vc-file-getprop file 'bzr-root) + (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file))) + (when root (vc-file-setprop file 'bzr-root root))))) (defun vc-bzr-registered (file) - "Return non-nil if FILE is registered with bzr." - (if (vc-bzr-root-dir file) ; Short cut. - (vc-bzr-state file))) ; Expensive. - -(defun vc-bzr-buffer-nonblank-p (&optional buffer) - "Return non-nil if BUFFER contains any non-blank characters." - (or (> (buffer-size buffer) 0) - (save-excursion - (set-buffer (or buffer (current-buffer))) - (goto-char (point-min)) - (re-search-forward "[^ \t\n]" (point-max) t)))) + "Return non-nil if FILE is registered with bzr. + +For speed, this function tries first to parse Bzr internal file +`checkout/dirstate', but it may fail if Bzr internal file format +has changed. As a safeguard, the `checkout/dirstate' file is +only parsed if it contains the string `#bazaar dirstate flat +format 3' in the first line. + +If the `checkout/dirstate' file cannot be parsed, fall back to +running `vc-bzr-state'." + (lexical-let ((root (vc-bzr-root file))) + (when root ; Short cut. + ;; This looks at internal files. May break if they change + ;; their format. + (lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root))) + (if (not (file-readable-p dirstate)) + (vc-bzr-state file) ; Expensive. + (with-temp-buffer + (insert-file-contents dirstate) + (goto-char (point-min)) + (if (not (looking-at "#bazaar dirstate flat format 3")) + (vc-bzr-state file) ; Some other unknown format? + (let* ((relfile (file-relative-name file root)) + (reldir (file-name-directory relfile))) + (re-search-forward + (concat "^\0" + (if reldir (regexp-quote (directory-file-name reldir))) + "\0" + (regexp-quote (file-name-nondirectory relfile)) + "\0") + nil t))))))))) (defconst vc-bzr-state-words - "added\\|ignored\\|modified\\|removed\\|renamed\\|unknown" + "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown" "Regexp matching file status words as reported in `bzr' output.") -;; FIXME: Also get this in a non-registered sub-directory. -(defun vc-bzr-state (file) +(defun vc-bzr-file-name-relative (filename) + "Return file name FILENAME stripped of the initial Bzr repository path." + (lexical-let* + ((filename* (expand-file-name filename)) + (rootdir (vc-bzr-root filename*))) + (when rootdir + (file-relative-name filename* rootdir)))) + +(defun vc-bzr-status (file) + "Return FILE status according to Bzr. +Return value is a cons (STATUS . WARNING), where WARNING is a +string or nil, and STATUS is one of the symbols: `added', +`ignored', `kindchanged', `modified', `removed', `renamed', `unknown', +which directly correspond to `bzr status' output, or 'unchanged +for files whose copy in the working tree is identical to the one +in the branch repository, or nil for files that are not +registered with Bzr. + +If any error occurred in running `bzr status', then return nil." (with-temp-buffer - (cd (file-name-directory file)) - (let ((ret (vc-bzr-command "status" t 255 file)) - (state 'up-to-date)) - ;; the only secure status indication in `bzr status' output - ;; is a couple of lines following the pattern:: - ;; | : - ;; | - ;; if the file is up-to-date, we get no status report from `bzr', - ;; so if the regexp search for the above pattern fails, we consider - ;; the file to be up-to-date. - (goto-char (point-min)) - (when - (re-search-forward - (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" - (file-name-nondirectory file) "[ \t\n]*$") - (point-max) t) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (goto-char start) - (setq state - (cond - ((not (equal ret 0)) nil) - ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) - ((looking-at "unknown\\|ignored") nil))) - ;; erase the status text that matched - (delete-region start end))) - (when (vc-bzr-buffer-nonblank-p) - ;; "bzr" will output some warnings and informational messages - ;; to the user to stderr; due to Emacs' `vc-do-command' (and, - ;; it seems, `start-process' itself), we cannot catch stderr - ;; and stdout into different buffers. So, if there's anything - ;; left in the buffer after removing the above status - ;; keywords, let us just presume that any other message from - ;; "bzr" is a user warning, and display it. - (message "Warnings in `bzr' output: %s" - (buffer-substring (point-min) (point-max)))) - (when state - (vc-file-setprop file 'vc-workfile-version - (vc-bzr-workfile-version file)) - (vc-file-setprop file 'vc-state state)) - state))) + (let ((ret (condition-case nil + (vc-bzr-command "status" t 0 file) + (file-error nil))) ; vc-bzr-program not found. + (status 'unchanged)) + ;; the only secure status indication in `bzr status' output + ;; is a couple of lines following the pattern:: + ;; | : + ;; | + ;; if the file is up-to-date, we get no status report from `bzr', + ;; so if the regexp search for the above pattern fails, we consider + ;; the file to be up-to-date. + (goto-char (point-min)) + (when (re-search-forward + ;; bzr prints paths relative to the repository root. + (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+" + (regexp-quote (vc-bzr-file-name-relative file)) + ;; Bzr appends a '/' to directory names and + ;; '*' to executable files + (if (file-directory-p file) "/?" "\\*?") + "[ \t\n]*$") + nil t) + (lexical-let ((statusword (match-string 1))) + ;; Erase the status text that matched. + (delete-region (match-beginning 0) (match-end 0)) + (setq status + (intern (replace-regexp-in-string " " "" statusword))))) + (when status + (goto-char (point-min)) + (skip-chars-forward " \n\t") ;Throw away spaces. + (cons status + ;; "bzr" will output warnings and informational messages to + ;; stderr; due to Emacs' `vc-do-command' (and, it seems, + ;; `start-process' itself) limitations, we cannot catch stderr + ;; and stdout into different buffers. So, if there's anything + ;; left in the buffer after removing the above status + ;; keywords, let us just presume that any other message from + ;; "bzr" is a user warning, and display it. + (unless (eobp) (buffer-substring (point) (point-max)))))))) -(defun vc-bzr-workfile-unchanged-p (file) - (eq 'up-to-date (vc-bzr-state file))) +(defun vc-bzr-state (file) + (lexical-let ((result (vc-bzr-status file))) + (when (consp result) + (if (cdr result) + (message "Warnings in `bzr' output: %s" (cdr result))) + (cdr (assq (car result) + '((added . edited) + (kindchanged . edited) + (renamed . edited) + (modified . edited) + (removed . edited) + (ignored . nil) + (unknown . nil) + (unchanged . up-to-date))))))) -(defun vc-bzr-workfile-version (file) - ;; Looks like this could be obtained via counting lines in - ;; .bzr/branch/revision-history. - (with-temp-buffer - (vc-bzr-command "revno" t 0 file) - (goto-char (point-min)) - (buffer-substring (point) (line-end-position)))) +(defun vc-bzr-workfile-unchanged-p (file) + (eq 'unchanged (car (vc-bzr-status file)))) + +(defun vc-bzr-working-revision (file) + (lexical-let* + ((rootdir (vc-bzr-root file)) + (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file + rootdir)) + (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir)) + (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir))) + ;; This looks at internal files to avoid forking a bzr process. + ;; May break if they change their format. + (if (file-exists-p branch-format-file) + (with-temp-buffer + (insert-file-contents branch-format-file) + (goto-char (point-min)) + (cond + ((or + (looking-at "Bazaar-NG branch, format 0.0.4") + (looking-at "Bazaar-NG branch format 5")) + ;; count lines in .bzr/branch/revision-history + (insert-file-contents revhistory-file) + (number-to-string (count-lines (line-end-position) (point-max)))) + ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") + ;; revno is the first number in .bzr/branch/last-revision + (insert-file-contents lastrev-file) + (if (re-search-forward "[0-9]+" nil t) + (buffer-substring (match-beginning 0) (match-end 0)))))) + ;; fallback to calling "bzr revno" + (lexical-let* + ((result (vc-bzr-command-discarding-stderr + vc-bzr-program "revno" file)) + (exitcode (car result)) + (output (cdr result))) + (cond + ((eq exitcode 0) (substring output 0 -1)) + (t nil)))))) (defun vc-bzr-checkout-model (file) 'implicit) -(defun vc-bzr-register (file &optional rev comment) +(defun vc-bzr-create-repo () + "Create a new Bzr repository." + (vc-bzr-command "init" nil 0 nil)) + +(defun vc-bzr-init-version (&optional file) + "Always return nil, as Bzr cannot register explicit versions." + nil) + +(defun vc-bzr-register (files &optional rev comment) "Register FILE under bzr. Signal an error unless REV is nil. COMMENT is ignored." - (if rev (error "Can't register explicit version with bzr")) - (vc-bzr-command "add" nil 0 file)) + (if rev (error "Can't register explicit revision with bzr")) + (vc-bzr-command "add" nil 0 files)) ;; Could run `bzr status' in the directory and see if it succeeds, but ;; that's relatively expensive. -(defalias 'vc-bzr-responsible-p 'vc-bzr-root-dir +(defalias 'vc-bzr-responsible-p 'vc-bzr-root "Return non-nil if FILE is (potentially) controlled by bzr. The criterion is that there is a `.bzr' directory in the same or a superior directory.") @@ -270,13 +309,20 @@ or a superior directory.") (defun vc-bzr-unregister (file) "Unregister FILE from bzr." - (vc-bzr-command "remove" nil 0 file)) + (vc-bzr-command "remove" nil 0 file "--keep")) -(defun vc-bzr-checkin (file rev comment) +(defun vc-bzr-checkin (files rev comment) "Check FILE in to bzr with log message COMMENT. REV non-nil gets an error." - (if rev (error "Can't check in a specific version with bzr")) - (vc-bzr-command "commit" nil 0 file "-m" comment)) + (if rev (error "Can't check in a specific revision with bzr")) + (vc-bzr-command "commit" nil 0 files "-m" comment)) + +(defun vc-bzr-find-version (file rev buffer) + "Fetch version REV of file FILE and put it into BUFFER." + (with-current-buffer buffer + (if (and rev (stringp rev) (not (string= rev ""))) + (vc-bzr-command "cat" t 0 file "-r" rev) + (vc-bzr-command "cat" t 0 file)))) (defun vc-bzr-checkout (file &optional editable rev destfile) "Checkout revision REV of FILE from bzr to DESTFILE. @@ -285,14 +331,14 @@ EDITABLE is ignored." (setq destfile (vc-version-backup-file-name file rev))) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) - (with-temp-file destfile - (if rev - (vc-bzr-command "cat" t 0 file "-r" rev) - (vc-bzr-command "cat" t 0 file))))) + (with-temp-file destfile + (if (and rev (stringp rev) (not (string= rev ""))) + (vc-bzr-command "cat" t 0 file "-r" rev) + (vc-bzr-command "cat" t 0 file))))) (defun vc-bzr-revert (file &optional contents-done) (unless contents-done - (with-temp-buffer (vc-bzr-command "revert" t 'async file)))) + (with-temp-buffer (vc-bzr-command "revert" t 0 file)))) (defvar log-view-message-re) (defvar log-view-file-re) @@ -317,52 +363,44 @@ EDITABLE is ignored." (2 'change-log-email)) ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)))))) -(defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22 - "Get bzr change log for FILE into specified BUFFER." - ;; Fixme: This might need the locale fixing up if things like `revno' - ;; got localized, but certainly it shouldn't use LC_ALL=C. - ;; NB. Can't be async -- see `vc-bzr-post-command-function'. - (vc-bzr-command "log" buffer 0 file) +(defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22 + "Get bzr change log for FILES into specified BUFFER." + ;; FIXME: `vc-bzr-command' runs `bzr log' with `LC_MESSAGES=C', so + ;; the log display may not what the user wants - but I see no other + ;; way of getting the above regexps working. + (apply 'vc-bzr-command "log" buffer 0 files + (if (stringp vc-bzr-log-switches) + (list vc-bzr-log-switches) + vc-bzr-log-switches)) ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for ;; the buffer, or at least set the regexps right. (unless (fboundp 'vc-default-log-view-mode) (add-hook 'log-view-mode-hook 'vc-bzr-log-view-mode))) -(defun vc-bzr-show-log-entry (version) - "Find entry for patch name VERSION in bzr change log buffer." +(defun vc-bzr-show-log-entry (revision) + "Find entry for patch name REVISION in bzr change log buffer." (goto-char (point-min)) (let (case-fold-search) - (if (re-search-forward (concat "^-+\nrevno: " version "$") nil t) + (if (re-search-forward (concat "^-+\nrevno: " revision "$") nil t) (beginning-of-line 0) (goto-char (point-min))))) -;; Fixem: vc-bzr-wash-log - (autoload 'vc-diff-switches-list "vc" nil nil t) -(defun vc-bzr-diff (file &optional rev1 rev2 buffer) +(defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff." - (let ((working (vc-workfile-version file))) - (if (and (equal rev1 working) (not rev2)) - (setq rev1 nil)) - (if (and (not rev1) rev2) - (setq rev1 working)) - ;; NB. Can't be async -- see `vc-bzr-post-command-function'. - ;; bzr diff produces condition code 1 for some reason. - (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file - "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) - " ") - (when rev1 - (if rev2 - (list "-r" (format "%s..%s" rev1 rev2)) - (list "-r" rev1)))))) - -(defalias 'vc-bzr-diff-tree 'vc-bzr-diff) - -;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info - -;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with -;; straight integer versions. + ;; `bzr diff' exits with code 1 if diff is non-empty + (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files + "--diff-options" (mapconcat 'identity + (vc-diff-switches-list bzr) + " ") + (list "-r" (format "%s..%s" + (or rev1 "revno:-1") + (or rev2 ""))))) + + +;; FIXME: vc-{next,previous}-revision need fixing in vc.el to deal with +;; straight integer revisions. (defun vc-bzr-delete-file (file) "Delete FILE and delete it in the bzr repository." @@ -379,18 +417,18 @@ EDITABLE is ignored." "Internal use.") (make-variable-buffer-local 'vc-bzr-annotation-table) -(defun vc-bzr-annotate-command (file buffer &optional version) +(defun vc-bzr-annotate-command (file buffer &optional revision) "Prepare BUFFER for `vc-annotate' on FILE. Each line is tagged with the revision number, which has a `help-echo' property containing author and date information." - (apply #'vc-bzr-command "annotate" buffer 0 file "-l" "--all" - (if version (list "-r" version))) + (apply #'vc-bzr-command "annotate" buffer 0 file "--long" "--all" + (if revision (list "-r" revision))) (with-current-buffer buffer ;; Store the tags for the annotated source lines in a hash table ;; to allow saving space by sharing the text properties. (setq vc-bzr-annotation-table (make-hash-table :test 'equal)) (goto-char (point-min)) - (while (re-search-forward "^\\( *[0-9]+\\) \\(.+\\) +\\([0-9]\\{8\\}\\) |" + (while (re-search-forward "^\\( *[0-9]+\\) +\\(.+\\) +\\([0-9]\\{8\\}\\) |" nil t) (let* ((rev (match-string 1)) (author (match-string 2)) @@ -398,9 +436,6 @@ property containing author and date information." (key (match-string 0)) (tag (gethash key vc-bzr-annotation-table))) (unless tag - (save-match-data - (string-match " +\\'" author) - (setq author (substring author 0 (match-beginning 0)))) (setq tag (propertize rev 'help-echo (concat "Author: " author ", date: " date) 'mouse-face 'highlight)) @@ -408,14 +443,6 @@ property containing author and date information." (replace-match "") (insert tag " |"))))) -;; Definition from Emacs 22 -(unless (fboundp 'vc-annotate-convert-time) -(defun vc-annotate-convert-time (time) - "Convert a time value to a floating-point number of days. -The argument TIME is a list as returned by `current-time' or -`encode-time', only the first two elements of that list are considered." - (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) - (defun vc-bzr-annotate-time () (when (re-search-forward "^ *[0-9]+ |" nil t) (let ((prop (get-text-property (line-beginning-position) 'help-echo))) @@ -435,29 +462,22 @@ Return nil if current line isn't annotated." (if (looking-at " *\\([0-9]+\\) | ") (match-string-no-properties 1)))) -;; Not needed for Emacs 22 -(defun vc-bzr-annotate-difference (point) - (let ((next-time (vc-bzr-annotate-time))) - (if next-time - (- (vc-annotate-convert-time (current-time)) next-time)))) - -;; FIXME: `bzr root' will return the real path to the repository root, -;; that is, it can differ from the buffer's current directory name -;; if there are any symbolic links. -(defun vc-bzr-root (dir) - "Return the root directory of the bzr repository containing DIR." - ;; Cache technique copied from vc-arch.el. - (or (vc-file-getprop dir 'bzr-root) - (vc-file-setprop - dir 'bzr-root - (substring - (shell-command-to-string (concat vc-bzr-program " root " dir)) 0 -1)))) +(defun vc-bzr-command-discarding-stderr (command &rest args) + "Execute shell command COMMAND (with ARGS); return its output and exitcode. +Return value is a cons (EXITCODE . OUTPUT), where EXITCODE is +the (numerical) exit code of the process, and OUTPUT is a string +containing whatever the process sent to its standard output +stream. Standard error output is discarded." + (with-temp-buffer + (cons + (apply #'call-process command nil (list (current-buffer) nil) nil args) + (buffer-substring (point-min) (point-max))))) ;; TODO: it would be nice to mark the conflicted files in VC Dired, ;; and implement a command to run ediff and `bzr resolve' once the ;; changes have been merged. (defun vc-bzr-dir-state (dir &optional localp) - "Find the VC state of all files in DIR. + "Find the VC state of all files in DIR and its subdirectories. Optional argument LOCALP is always ignored." (let ((bzr-root-directory (vc-bzr-root dir)) (at-start t) @@ -470,7 +490,8 @@ Optional argument LOCALP is always ignored." ;; evidence of the contrary. (setq at-start t) (with-temp-buffer - (vc-bzr-command "ls" t 0 nil "--versioned" "--non-recursive") + (buffer-disable-undo) ;; Because these buffers can get huge + (vc-bzr-command "ls" t 0 nil "--versioned") (goto-char (point-min)) (while (or at-start (eq 0 (forward-line))) @@ -479,10 +500,14 @@ Optional argument LOCALP is always ignored." (buffer-substring-no-properties (line-beginning-position) (line-end-position)) bzr-root-directory))) + ;; files are up-to-date unless they appear in the `bzr + ;; status' output below (vc-file-setprop file 'vc-state 'up-to-date) ;; XXX: is this correct? what happens if one ;; mixes different SCMs in the same dir? - (vc-file-setprop file 'vc-backend 'BZR)))) + ;; Anyway, we're looking at the output of `bzr ls --versioned', + ;; so we know these files are registered with Bzr. + (vc-file-setprop file 'vc-backend 'Bzr)))) ;; `bzr status' reports on added/modified/renamed and unknown/ignored files (setq at-start t) (with-temp-buffer @@ -493,16 +518,22 @@ Optional argument LOCALP is always ignored." (setq at-start nil) (cond ((looking-at "^added") - (setq current-vc-state 'edited) + (setq current-vc-state 'added) (setq current-bzr-state 'added)) + ((looking-at "^kind changed") + (setq current-vc-state 'edited) + (setq current-bzr-state 'kindchanged)) ((looking-at "^modified") (setq current-vc-state 'edited) (setq current-bzr-state 'modified)) ((looking-at "^renamed") (setq current-vc-state 'edited) (setq current-bzr-state 'renamed)) - ((looking-at "^\\(unknown\\|ignored\\)") - (setq current-vc-state nil) + ((looking-at "^ignored") + (setq current-vc-state 'ignored) + (setq current-bzr-state 'not-versioned)) + ((looking-at "^unknown") + (setq current-vc-state 'unregistered) (setq current-bzr-state 'not-versioned)) ((looking-at " ") ;; file names are indented by two spaces @@ -514,7 +545,7 @@ Optional argument LOCALP is always ignored." (vc-file-setprop file 'vc-state current-vc-state) (vc-file-setprop file 'vc-bzr-state current-bzr-state) (when (eq 'added current-bzr-state) - (vc-file-setprop file 'vc-workfile-version "0")))) + (vc-file-setprop file 'vc-working-revision "0")))) (when (eq 'not-versioned current-bzr-state) (let ((file (expand-file-name (buffer-substring-no-properties @@ -530,23 +561,13 @@ Optional argument LOCALP is always ignored." (defun vc-bzr-dired-state-info (file) "Bzr-specific version of `vc-dired-state-info'." (if (eq 'edited (vc-state file)) - (let ((bzr-state (vc-file-getprop file 'vc-bzr-state))) - (if bzr-state - (concat "(" (symbol-name bzr-state) ")") - ;; else fall back to default vc representation - (vc-default-dired-state-info 'BZR file))))) - -;; In case of just `(load "vc-bzr")', but that's probably the wrong -;; way to do it. -(add-to-list 'vc-handled-backends 'BZR) + (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) + 'edited)) ")") + ;; else fall back to default vc.el representation + (vc-default-dired-state-info 'Bzr file))) (eval-after-load "vc" - '(add-to-list 'vc-directory-exclusion-list ".bzr" t)) - -(defconst vc-bzr-unload-hook - (lambda () - (setq vc-handled-backends (delq 'BZR vc-handled-backends)) - (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) + '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t)) (provide 'vc-bzr) ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06