X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4787a496a05fdc03241850b45911dd283d4b06b8..a9e3ff690bba45e6723e9d355517767d8b52d41a:/lisp/vc-bzr.el diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el index d9f8a127f3..cafca38389 100644 --- a/lisp/vc-bzr.el +++ b/lisp/vc-bzr.el @@ -1,8 +1,9 @@ ;;; vc-bzr.el --- VC backend for the bzr revision control system -;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. -;; Author: Dave Love , Riccardo Murri +;; Author: Dave Love +;; Riccardo Murri ;; Keywords: tools ;; Created: Sept 2006 ;; Version: 2008-01-04 (Bzr revno 25) @@ -52,7 +53,8 @@ (eval-when-compile (require 'cl) - (require 'vc)) ; for vc-exec-after + (require 'vc) ;; for vc-exec-after + (require 'vc-dir)) ;; Clear up the cache to force vc-call to check again and discover ;; new functions when we reload this file. @@ -69,14 +71,16 @@ :type '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) + "String or list of strings specifying switches for bzr 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)) :group 'vc-bzr) (defcustom vc-bzr-log-switches nil - "String/list of strings specifying extra switches for `bzr log' under VC." + "String or list of strings specifying switches for bzr log under VC." :type '(choice (const :tag "None" nil) (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) @@ -213,7 +217,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and (lexical-let* ((filename* (expand-file-name filename)) (rootdir (vc-bzr-root filename*))) - (when rootdir + (when rootdir (file-relative-name filename* rootdir)))) (defun vc-bzr-status (file) @@ -323,22 +327,41 @@ If any error occurred in running `bzr status', then return nil." (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) + (if (and (file-exists-p branch-format-file) + ;; For lightweight checkouts (obtained with bzr checkout --lightweight) + ;; the branch-format-file does not contain the revision + ;; information, we need to look up the branch-format-file + ;; in the place where the lightweight checkout comes + ;; from. We only do that if it's a local file. + (let ((location-fname (expand-file-name + (concat vc-bzr-admin-dirname + "/branch/location") rootdir))) + ;; The existence of this file is how we distinguish + ;; lightweight checkouts. + (if (file-exists-p location-fname) + (with-temp-buffer + (insert-file-contents location-fname) + (when (re-search-forward "file://\(.+\)" nil t) + (setq branch-format-file (match-string 1)) + (file-exists-p branch-format-file))) + t))) (with-temp-buffer - (insert-file-contents branch-format-file) + (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) + (insert-file-contents revhistory-file) (number-to-string (count-lines (line-end-position) (point-max)))) - ((looking-at "Bazaar Branch Format 6 (bzr 0.15)") + ((or + (looking-at "Bazaar Branch Format 6 (bzr 0.15)") + (looking-at "Bazaar Branch Format 7 (needs bzr 1.6)")) ;; 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)))))) + (insert-file-contents lastrev-file) + (when (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 @@ -403,8 +426,8 @@ REV non-nil gets an error." (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." +(defun vc-bzr-find-revision (file rev buffer) + "Fetch revision 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) @@ -423,13 +446,15 @@ REV non-nil gets an error." (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-current-tag-function) +(defvar log-view-per-file-logs) (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. (require 'add-log) + (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)") (set (make-local-variable 'log-view-message-re) - "^ *-+\n *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)") + "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)") (set (make-local-variable 'log-view-font-lock-keywords) ;; log-view-font-lock-keywords is careful to use the buffer-local ;; value of log-view-message-re only since Emacs-23. @@ -465,28 +490,30 @@ REV non-nil gets an error." (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 - ;; "revno:" can appear either at the beginning of a line, or indented. - (concat "^[ ]*-+\n[ ]*revno: " - ;; The revision can contain ".", quote it so that it - ;; does not interfere with regexp matching. - (regexp-quote revision) "$") nil t) - (beginning-of-line 0) - (goto-char (point-min))))) + (when revision + (let (case-fold-search) + (if (re-search-forward + ;; "revno:" can appear either at the beginning of a line, + ;; or indented. + (concat "^[ ]*-+\n[ ]*revno: " + ;; The revision can contain ".", quote it so that it + ;; does not interfere with regexp matching. + (regexp-quote revision) "$") nil t) + (beginning-of-line 0) + (goto-char (point-min)))))) (defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff." ;; `bzr diff' exits with code 1 if diff is non-empty. (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 'async files - "--diff-options" (mapconcat 'identity - (vc-diff-switches-list bzr) + "--diff-options" (mapconcat 'identity + (vc-switches 'bzr 'diff) " ") ;; This `when' is just an optimization because bzr-1.2 is *much* ;; faster when the revision argument is not given. (when (or rev1 rev2) (list "-r" (format "%s..%s" - (or rev1 "revno:-1") + (or rev1 "revno:-1") (or rev2 "")))))) @@ -534,23 +561,25 @@ property containing author and date information." (replace-match "") (insert tag " |"))))) +(declare-function vc-annotate-convert-time "vc-annotate" (time)) + (defun vc-bzr-annotate-time () (when (re-search-forward "^ *[0-9.]+ +|" nil t) (let ((prop (get-text-property (line-beginning-position) 'help-echo))) (string-match "[0-9]+\\'" prop) + (let ((str (match-string-no-properties 0 prop))) (vc-annotate-convert-time (encode-time 0 0 0 - (string-to-number (substring (match-string 0 prop) 6 8)) - (string-to-number (substring (match-string 0 prop) 4 6)) - (string-to-number (substring (match-string 0 prop) 0 4)) - ))))) + (string-to-number (substring str 6 8)) + (string-to-number (substring str 4 6)) + (string-to-number (substring str 0 4)))))))) (defun vc-bzr-annotate-extract-revision-at-line () "Return revision for current line of annoation buffer, or nil. Return nil if current line isn't annotated." (save-excursion (beginning-of-line) - (if (looking-at " *\\([0-9.]+\\) | ") + (if (looking-at " *\\([0-9.]+\\) *| ") (match-string-no-properties 1)))) (defun vc-bzr-command-discarding-stderr (command &rest args) @@ -567,45 +596,87 @@ stream. Standard error output is discarded." (defun vc-bzr-prettify-state-info (file) "Bzr-specific version of `vc-prettify-state-info'." (if (eq 'edited (vc-state file)) - (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) + (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) 'edited)) ")") ;; else fall back to default vc.el representation (vc-default-prettify-state-info 'Bzr file))) -;; XXX: this needs testing, it's probably incomplete. +(defstruct (vc-bzr-extra-fileinfo + (:copier nil) + (:constructor vc-bzr-create-extra-fileinfo (extra-name)) + (:conc-name vc-bzr-extra-fileinfo->)) + extra-name) ;; original name for rename targets, new name for + +(defun vc-bzr-dir-printer (info) + "Pretty-printer for the vc-dir-fileinfo structure." + (let ((extra (vc-dir-fileinfo->extra info))) + (vc-default-dir-printer 'Bzr info) + (when extra + (insert (propertize + (format " (renamed from %s)" + (vc-bzr-extra-fileinfo->extra-name extra)) + 'face 'font-lock-comment-face))))) + +;; FIXME: this needs testing, it's probably incomplete. (defun vc-bzr-after-dir-status (update-function) (let ((status-str nil) - (translation '(("+N" . added) - ("-D" . removed) - (" M" . edited) - ;; XXX: what about ignored files? - (" D" . missing) - ("C " . conflict) - ("? " . unregistered))) + (translation '(("+N " . added) + ("-D " . removed) + (" M " . edited) ;; file text modified + (" *" . edited) ;; execute bit changed + (" M*" . edited) ;; text modified + execute bit changed + ;; FIXME: what about ignored files? + (" D " . missing) + ;; For conflicts, should we list the .THIS/.BASE/.OTHER? + ("C " . conflict) + ("? " . unregistered) + ("? " . unregistered) + ;; No such state, but we need to distinguish this case. + ("R " . renamed) + ;; For a non existent file FOO, the output is: + ;; bzr: ERROR: Path(s) do not exist: FOO + ("bzr" . not-found) + ;; If the tree is not up to date, bzr will print this warning: + ;; working tree is out of date, run 'bzr update' + ;; ignore it. + ;; FIXME: maybe this warning can be put in the vc-dir header... + ("wor" . not-found) + ;; Ignore "P " and "P." for pending patches. + )) (translated nil) (result nil)) (goto-char (point-min)) (while (not (eobp)) (setq status-str - (buffer-substring-no-properties (point) (+ (point) 2))) + (buffer-substring-no-properties (point) (+ (point) 3))) (setq translated (cdr (assoc status-str translation))) - ;; For conflicts the file appears twice in the listing: once - ;; with the M flag and once with the C flag, so take care not - ;; to add it twice to `result'. Ugly. - (if (eq translated 'conflict) - (let* ((file - (buffer-substring-no-properties - ;;For files with conflicts the format is: - ;;C Text conflict in FILENAME - ;; Bah. - (+ (point) 21) (line-end-position))) - (entry (assoc file result))) - (when entry - (setf (nth 1 entry) 'conflict))) + (cond + ((eq translated 'conflict) + ;; For conflicts the file appears twice in the listing: once + ;; with the M flag and once with the C flag, so take care + ;; not to add it twice to `result'. Ugly. + (let* ((file + (buffer-substring-no-properties + ;;For files with conflicts the format is: + ;;C Text conflict in FILENAME + ;; Bah. + (+ (point) 21) (line-end-position))) + (entry (assoc file result))) + (when entry + (setf (nth 1 entry) 'conflict)))) + ((eq translated 'renamed) + (re-search-forward "R \\(.*\\) => \\(.*\\)$" (line-end-position) t) + (let ((new-name (match-string 2)) + (old-name (match-string 1))) + (push (list new-name 'edited + (vc-bzr-create-extra-fileinfo old-name)) result))) + ;; do nothing for non existent files + ((eq translated 'not-found)) + (t (push (list (buffer-substring-no-properties (+ (point) 4) - (line-end-position)) - translated) result)) + (line-end-position)) + translated) result))) (forward-line)) (funcall update-function result))) @@ -615,6 +686,43 @@ stream. Standard error output is discarded." (vc-exec-after `(vc-bzr-after-dir-status (quote ,update-function)))) +(defun vc-bzr-dir-status-files (dir files default-state update-function) + "Return a list of conses (file . state) for DIR." + (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files) + (vc-exec-after + `(vc-bzr-after-dir-status (quote ,update-function)))) + +(defun vc-bzr-dir-extra-headers (dir) + (let* + ((str (with-temp-buffer + (vc-bzr-command "info" t 0 dir) + (buffer-string))) + (light-checkout + (when (string-match ".+light checkout root: \\(.+\\)$" str) + (match-string 1 str))) + (light-checkout-branch + (when light-checkout + (when (string-match ".+checkout of branch: \\(.+\\)$" str) + (match-string 1 str))))) + (concat + (propertize "Parent branch : " 'face 'font-lock-type-face) + (propertize + (if (string-match "parent branch: \\(.+\\)$" str) + (match-string 1 str) + "None") + 'face 'font-lock-variable-name-face) + "\n" + (when light-checkout + (concat + (propertize "Light checkout root: " 'face 'font-lock-type-face) + (propertize light-checkout 'face 'font-lock-variable-name-face) + "\n")) + (when light-checkout-branch + (concat + (propertize "Checkout of branch : " 'face 'font-lock-type-face) + (propertize light-checkout-branch 'face 'font-lock-variable-name-face) + "\n"))))) + ;;; Revision completion (defun vc-bzr-revision-completion-table (files) @@ -625,6 +733,8 @@ stream. Standard error output is discarded." ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):" string) (completion-table-with-context (substring string 0 (match-end 0)) + ;; FIXME: only allow directories. + ;; FIXME: don't allow envvars. 'read-file-name-internal (substring string (match-end 0)) ;; Dropping `pred'. Maybe we should @@ -655,7 +765,14 @@ stream. Standard error output is discarded." ((string-match "\\`\\(revid\\):" string) ;; FIXME: How can I get a list of revision ids? ) + ((eq (car-safe action) 'boundaries) + (list* 'boundaries + (string-match "[^:]*\\'" string) + (string-match ":" (cdr action)))) (t + ;; Could use completion-table-with-terminator, except that it + ;; currently doesn't work right w.r.t pcm and doesn't give + ;; the *Completions* output we want. (complete-with-action action '("revno:" "revid:" "last:" "before:" "tag:" "date:" "ancestor:" "branch:" "submit:")