diff options
| author | Miles Bader | 2007-03-29 00:20:31 +0000 |
|---|---|---|
| committer | Miles Bader | 2007-03-29 00:20:31 +0000 |
| commit | c534074c9c3532e39afa8bce3302e9cbd52ffcb6 (patch) | |
| tree | 7dc5b51fbe0161b6ae9f553a51ccdc46e37d2c3b | |
| parent | ddd79e229bfec6adc57575304fe9e1af5d258fbc (diff) | |
| download | emacs-c534074c9c3532e39afa8bce3302e9cbd52ffcb6.tar.gz emacs-c534074c9c3532e39afa8bce3302e9cbd52ffcb6.zip | |
vc-bzr.el: New file.
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-187
Creator: Stefan Monnier <monnier@iro.umontreal.ca>
| -rw-r--r-- | lisp/ChangeLog.unicode | 4 | ||||
| -rw-r--r-- | lisp/vc-bzr.el | 565 |
2 files changed, 569 insertions, 0 deletions
diff --git a/lisp/ChangeLog.unicode b/lisp/ChangeLog.unicode index 9239329370c..792aabf03b8 100644 --- a/lisp/ChangeLog.unicode +++ b/lisp/ChangeLog.unicode | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2007-03-28 Riccardo Murri <riccardo.murri@gmail.com> | ||
| 2 | |||
| 3 | * vc-bzr.el: New file. | ||
| 4 | |||
| 1 | 2007-03-23 Kenichi Handa <handa@m17n.org> | 5 | 2007-03-23 Kenichi Handa <handa@m17n.org> |
| 2 | 6 | ||
| 3 | * international/characters.el: Add more cases/syntaxes from Latin | 7 | * international/characters.el: Add more cases/syntaxes from Latin |
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el new file mode 100644 index 00000000000..0ff1668cf80 --- /dev/null +++ b/lisp/vc-bzr.el | |||
| @@ -0,0 +1,565 @@ | |||
| 1 | ;;; vc-bzr.el --- VC backend for the bzr revision control system | ||
| 2 | |||
| 3 | ;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el, | ||
| 6 | ;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el | ||
| 7 | ;; I could not get in touch with Dave Love by email, so | ||
| 8 | ;; I am releasing my changes separately. -- Riccardo | ||
| 9 | |||
| 10 | ;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com> | ||
| 11 | ;; Keywords: tools | ||
| 12 | ;; Created: Sept 2006 | ||
| 13 | ;; Version: 2007-01-17 | ||
| 14 | ;; URL: http://launchpad.net/vc-bzr | ||
| 15 | |||
| 16 | ;; This file is free software; you can redistribute it and/or modify | ||
| 17 | ;; it under the terms of the GNU General Public License as published by | ||
| 18 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 19 | ;; any later version. | ||
| 20 | |||
| 21 | ;; This file is distributed in the hope that it will be useful, | ||
| 22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 24 | ;; GNU General Public License for more details. | ||
| 25 | |||
| 26 | ;; You should have received a copy of the GNU General Public License | ||
| 27 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 28 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 29 | ;; Boston, MA 02110-1301, USA. | ||
| 30 | |||
| 31 | |||
| 32 | ;;; Commentary: | ||
| 33 | |||
| 34 | ;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el, | ||
| 35 | ;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el | ||
| 36 | |||
| 37 | ;; See <URL:http://bazaar-vcs.org/> concerning bzr. | ||
| 38 | |||
| 39 | ;; Load this library to register bzr support in VC. The support is | ||
| 40 | ;; preliminary and incomplete, adapted from my darcs version. Lightly | ||
| 41 | ;; exercised with bzr 0.8 and Emacs 21, and bzr 0.11 on Emacs 22. See | ||
| 42 | ;; various Fixmes below. | ||
| 43 | |||
| 44 | ;; This should be suitable for direct inclusion in Emacs if someone | ||
| 45 | ;; can persuade rms. | ||
| 46 | |||
| 47 | |||
| 48 | ;;; Code: | ||
| 49 | |||
| 50 | (eval-when-compile | ||
| 51 | (require 'vc)) ; for vc-exec-after | ||
| 52 | |||
| 53 | (defgroup vc-bzr nil | ||
| 54 | "VC bzr backend." | ||
| 55 | ;; :version "22" | ||
| 56 | :group 'vc) | ||
| 57 | |||
| 58 | (defcustom vc-bzr-program "bzr" | ||
| 59 | "*Name of the bzr command (excluding any arguments)." | ||
| 60 | :group 'vc-bzr | ||
| 61 | :type 'string) | ||
| 62 | |||
| 63 | ;; Fixme: there's probably no call for this. | ||
| 64 | (defcustom vc-bzr-program-args nil | ||
| 65 | "*List of global arguments to pass to `vc-bzr-program'." | ||
| 66 | :group 'vc-bzr | ||
| 67 | :type '(repeat string)) | ||
| 68 | |||
| 69 | (defcustom vc-bzr-diff-switches nil | ||
| 70 | "*String/list of strings specifying extra switches for bzr diff under VC." | ||
| 71 | :type '(choice (const :tag "None" nil) | ||
| 72 | (string :tag "Argument String") | ||
| 73 | (repeat :tag "Argument List" :value ("") string)) | ||
| 74 | :group 'vc-bzr) | ||
| 75 | |||
| 76 | (defvar vc-bzr-version nil | ||
| 77 | "Internal use.") | ||
| 78 | |||
| 79 | ;; Could be used for compatibility checks if bzr changes. | ||
| 80 | (defun vc-bzr-version () | ||
| 81 | "Return a three-numeric element list with components of the bzr version. | ||
| 82 | This is of the form (X Y Z) for revision X.Y.Z. The elements are zero | ||
| 83 | if running `vc-bzr-program' doesn't produce the expected output." | ||
| 84 | (if vc-bzr-version | ||
| 85 | vc-bzr-version | ||
| 86 | (let ((s (shell-command-to-string | ||
| 87 | (concat (shell-quote-argument vc-bzr-program) " --version")))) | ||
| 88 | (if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s) | ||
| 89 | (setq vc-bzr-version (list (string-to-number (match-string 1 s)) | ||
| 90 | (string-to-number (match-string 2 s)) | ||
| 91 | (string-to-number (match-string 3 s)))) | ||
| 92 | '(0 0 0))))) | ||
| 93 | |||
| 94 | (defun vc-bzr-at-least-version (vers) | ||
| 95 | "Return t if the bzr command reports being a least version VERS. | ||
| 96 | First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'." | ||
| 97 | (version-list-<= vers (vc-bzr-version))) | ||
| 98 | |||
| 99 | ;; XXX: vc-do-command is tailored for RCS and assumes that command-line | ||
| 100 | ;; options precede the file name (ci -something file); with bzr, we need | ||
| 101 | ; to pass options *after* the subcommand, e.g. bzr ls --versioned. | ||
| 102 | (defun vc-bzr-do-command* (buffer okstatus command &rest args) | ||
| 103 | "Execute bzr COMMAND, notifying user and checking for errors. | ||
| 104 | This is a wrapper around `vc-do-command', which see for detailed | ||
| 105 | explanation of arguments BUFFER, OKSTATUS and COMMAND. | ||
| 106 | |||
| 107 | If the optional list of ARGS is present, its elements are | ||
| 108 | appended to the command line, in the order given. | ||
| 109 | |||
| 110 | Unlike `vc-do-command', this has no way of telling which elements | ||
| 111 | in ARGS are file names and which are command-line options, so be | ||
| 112 | sure to pass absolute file names if needed. On the other hand, | ||
| 113 | you can mix options and file names in any order." | ||
| 114 | (apply 'vc-do-command buffer okstatus command nil args)) | ||
| 115 | |||
| 116 | (cond | ||
| 117 | ((vc-bzr-at-least-version '(0 9)) | ||
| 118 | ;; since v0.9, bzr supports removing the progress indicators | ||
| 119 | ;; by setting environment variable BZR_PROGRESS_BAR to "none". | ||
| 120 | (defun vc-bzr-command (bzr-command buffer okstatus file &rest args) | ||
| 121 | "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. | ||
| 122 | Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." | ||
| 123 | (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) | ||
| 124 | (apply 'vc-do-command buffer okstatus vc-bzr-program | ||
| 125 | file bzr-command (append vc-bzr-program-args args)))) | ||
| 126 | |||
| 127 | (defun vc-bzr-command* (bzr-command buffer okstatus file &rest args) | ||
| 128 | "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND. | ||
| 129 | Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment. | ||
| 130 | First argument BZR-COMMAND is passed as the first optional argument to | ||
| 131 | `vc-bzr-do-command*'." | ||
| 132 | (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) | ||
| 133 | (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program | ||
| 134 | bzr-command (append vc-bzr-program-args args))))) | ||
| 135 | |||
| 136 | (t | ||
| 137 | ;; for older versions, we fall back to washing the log buffer | ||
| 138 | ;; when all output has been gathered. | ||
| 139 | (defun vc-bzr-command (command buffer okstatus file &rest args) | ||
| 140 | "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND." | ||
| 141 | ;; Note: The ^Ms from the progress-indicator stuff that bzr prints | ||
| 142 | ;; on stderr cause auto-detection of a mac coding system on the | ||
| 143 | ;; stream for async output. bzr ought to be fixed to be able to | ||
| 144 | ;; suppress this. See also `vc-bzr-post-command-function'. (We | ||
| 145 | ;; can't sink the stderr output in `vc-do-command'.) | ||
| 146 | (apply 'vc-do-command buffer okstatus vc-bzr-program | ||
| 147 | file command (append vc-bzr-program-args args))) | ||
| 148 | |||
| 149 | (defun vc-bzr-command* (command buffer okstatus &rest args) | ||
| 150 | "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND." | ||
| 151 | (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program | ||
| 152 | command file (append vc-bzr-program-args args))) | ||
| 153 | |||
| 154 | (defun vc-bzr-post-command-function (command file flags) | ||
| 155 | "`vc-post-command-functions' function to remove progress messages." | ||
| 156 | ;; Note that using this requires that the vc command is run | ||
| 157 | ;; synchronously. Otherwise, the ^Ms in the leading progress | ||
| 158 | ;; message on stdout cause the stream to be interpreted as having | ||
| 159 | ;; DOS line endings, losing the ^Ms, so the search fails. I don't | ||
| 160 | ;; know how this works under Windows. | ||
| 161 | (when (equal command vc-bzr-program) | ||
| 162 | (save-excursion | ||
| 163 | (goto-char (point-min)) | ||
| 164 | (if (looking-at "^\\(\r.*\r\\)[^\r]+$") | ||
| 165 | (replace-match "" nil nil nil 1))) | ||
| 166 | (save-excursion | ||
| 167 | (goto-char (point-min)) | ||
| 168 | ;; This is inserted by bzr 0.11 `log', at least | ||
| 169 | (while (looking-at "read knit.*\n") | ||
| 170 | (replace-match ""))))) | ||
| 171 | |||
| 172 | (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) | ||
| 173 | |||
| 174 | ;; Fixme: If we're only interested in status messages, we only need | ||
| 175 | ;; to set LC_MESSAGES, and we might need finer control of this. This | ||
| 176 | ;; is moot anyhow, since bzr doesn't appear to be localized at all | ||
| 177 | ;; (yet?). | ||
| 178 | (eval-when-compile | ||
| 179 | (defmacro vc-bzr-with-c-locale (&rest body) | ||
| 180 | "Run BODY with LC_ALL=C in the process environment. | ||
| 181 | This ensures that messages to be matched come out as expected." | ||
| 182 | `(let ((process-environment (cons "LC_ALL=C" process-environment))) | ||
| 183 | ,@body))) | ||
| 184 | (put 'vc-bzr-with-c-locale 'edebug-form-spec t) | ||
| 185 | (put 'vc-bzr-with-c-locale 'lisp-indent-function 0) | ||
| 186 | |||
| 187 | (defun vc-bzr-bzr-dir (file) | ||
| 188 | "Return the .bzr directory in the hierarchy above FILE. | ||
| 189 | Return nil if there isn't one." | ||
| 190 | (setq file (expand-file-name file)) | ||
| 191 | (let ((dir (if (file-directory-p file) | ||
| 192 | file | ||
| 193 | (file-name-directory file))) | ||
| 194 | bzr) | ||
| 195 | (catch 'found | ||
| 196 | (while t | ||
| 197 | (setq bzr (expand-file-name ".bzr" dir)) ; fixme: "_bzr" on Doze?? | ||
| 198 | (if (file-directory-p bzr) | ||
| 199 | (throw 'found (file-name-as-directory bzr))) | ||
| 200 | (if (equal "" (file-name-nondirectory (directory-file-name dir))) | ||
| 201 | (throw 'found nil) | ||
| 202 | (setq dir (file-name-directory (directory-file-name dir)))))))) | ||
| 203 | |||
| 204 | (defun vc-bzr-registered (file) | ||
| 205 | "Return non-nil if FILE is registered with bzr." | ||
| 206 | (if (vc-bzr-bzr-dir file) ; short cut | ||
| 207 | (vc-bzr-state file))) ; expensive | ||
| 208 | |||
| 209 | (defun vc-bzr-state (file) | ||
| 210 | (let (ret state conflicts pending-merges) | ||
| 211 | (with-temp-buffer | ||
| 212 | (cd (file-name-directory file)) | ||
| 213 | (setq ret (vc-bzr-with-c-locale (vc-bzr-command "status" t 255 file))) | ||
| 214 | (goto-char 1) | ||
| 215 | (save-excursion | ||
| 216 | (when (re-search-forward "^conflicts:" nil t) | ||
| 217 | (message "Warning -- conflicts in bzr branch"))) | ||
| 218 | (save-excursion | ||
| 219 | (when (re-search-forward "^pending merges:" nil t) | ||
| 220 | (message "Warning -- pending merges in bzr branch"))) | ||
| 221 | (setq state | ||
| 222 | (cond ((not (equal ret 0)) nil) | ||
| 223 | ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) | ||
| 224 | ;; Fixme: Also get this in a non-registered sub-directory. | ||
| 225 | ((looking-at "^$") 'up-to-date) | ||
| 226 | ;; if we're seeing this as first line of text, | ||
| 227 | ;; then the status is up-to-date, | ||
| 228 | ;; but bzr output only gives the warning to users. | ||
| 229 | ((looking-at "conflicts\\|pending") 'up-to-date) | ||
| 230 | ((looking-at "unknown\\|ignored") nil) | ||
| 231 | (t (error "Unrecognized output from `bzr status'")))) | ||
| 232 | (when (or conflicts pending-merges) | ||
| 233 | (message | ||
| 234 | (concat "Warning -- " | ||
| 235 | (if conflicts "conflicts ") | ||
| 236 | (if (and conflicts pending-merges) "and ") | ||
| 237 | (if pending-merges "pending merges ") | ||
| 238 | "in bzr branch"))) | ||
| 239 | (when state | ||
| 240 | (vc-file-setprop file 'vc-workfile-version | ||
| 241 | (vc-bzr-workfile-version file)) | ||
| 242 | (vc-file-setprop file 'vc-state state)) | ||
| 243 | state))) | ||
| 244 | |||
| 245 | (defun vc-bzr-workfile-unchanged-p (file) | ||
| 246 | (eq 'up-to-date (vc-bzr-state file))) | ||
| 247 | |||
| 248 | (defun vc-bzr-workfile-version (file) | ||
| 249 | (with-temp-buffer | ||
| 250 | (vc-bzr-command "revno" t 0 file) | ||
| 251 | (goto-char 1) | ||
| 252 | (buffer-substring 1 (line-end-position)))) | ||
| 253 | |||
| 254 | (defun vc-bzr-checkout-model (file) | ||
| 255 | 'implicit) | ||
| 256 | |||
| 257 | (defun vc-bzr-register (file &optional rev comment) | ||
| 258 | "Register FILE under bzr. | ||
| 259 | Signal an error unless REV is nil. | ||
| 260 | COMMENT is ignored." | ||
| 261 | (if rev (error "Can't register explicit version with bzr")) | ||
| 262 | (vc-bzr-command "add" nil 0 file)) | ||
| 263 | |||
| 264 | ;; Could run `bzr status' in the directory and see if it succeeds, but | ||
| 265 | ;; that's relatively expensive. | ||
| 266 | (defun vc-bzr-responsible-p (file) | ||
| 267 | "Return non-nil if FILE is (potentially) controlled by bzr. | ||
| 268 | The criterion is that there is a `.bzr' directory in the same | ||
| 269 | or a superior directory." | ||
| 270 | (vc-bzr-bzr-dir file)) | ||
| 271 | |||
| 272 | (defun vc-bzr-could-register (file) | ||
| 273 | "Return non-nil if FILE could be registered under bzr." | ||
| 274 | (and (vc-bzr-responsible-p file) ; shortcut | ||
| 275 | (condition-case () | ||
| 276 | (with-temp-buffer | ||
| 277 | (vc-bzr-command "add" t 0 file "--dry-run") | ||
| 278 | ;; The command succeeds with no output if file is | ||
| 279 | ;; registered (in bzr 0.8). | ||
| 280 | (goto-char 1) | ||
| 281 | (looking-at "added ")) | ||
| 282 | (error)))) | ||
| 283 | |||
| 284 | (defun vc-bzr-unregister (file) | ||
| 285 | "Unregister FILE from bzr." | ||
| 286 | (vc-bzr-command "remove" nil 0 file)) | ||
| 287 | |||
| 288 | (defun vc-bzr-checkin (file rev comment) | ||
| 289 | "Check FILE in to bzr with log message COMMENT. | ||
| 290 | REV non-nil gets an error." | ||
| 291 | (if rev (error "Can't check in a specific version with bzr")) | ||
| 292 | (vc-bzr-command "commit" nil 0 file "-m" comment)) | ||
| 293 | |||
| 294 | (defun vc-bzr-checkout (file &optional editable rev destfile) | ||
| 295 | "Checkout revision REV of FILE from bzr to DESTFILE. | ||
| 296 | EDITABLE is ignored." | ||
| 297 | (unless destfile | ||
| 298 | (setq destfile (vc-version-backup-file-name file rev))) | ||
| 299 | (let ((coding-system-for-read 'binary) | ||
| 300 | (coding-system-for-write 'binary)) | ||
| 301 | (with-temp-file destfile | ||
| 302 | (if rev | ||
| 303 | (vc-bzr-command "cat" t 0 file "-r" rev) | ||
| 304 | (vc-bzr-command "cat" t 0 file))))) | ||
| 305 | |||
| 306 | (defun vc-bzr-revert (file &optional contents-done) | ||
| 307 | (unless contents-done | ||
| 308 | (with-temp-buffer (vc-bzr-command "revert" t 'async file)))) | ||
| 309 | |||
| 310 | (eval-when-compile | ||
| 311 | (defvar log-view-message-re) | ||
| 312 | (defvar log-view-file-re) | ||
| 313 | (defvar log-view-font-lock-keywords) | ||
| 314 | (defvar log-view-current-tag-function)) | ||
| 315 | |||
| 316 | ;; Grim hack to account for lack of an extension mechanism for | ||
| 317 | ;; log-view. Should be fixed in VC... | ||
| 318 | (defun vc-bzr-view-log-function () | ||
| 319 | "To be added to `log-view-mode-hook' to set variables for bzr output. | ||
| 320 | Removes itself after running." | ||
| 321 | (remove-hook 'log-view-mode-hook 'vc-bzr-view-log-function) | ||
| 322 | (require 'add-log) | ||
| 323 | ;; Don't have file markers, so use impossible regexp. | ||
| 324 | (set (make-local-variable 'log-view-file-re) "\\'\\`") | ||
| 325 | (set (make-local-variable 'log-view-message-re) "^ *-+\n *\\(revno: [0-9]+\\|merged: .+\\)") | ||
| 326 | (set (make-local-variable 'log-view-font-lock-keywords) | ||
| 327 | `(("^ *committer: \ | ||
| 328 | \\([^<(]+?\\)[ ]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]" | ||
| 329 | nil nil | ||
| 330 | (1 'change-log-name-face nil t) | ||
| 331 | (2 'change-log-email-face nil t) | ||
| 332 | (3 'change-log-email-face nil t)) | ||
| 333 | ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)) | ||
| 334 | (,log-view-message-re . 'log-view-message-face) | ||
| 335 | ;; ("^ \\(.*\\)$" (1 'log-view-message-face)) | ||
| 336 | ))) | ||
| 337 | |||
| 338 | (defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22 | ||
| 339 | "Get bzr change log for FILE into specified BUFFER." | ||
| 340 | ;; Fixme: VC needs a hook to sort out the mode for the buffer, or at | ||
| 341 | ;; least set the regexps right. | ||
| 342 | ;; Fixme: This might need the locale fixing up if things like `revno' | ||
| 343 | ;; got localized, but certainly it shouldn't use LC_ALL=C. | ||
| 344 | ;; NB. Can't be async -- see `vc-bzr-post-command-function'. | ||
| 345 | (vc-bzr-command "log" buffer 0 file) | ||
| 346 | (add-hook 'log-view-mode-hook 'vc-bzr-view-log-function)) | ||
| 347 | |||
| 348 | (defun vc-bzr-show-log-entry (version) | ||
| 349 | "Find entry for patch name VERSION in bzr change log buffer." | ||
| 350 | (goto-char (point-min)) | ||
| 351 | (let (case-fold-search) | ||
| 352 | (if (re-search-forward (concat "^-+\nrevno: " version "$") nil t) | ||
| 353 | (beginning-of-line 0) | ||
| 354 | (goto-char (point-min))))) | ||
| 355 | |||
| 356 | ;; Fixem: vc-bzr-wash-log | ||
| 357 | |||
| 358 | (autoload 'vc-diff-switches-list "vc" nil nil t) | ||
| 359 | |||
| 360 | (defun vc-bzr-diff (file &optional rev1 rev2 buffer) | ||
| 361 | "VC bzr backend for diff." | ||
| 362 | (let ((working (vc-workfile-version file))) | ||
| 363 | (if (and (equal rev1 working) (not rev2)) | ||
| 364 | (setq rev1 nil)) | ||
| 365 | (if (and (not rev1) rev2) | ||
| 366 | (setq rev1 working)) | ||
| 367 | ;; NB. Can't be async -- see `vc-bzr-post-command-function'. | ||
| 368 | ;; bzr diff produces condition code 1 for some reason. | ||
| 369 | (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file | ||
| 370 | "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) | ||
| 371 | " ") | ||
| 372 | (when rev1 | ||
| 373 | (if rev2 | ||
| 374 | (list "-r" (format "%s..%s" rev1 rev2)) | ||
| 375 | (list "-r" rev1)))))) | ||
| 376 | |||
| 377 | (defalias 'vc-bzr-diff-tree 'vc-bzr-diff) | ||
| 378 | |||
| 379 | ;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info | ||
| 380 | |||
| 381 | ;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with | ||
| 382 | ;; straight integer versions. | ||
| 383 | |||
| 384 | (defun vc-bzr-delete-file (file) | ||
| 385 | "Delete FILE and delete it in the bzr repository." | ||
| 386 | (condition-case () | ||
| 387 | (delete-file file) | ||
| 388 | (file-error nil)) | ||
| 389 | (vc-bzr-command "remove" nil 0 file)) | ||
| 390 | |||
| 391 | (defun vc-bzr-rename-file (old new) | ||
| 392 | "Rename file from OLD to NEW using `bzr mv'." | ||
| 393 | (vc-bzr-command "mv" nil 0 new old)) | ||
| 394 | |||
| 395 | (defvar vc-bzr-annotation-table nil | ||
| 396 | "Internal use.") | ||
| 397 | (make-variable-buffer-local 'vc-bzr-annotation-table) | ||
| 398 | |||
| 399 | (defun vc-bzr-annotate-command (file buffer &optional version) | ||
| 400 | "Prepare BUFFER for `vc-annotate' on FILE. | ||
| 401 | Each line is tagged with the revision number, which has a `help-echo' | ||
| 402 | property containing author and date information." | ||
| 403 | (apply #'vc-bzr-command "annotate" buffer 0 file "-l" "--all" | ||
| 404 | (if version (list "-r" version))) | ||
| 405 | (with-current-buffer buffer | ||
| 406 | ;; Store the tags for the annotated source lines in a hash table | ||
| 407 | ;; to allow saving space by sharing the text properties. | ||
| 408 | (setq vc-bzr-annotation-table (make-hash-table :test 'equal)) | ||
| 409 | (goto-char (point-min)) | ||
| 410 | (while (re-search-forward "^\\( *[0-9]+\\) \\(.+\\) +\\([0-9]\\{8\\}\\) |" | ||
| 411 | nil t) | ||
| 412 | (let* ((rev (match-string 1)) | ||
| 413 | (author (match-string 2)) | ||
| 414 | (date (match-string 3)) | ||
| 415 | (key (match-string 0)) | ||
| 416 | (tag (gethash key vc-bzr-annotation-table))) | ||
| 417 | (unless tag | ||
| 418 | (save-match-data | ||
| 419 | (string-match " +\\'" author) | ||
| 420 | (setq author (substring author 0 (match-beginning 0)))) | ||
| 421 | (setq tag (propertize rev 'help-echo (concat "Author: " author | ||
| 422 | ", date: " date) | ||
| 423 | 'mouse-face 'highlight)) | ||
| 424 | (puthash key tag vc-bzr-annotation-table)) | ||
| 425 | (replace-match "") | ||
| 426 | (insert tag " |"))))) | ||
| 427 | |||
| 428 | ;; Definition from Emacs 22 | ||
| 429 | (unless (fboundp 'vc-annotate-convert-time) | ||
| 430 | (defun vc-annotate-convert-time (time) | ||
| 431 | "Convert a time value to a floating-point number of days. | ||
| 432 | The argument TIME is a list as returned by `current-time' or | ||
| 433 | `encode-time', only the first two elements of that list are considered." | ||
| 434 | (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) | ||
| 435 | |||
| 436 | (defun vc-bzr-annotate-time () | ||
| 437 | (when (re-search-forward "^ *[0-9]+ |" nil t) | ||
| 438 | (let ((prop (get-text-property (line-beginning-position) 'help-echo))) | ||
| 439 | (string-match "[0-9]+\\'" prop) | ||
| 440 | (vc-annotate-convert-time | ||
| 441 | (encode-time 0 0 0 | ||
| 442 | (string-to-number (substring (match-string 0 prop) 6 8)) | ||
| 443 | (string-to-number (substring (match-string 0 prop) 4 6)) | ||
| 444 | (string-to-number (substring (match-string 0 prop) 0 4)) | ||
| 445 | ))))) | ||
| 446 | |||
| 447 | (defun vc-bzr-annotate-extract-revision-at-line () | ||
| 448 | "Return revision for current line of annoation buffer, or nil. | ||
| 449 | Return nil if current line isn't annotated." | ||
| 450 | (save-excursion | ||
| 451 | (beginning-of-line) | ||
| 452 | (if (looking-at " *\\([0-9]+\\) | ") | ||
| 453 | (match-string-no-properties 1)))) | ||
| 454 | |||
| 455 | ;; Not needed for Emacs 22 | ||
| 456 | (defun vc-bzr-annotate-difference (point) | ||
| 457 | (let ((next-time (vc-bzr-annotate-time))) | ||
| 458 | (if next-time | ||
| 459 | (- (vc-annotate-convert-time (current-time)) next-time)))) | ||
| 460 | |||
| 461 | ;; FIXME: `bzr root' will return the real path to the repository root, | ||
| 462 | ;; that is, it can differ from the buffer's current directory name | ||
| 463 | ;; if there are any symbolic links. | ||
| 464 | (defun vc-bzr-root (dir) | ||
| 465 | "Return the root directory of the bzr repository containing DIR." | ||
| 466 | (substring | ||
| 467 | (shell-command-to-string (concat vc-bzr-program " root " dir)) 0 -1)) | ||
| 468 | |||
| 469 | ;; TODO: it would be nice to mark the conflicted files in VC Dired, | ||
| 470 | ;; and implement a command to run ediff and `bzr resolve' once the | ||
| 471 | ;; changes have been merged. | ||
| 472 | (defun vc-bzr-dir-state (dir &optional localp) | ||
| 473 | "Find the VC state of all files in DIR. | ||
| 474 | Optional argument LOCALP is always ignored." | ||
| 475 | (let (at-start bzr-root-directory current-bzr-state current-vc-state) | ||
| 476 | ;; check that DIR is a bzr repository | ||
| 477 | (set 'bzr-root-directory (vc-bzr-root dir)) | ||
| 478 | (unless (string-match "^/" bzr-root-directory) | ||
| 479 | (error "Cannot find bzr repository for directory `%s'" dir)) | ||
| 480 | ;; `bzr ls --versioned' lists all versioned files; | ||
| 481 | ;; assume they are up-to-date, unless we are given | ||
| 482 | ;; evidence of the contrary. | ||
| 483 | (set 'at-start t) | ||
| 484 | (with-temp-buffer | ||
| 485 | (vc-bzr-command* "ls" t 0 "--versioned" "--non-recursive") | ||
| 486 | (goto-char (point-min)) | ||
| 487 | (while (or at-start | ||
| 488 | (eq 0 (forward-line))) | ||
| 489 | (set 'at-start nil) | ||
| 490 | (let ((file (expand-file-name | ||
| 491 | (buffer-substring-no-properties | ||
| 492 | (line-beginning-position) (line-end-position)) | ||
| 493 | bzr-root-directory))) | ||
| 494 | (vc-file-setprop file 'vc-state 'up-to-date) | ||
| 495 | ;; XXX: is this correct? what happens if one | ||
| 496 | ;; mixes different SCMs in the same dir? | ||
| 497 | (vc-file-setprop file 'vc-backend 'BZR)))) | ||
| 498 | ;; `bzr status' reports on added/modified/renamed and unknown/ignored files | ||
| 499 | (set 'at-start t) | ||
| 500 | (with-temp-buffer | ||
| 501 | (vc-bzr-with-c-locale (vc-bzr-command "status" t 0 nil)) | ||
| 502 | (goto-char (point-min)) | ||
| 503 | (while (or at-start | ||
| 504 | (eq 0 (forward-line))) | ||
| 505 | (set 'at-start nil) | ||
| 506 | (cond | ||
| 507 | ((looking-at "^added") | ||
| 508 | (set 'current-vc-state 'edited) | ||
| 509 | (set 'current-bzr-state 'added)) | ||
| 510 | ((looking-at "^modified") | ||
| 511 | (set 'current-vc-state 'edited) | ||
| 512 | (set 'current-bzr-state 'modified)) | ||
| 513 | ((looking-at "^renamed") | ||
| 514 | (set 'current-vc-state 'edited) | ||
| 515 | (set 'current-bzr-state 'renamed)) | ||
| 516 | ((looking-at "^\\(unknown\\|ignored\\)") | ||
| 517 | (set 'current-vc-state nil) | ||
| 518 | (set 'current-bzr-state 'not-versioned)) | ||
| 519 | ((looking-at " ") | ||
| 520 | ;; file names are indented by two spaces | ||
| 521 | (when current-vc-state | ||
| 522 | (let ((file (expand-file-name | ||
| 523 | (buffer-substring-no-properties | ||
| 524 | (match-end 0) (line-end-position)) | ||
| 525 | bzr-root-directory))) | ||
| 526 | (vc-file-setprop file 'vc-state current-vc-state) | ||
| 527 | (vc-file-setprop file 'vc-bzr-state current-bzr-state) | ||
| 528 | (when (eq 'added current-bzr-state) | ||
| 529 | (vc-file-setprop file 'vc-workfile-version "0")))) | ||
| 530 | (when (eq 'not-versioned current-bzr-state) | ||
| 531 | (let ((file (expand-file-name | ||
| 532 | (buffer-substring-no-properties | ||
| 533 | (match-end 0) (line-end-position)) | ||
| 534 | bzr-root-directory))) | ||
| 535 | (vc-file-setprop file 'vc-backend 'none) | ||
| 536 | (vc-file-setprop file 'vc-state nil)))) | ||
| 537 | (t | ||
| 538 | ;; skip this part of `bzr status' output | ||
| 539 | (set 'current-vc-state nil) | ||
| 540 | (set 'current-bzr-state nil))))))) | ||
| 541 | |||
| 542 | (defun vc-bzr-dired-state-info (file) | ||
| 543 | "Bzr-specific version of `vc-dired-state-info'." | ||
| 544 | (if (eq 'edited (vc-state file)) | ||
| 545 | (let ((bzr-state (vc-file-getprop file 'vc-bzr-state))) | ||
| 546 | (if bzr-state | ||
| 547 | (concat "(" (symbol-name bzr-state) ")") | ||
| 548 | ;; else fall back to default vc representation | ||
| 549 | (vc-default-dired-state-info 'BZR file))))) | ||
| 550 | |||
| 551 | ;; In case of just `(load "vc-bzr")', but that's probably the wrong | ||
| 552 | ;; way to do it. | ||
| 553 | (add-to-list 'vc-handled-backends 'BZR) | ||
| 554 | |||
| 555 | (eval-after-load "vc" | ||
| 556 | '(add-to-list 'vc-directory-exclusion-list ".bzr" t)) | ||
| 557 | |||
| 558 | (defconst vc-bzr-unload-hook | ||
| 559 | (lambda () | ||
| 560 | (setq vc-handled-backends (delq 'BZR vc-handled-backends)) | ||
| 561 | (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) | ||
| 562 | |||
| 563 | (provide 'vc-bzr) | ||
| 564 | ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06 | ||
| 565 | ;;; vc-bzr.el ends here | ||