LCOV - code coverage report
Current view: top level - lisp/vc - vc-bzr.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 11 598 1.8 %
Date: 2017-08-30 10:12:24 Functions: 5 71 7.0 %

          Line data    Source code
       1             : ;;; vc-bzr.el --- VC backend for the bzr revision control system  -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Dave Love <fx@gnu.org>
       6             : ;;         Riccardo Murri <riccardo.murri@gmail.com>
       7             : ;; Maintainer: emacs-devel@gnu.org
       8             : ;; Keywords: vc tools
       9             : ;; Created: Sept 2006
      10             : ;; Package: vc
      11             : 
      12             : ;; This file is part of GNU Emacs.
      13             : 
      14             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      15             : ;; it under the terms of the GNU General Public License as published by
      16             : ;; the Free Software Foundation, either version 3 of the License, or
      17             : ;; (at your option) any later version.
      18             : 
      19             : ;; GNU Emacs is distributed in the hope that it will be useful,
      20             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      21             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      22             : ;; GNU General Public License for more details.
      23             : 
      24             : ;; You should have received a copy of the GNU General Public License
      25             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      26             : 
      27             : ;;; Commentary:
      28             : 
      29             : ;; See <URL:http://bazaar.canonical.com/> concerning bzr.
      30             : 
      31             : ;; This library provides bzr support in VC.
      32             : 
      33             : ;; Known bugs
      34             : ;; ==========
      35             : 
      36             : ;; When editing a symlink and *both* the symlink and its target
      37             : ;; are bzr-versioned, `vc-bzr' presently runs `bzr status' on the
      38             : ;; symlink, thereby not detecting whether the actual contents
      39             : ;; (that is, the target contents) are changed.
      40             : 
      41             : ;;; Properties of the backend
      42             : 
      43             : (defun vc-bzr-revision-granularity () 'repository)
      44             : (defun vc-bzr-checkout-model (_files) 'implicit)
      45             : 
      46             : ;;; Code:
      47             : 
      48             : (eval-when-compile
      49             :   (require 'cl-lib)
      50             :   (require 'vc-dispatcher)
      51             :   (require 'vc-dir))                    ; vc-dir-at-event
      52             : 
      53             : (declare-function vc-deduce-fileset "vc"
      54             :                   (&optional observer allow-unregistered
      55             :                              state-model-only-files))
      56             : 
      57             : 
      58             : ;; Clear up the cache to force vc-call to check again and discover
      59             : ;; new functions when we reload this file.
      60             : (put 'Bzr 'vc-functions nil)
      61             : 
      62             : (defgroup vc-bzr nil
      63             :   "VC Bazaar (bzr) backend."
      64             :   :version "22.2"
      65             :   :group 'vc)
      66             : 
      67             : (defcustom vc-bzr-program "bzr"
      68             :   "Name of the bzr command (excluding any arguments)."
      69             :   :group 'vc-bzr
      70             :   :type 'string)
      71             : 
      72             : (defcustom vc-bzr-diff-switches nil
      73             :   "String or list of strings specifying switches for bzr diff under VC.
      74             : If nil, use the value of `vc-diff-switches'.  If t, use no switches."
      75             :   :type '(choice (const :tag "Unspecified" nil)
      76             :                  (const :tag "None" t)
      77             :                  (string :tag "Argument String")
      78             :                  (repeat :tag "Argument List" :value ("") string))
      79             :   :group 'vc-bzr)
      80             : 
      81             : (defcustom vc-bzr-annotate-switches nil
      82             :   "String or list of strings specifying switches for bzr annotate under VC.
      83             : If nil, use the value of `vc-annotate-switches'.  If t, use no switches."
      84             :   :type '(choice (const :tag "Unspecified" nil)
      85             :                  (const :tag "None" t)
      86             :                  (string :tag "Argument String")
      87             :                  (repeat :tag "Argument List" :value ("") string))
      88             :   :version "25.1"
      89             :   :group 'vc-bzr)
      90             : 
      91             : (defcustom vc-bzr-log-switches nil
      92             :   "String or list of strings specifying switches for bzr log under VC."
      93             :   :type '(choice (const :tag "None" nil)
      94             :                  (string :tag "Argument String")
      95             :                  (repeat :tag "Argument List" :value ("") string))
      96             :   :group 'vc-bzr)
      97             : 
      98             : (defcustom vc-bzr-status-switches
      99             :   (ignore-errors
     100             :     (with-temp-buffer
     101             :       (let ((process-environment (cons (format "BZR_LOG=%s" null-device)
     102             :                                        process-environment)))
     103             :         (call-process vc-bzr-program nil t nil "help" "status"))
     104             :       (if (search-backward "--no-classify" nil t)
     105             :           "--no-classify")))
     106             :   "String or list of strings specifying switches for bzr status under VC.
     107             : The option \"--no-classify\" should be present if your bzr supports it."
     108             :   :type '(choice (const :tag "None" nil)
     109             :                  (string :tag "Argument String")
     110             :                  (repeat :tag "Argument List" :value ("") string))
     111             :   :group 'vc-bzr
     112             :   :version "24.1")
     113             : 
     114             : ;; since v0.9, bzr supports removing the progress indicators
     115             : ;; by setting environment variable BZR_PROGRESS_BAR to "none".
     116             : (defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args)
     117             :   "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
     118             : Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
     119             : `LC_MESSAGES=C' to the environment.  If BZR-COMMAND is \"status\",
     120             : prepends `vc-bzr-status-switches' to ARGS."
     121           0 :   (let ((process-environment
     122           0 :          `("BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
     123             :            "LC_MESSAGES=C"         ; Force English output
     124           0 :            ,@process-environment)))
     125           0 :     (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
     126           0 :            file-or-list bzr-command
     127           0 :            (if (and (string-equal "status" bzr-command)
     128           0 :                     vc-bzr-status-switches)
     129           0 :                (append (if (stringp vc-bzr-status-switches)
     130           0 :                            (list vc-bzr-status-switches)
     131           0 :                          vc-bzr-status-switches)
     132           0 :                        args)
     133           0 :              args))))
     134             : 
     135             : (defun vc-bzr-async-command (bzr-command &rest args)
     136             :   "Wrapper round `vc-do-async-command' using `vc-bzr-program' as COMMAND.
     137             : Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
     138             : `LC_MESSAGES=C' to the environment.
     139             : Use the current Bzr root directory as the ROOT argument to
     140             : `vc-do-async-command', and specify an output buffer named
     141             : \"*vc-bzr : ROOT*\".  Return this buffer."
     142           0 :   (let* ((process-environment
     143           0 :           `("BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
     144           0 :             ,@process-environment))
     145           0 :          (root (vc-bzr-root default-directory))
     146           0 :          (buffer (format "*vc-bzr : %s*" (expand-file-name root))))
     147           0 :     (apply 'vc-do-async-command buffer root
     148           0 :            vc-bzr-program bzr-command args)
     149           0 :     buffer))
     150             : 
     151             : ;;;###autoload
     152             : (defconst vc-bzr-admin-dirname ".bzr"
     153             :   "Name of the directory containing Bzr repository status files.")
     154             : ;; Used in the autoloaded vc-bzr-registered; see below.
     155             : ;;;###autoload
     156             : (defconst vc-bzr-admin-checkout-format-file
     157             :   (concat vc-bzr-admin-dirname "/checkout/format")
     158             :   "Name of the format file in a .bzr directory.")
     159             : (defconst vc-bzr-admin-dirstate
     160             :   (concat vc-bzr-admin-dirname "/checkout/dirstate"))
     161             : (defconst vc-bzr-admin-branch-format-file
     162             :   (concat vc-bzr-admin-dirname "/branch/format"))
     163             : (defconst vc-bzr-admin-revhistory
     164             :   (concat vc-bzr-admin-dirname "/branch/revision-history"))
     165             : (defconst vc-bzr-admin-lastrev
     166             :   (concat vc-bzr-admin-dirname "/branch/last-revision"))
     167             : (defconst vc-bzr-admin-branchconf
     168             :   (concat vc-bzr-admin-dirname "/branch/branch.conf"))
     169             : 
     170             : (defun vc-bzr-root (file)
     171             :   "Return the root directory of the bzr repository containing FILE."
     172             :   ;; Cache technique copied from vc-arch.el.
     173          36 :   (or (vc-file-getprop file 'bzr-root)
     174          36 :       (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file)))
     175          36 :         (when root (vc-file-setprop file 'bzr-root root)))))
     176             : 
     177             : (defun vc-bzr-branch-conf (file)
     178             :   "Return the Bazaar branch settings for file FILE, as an alist.
     179             : Each element of the returned alist has the form (NAME . VALUE),
     180             : which are the name and value of a Bazaar setting, as strings.
     181             : 
     182             : The settings are read from the file \".bzr/branch/branch.conf\"
     183             : in the repository root directory of FILE."
     184           0 :   (let (settings)
     185           0 :     (with-temp-buffer
     186           0 :       (insert-file-contents
     187           0 :        (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file)))
     188           0 :       (while (re-search-forward "^\\([^#=][^=]*?\\) *= *\\(.*\\)$" nil t)
     189           0 :         (push (cons (match-string 1) (match-string 2)) settings)))
     190           0 :     settings))
     191             : 
     192             : (defun vc-bzr-sha1 (file)
     193           0 :   (with-temp-buffer
     194           0 :     (set-buffer-multibyte nil)
     195           0 :     (insert-file-contents-literally file)
     196           0 :     (sha1 (current-buffer))))
     197             : 
     198             : (defun vc-bzr-state-heuristic (file)
     199             :   "Like `vc-bzr-state' but hopefully without running Bzr."
     200             :   ;; `bzr status' could be slow with large histories and pending merges,
     201             :   ;; so this tries to avoid calling it if possible.  bzr status is
     202             :   ;; faster now, so this is not as important as it was.
     203             :   ;;
     204             :   ;; This function tries first to parse Bzr internal file
     205             :   ;; `checkout/dirstate', but it may fail if Bzr internal file format
     206             :   ;; has changed.  As a safeguard, the `checkout/dirstate' file is
     207             :   ;; only parsed if it contains the string `#bazaar dirstate flat
     208             :   ;; format 3' in the first line.
     209             :   ;; If the `checkout/dirstate' file cannot be parsed, fall back to
     210             :   ;; running `vc-bzr-state'."
     211             :   ;;
     212             :   ;; The format of the dirstate file is explained in bzrlib/dirstate.py
     213             :   ;; in the bzr distribution.  Basically:
     214             :   ;; header-line giving the version of the file format in use.
     215             :   ;; a few lines of stuff
     216             :   ;; entries, one per line, with null-separated fields.  Each line:
     217             :   ;; entry_key = dirname (may be empty), basename, file-id
     218             :   ;; current = common ( = kind, fingerprint, size, executable )
     219             :   ;;           + working ( = packed_stat )
     220             :   ;; parent = common ( as above ) + history ( = rev_id )
     221             :   ;; kinds = (r)elocated, (a)bsent, (d)irectory, (f)ile, (l)ink
     222          36 :   (let* ((root (vc-bzr-root file))
     223          36 :          (dirstate (expand-file-name vc-bzr-admin-dirstate root)))
     224          36 :     (when root                          ; Short cut.
     225           0 :       (condition-case err
     226           0 :           (with-temp-buffer
     227           0 :             (insert-file-contents dirstate)
     228           0 :             (goto-char (point-min))
     229           0 :             (if (not (looking-at "#bazaar dirstate flat format 3"))
     230           0 :                 (vc-bzr-state file)     ; Some other unknown format?
     231           0 :               (let* ((relfile (file-relative-name file root))
     232           0 :                      (reldir (file-name-directory relfile)))
     233           0 :                 (cond
     234           0 :                  ((not
     235           0 :                    (re-search-forward
     236           0 :                     (concat "^\0"
     237           0 :                             (if reldir (regexp-quote
     238           0 :                                         (directory-file-name reldir)))
     239             :                             "\0"
     240           0 :                             (regexp-quote (file-name-nondirectory relfile))
     241             :                             "\0"
     242             :                             "[^\0]*\0"             ;id?
     243             :                             "\\([^\0]*\\)\0"       ;"a/f/d", a=removed?
     244             :                             "\\([^\0]*\\)\0"       ;sha1 (empty if conflicted)?
     245             :                             "\\([^\0]*\\)\0"       ;size?p
     246             :                             ;; y/n.  Whether or not the current copy
     247             :                             ;; was executable the last time bzr checked?
     248             :                             "[^\0]*\0"
     249             :                             "[^\0]*\0"  ;?
     250             :                             ;; Parent information.  Absent in a new repo.
     251             :                             "\\(?:\\([^\0]*\\)\0"  ;"a/f/d" a=added?
     252             :                             "\\([^\0]*\\)\0"       ;sha1 again?
     253             :                             "\\([^\0]*\\)\0"       ;size again?
     254             :                             ;; y/n.  Whether or not the repo thinks
     255             :                             ;; the file should be executable?
     256             :                             "\\([^\0]*\\)\0"
     257             :                             "[^\0]*\0\\)?" ;last revid?
     258             :                             ;; There are more fields when merges are pending.
     259           0 :                             )
     260           0 :                     nil t))
     261             :                   'unregistered)
     262             :                  ;; Apparently the second sha1 is the one we want: when
     263             :                  ;; there's a conflict, the first sha1 is absent (and the
     264             :                  ;; first size seems to correspond to the file with
     265             :                  ;; conflict markers).
     266           0 :                  ((eq (char-after (match-beginning 1)) ?a) 'removed)
     267             :                  ;; If there is no parent, this must be a new repo.
     268             :                  ;; If file is in dirstate, can only be added (b#8025).
     269           0 :                  ((or (not (match-beginning 4))
     270           0 :                       (eq (char-after (match-beginning 4)) ?a)) 'added)
     271           0 :                  ((or (and (eq (string-to-number (match-string 3))
     272           0 :                                (nth 7 (file-attributes file)))
     273           0 :                            (equal (match-string 5)
     274           0 :                                   (save-match-data (vc-bzr-sha1 file)))
     275             :                            ;; For a file, does the executable state match?
     276             :                            ;; (Bug#7544)
     277           0 :                            (or (not
     278           0 :                                 (eq (char-after (match-beginning 1)) ?f))
     279           0 :                                (let ((exe
     280           0 :                                       (memq
     281             :                                        ?x
     282           0 :                                        (mapcar
     283             :                                         'identity
     284           0 :                                         (nth 8 (file-attributes file))))))
     285           0 :                                  (if (eq (char-after (match-beginning 7))
     286           0 :                                          ?y)
     287           0 :                                      exe
     288           0 :                                    (not exe)))))
     289           0 :                       (and
     290             :                        ;; It looks like for lightweight
     291             :                        ;; checkouts \2 is empty and we need to
     292             :                        ;; look for size in \6.
     293           0 :                        (eq (match-beginning 2) (match-end 2))
     294           0 :                        (eq (string-to-number (match-string 6))
     295           0 :                            (nth 7 (file-attributes file)))
     296           0 :                        (equal (match-string 5)
     297           0 :                               (vc-bzr-sha1 file))))
     298             :                   'up-to-date)
     299           0 :                  (t 'edited)))))
     300             :         ;; The dirstate file can't be read, or some other problem.
     301             :         (error
     302           0 :          (message "Falling back on \"slow\" status detection (%S)" err)
     303          36 :          (vc-bzr-state file))))))
     304             : 
     305             : ;; This is a cheap approximation that is autoloaded.  If it finds a
     306             : ;; possible match it loads this file and runs the real function.
     307             : ;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too.
     308             : ;;;###autoload (defun vc-bzr-registered (file)
     309             : ;;;###autoload   (if (vc-find-root file vc-bzr-admin-checkout-format-file)
     310             : ;;;###autoload       (progn
     311             : ;;;###autoload         (load "vc-bzr" nil t)
     312             : ;;;###autoload         (vc-bzr-registered file))))
     313             : 
     314             : (defun vc-bzr-registered (file)
     315             :   "Return non-nil if FILE is registered with bzr."
     316          36 :   (let ((state (vc-bzr-state-heuristic file)))
     317          36 :     (not (memq state '(nil unregistered ignored)))))
     318             : 
     319             : (defconst vc-bzr-state-words
     320             :   "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
     321             :   "Regexp matching file status words as reported in `bzr' output.")
     322             : 
     323             : ;; History of Bzr commands.
     324             : (defvar vc-bzr-history nil)
     325             : 
     326             : (defun vc-bzr-file-name-relative (filename)
     327             :   "Return file name FILENAME stripped of the initial Bzr repository path."
     328           0 :   (let* ((filename* (expand-file-name filename))
     329           0 :          (rootdir (vc-bzr-root filename*)))
     330           0 :     (when rootdir
     331           0 :          (file-relative-name filename* rootdir))))
     332             : 
     333             : (defvar vc-bzr-error-regexp-alist
     334             :   '(("^\\( M[* ]\\|+N \\|-D \\|\\|  \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
     335             :     ("^C  \\(.+\\)" 2)
     336             :     ("^Text conflict in \\(.+\\)" 1 nil nil 2)
     337             :     ("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
     338             :   "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
     339             : 
     340             : ;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
     341             : (declare-function vc-exec-after "vc-dispatcher" (code))
     342             : (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
     343             : (declare-function vc-compilation-mode "vc-dispatcher" (backend))
     344             : 
     345             : (defun vc-bzr--pushpull (command prompt)
     346             :     "Run COMMAND (a string; either push or pull) on the current Bzr branch.
     347             : If PROMPT is non-nil, prompt for the Bzr command to run."
     348           0 :   (let* ((vc-bzr-program vc-bzr-program)
     349           0 :          (branch-conf (vc-bzr-branch-conf default-directory))
     350             :          ;; Check whether the branch is bound.
     351           0 :          (bound (assoc "bound" branch-conf))
     352           0 :          (bound (and bound (equal "true" (downcase (cdr bound)))))
     353           0 :          (has-loc (assoc (if (equal command "push")
     354             :                              "push_location"
     355           0 :                            "parent_location")
     356           0 :                          branch-conf))
     357             :          args)
     358           0 :     (when bound
     359           0 :       (if (equal command "push")
     360           0 :           (user-error "Cannot push a bound branch")
     361           0 :         (setq command "update")))
     362             :     ;; If necessary, prompt for the exact command.
     363           0 :     (when (or prompt (if (equal command "push")
     364           0 :                          (not has-loc)
     365           0 :                        (not (or bound has-loc))))
     366           0 :       (setq args (split-string
     367           0 :                   (read-shell-command
     368           0 :                    (format "Bzr %s command: " command)
     369           0 :                    (format "%s %s" vc-bzr-program command)
     370           0 :                    'vc-bzr-history)
     371           0 :                   " " t))
     372           0 :       (setq vc-bzr-program (car  args)
     373           0 :             command        (cadr args)
     374           0 :             args           (cddr args)))
     375           0 :     (require 'vc-dispatcher)
     376           0 :     (let ((buf (apply 'vc-bzr-async-command command args)))
     377           0 :       (with-current-buffer buf
     378           0 :         (vc-run-delayed
     379           0 :           (vc-compilation-mode 'bzr)
     380           0 :           (setq-local compile-command
     381           0 :                       (concat vc-bzr-program " " command " "
     382           0 :                               (if args (mapconcat 'identity args " ") "")))))
     383           0 :       (vc-set-async-update buf))))
     384             : 
     385             : (defun vc-bzr-pull (prompt)
     386             :   "Pull changes into the current Bzr branch.
     387             : Normally, this runs \"bzr pull\".  However, if the branch is a
     388             : bound branch, run \"bzr update\" instead.  If there is no default
     389             : location from which to pull or update, or if PROMPT is non-nil,
     390             : prompt for the Bzr command to run."
     391           0 :   (vc-bzr--pushpull "pull" prompt))
     392             : 
     393             : (defun vc-bzr-push (prompt)
     394             :   "Push changes from the current Bzr branch.
     395             : Normally, this runs \"bzr push\".  If there is no push location,
     396             : or if PROMPT is non-nil, prompt for the Bzr command to run."
     397           0 :   (vc-bzr--pushpull "push" prompt))
     398             : 
     399             : (defun vc-bzr-merge-branch ()
     400             :   "Merge another Bzr branch into the current one.
     401             : Prompt for the Bzr command to run, providing a pre-defined merge
     402             : source (an upstream branch or a previous merge source) as a
     403             : default if it is available."
     404           0 :   (let* ((branch-conf (vc-bzr-branch-conf default-directory))
     405             :          ;; "bzr merge" without an argument defaults to submit_branch,
     406             :          ;; then parent_location.  Extract the specific location and
     407             :          ;; add it explicitly to the command line.
     408             :          (setting nil)
     409             :          (location
     410           0 :           (cond
     411           0 :            ((setq setting (assoc "submit_branch" branch-conf))
     412           0 :             (cdr setting))
     413           0 :            ((setq setting (assoc "parent_location" branch-conf))
     414           0 :             (cdr setting))))
     415             :          (cmd
     416           0 :           (split-string
     417           0 :            (read-shell-command
     418             :             "Bzr merge command: "
     419           0 :             (concat vc-bzr-program " merge --pull"
     420           0 :                     (if location (concat " " location) ""))
     421           0 :             'vc-bzr-history)
     422           0 :            " " t))
     423           0 :          (vc-bzr-program (car  cmd))
     424           0 :          (command        (cadr cmd))
     425           0 :          (args           (cddr cmd)))
     426           0 :     (let ((buf (apply 'vc-bzr-async-command command args)))
     427           0 :       (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
     428           0 :       (vc-set-async-update buf))))
     429             : 
     430             : (defun vc-bzr-status (file)
     431             :   "Return FILE status according to Bzr.
     432             : Return value is a cons (STATUS . WARNING), where WARNING is a
     433             : string or nil, and STATUS is one of the symbols: `added',
     434             : `ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
     435             : which directly correspond to `bzr status' output, or 'unchanged
     436             : for files whose copy in the working tree is identical to the one
     437             : in the branch repository (or whose status not be determined)."
     438             : ;; Doc used to also say the following, but AFAICS, it has never been true.
     439             : ;;
     440             : ;;   ", or nil for files that are not registered with Bzr.
     441             : ;;   If any error occurred in running `bzr status', then return nil."
     442             : ;;
     443             : ;; Rather than returning nil in case of an error, it returns
     444             : ;; (unchanged . WARNING).  FIXME unchanged is not the best status to
     445             : ;; return in case of error.
     446           0 :   (with-temp-buffer
     447             :     ;; This is with-demoted-errors without the condition-case-unless-debug
     448             :     ;; annoyance, which makes it fail during ert testing.
     449           0 :     (condition-case err (vc-bzr-command "status" t 0 file)
     450           0 :       (error (message "Error: %S" err) nil))
     451           0 :     (let ((status 'unchanged))
     452             :       ;; the only secure status indication in `bzr status' output
     453             :       ;; is a couple of lines following the pattern::
     454             :       ;;   | <status>:
     455             :       ;;   |   <file name>
     456             :       ;; if the file is up-to-date, we get no status report from `bzr',
     457             :       ;; so if the regexp search for the above pattern fails, we consider
     458             :       ;; the file to be up-to-date.
     459           0 :       (goto-char (point-min))
     460           0 :       (when (re-search-forward
     461             :              ;; bzr prints paths relative to the repository root.
     462           0 :              (concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
     463           0 :                      (regexp-quote (vc-bzr-file-name-relative file))
     464             :                      ;; Bzr appends a '/' to directory names and
     465             :                      ;; '*' to executable files
     466           0 :                      (if (file-directory-p file) "/?" "\\*?")
     467           0 :                      "[ \t\n]*$")
     468           0 :              nil t)
     469           0 :         (let ((statusword (match-string 1)))
     470             :           ;; Erase the status text that matched.
     471           0 :           (delete-region (match-beginning 0) (match-end 0))
     472           0 :           (setq status
     473           0 :                 (intern (replace-regexp-in-string " " "" statusword)))))
     474           0 :       (when status
     475           0 :         (goto-char (point-min))
     476           0 :         (skip-chars-forward " \n\t") ;Throw away spaces.
     477           0 :         (cons status
     478             :               ;; "bzr" will output warnings and informational messages to
     479             :               ;; stderr; due to Emacs's `vc-do-command' (and, it seems,
     480             :               ;; `start-process' itself) limitations, we cannot catch stderr
     481             :               ;; and stdout into different buffers.  So, if there's anything
     482             :               ;; left in the buffer after removing the above status
     483             :               ;; keywords, let us just presume that any other message from
     484             :               ;; "bzr" is a user warning, and display it.
     485           0 :               (unless (eobp) (buffer-substring (point) (point-max))))))))
     486             : 
     487             : (defun vc-bzr-state (file)
     488           0 :   (let ((result (vc-bzr-status file)))
     489           0 :     (when (consp result)
     490           0 :       (let ((warnings (cdr result)))
     491           0 :         (when warnings
     492             :           ;; bzr 2.3.0 returns info about shelves, which is not really a warning
     493           0 :           (when (string-match "[0-9]+ shel\\(f\\|ves\\) exists?\\..*?\n" warnings)
     494           0 :             (setq warnings (replace-match "" nil nil warnings)))
     495           0 :           (unless (string= warnings "")
     496           0 :             (message "Warnings in `bzr' output: %s" warnings))))
     497           0 :       (cdr (assq (car result)
     498             :                  '((added . added)
     499             :                    (kindchanged . edited)
     500             :                    (renamed . edited)
     501             :                    (modified . edited)
     502             :                    (removed . removed)
     503             :                    (ignored . ignored)
     504             :                    (unknown . unregistered)
     505           0 :                    (unchanged . up-to-date)))))))
     506             : 
     507             : (defun vc-bzr-resolve-when-done ()
     508             :   "Call \"bzr resolve\" if the conflict markers have been removed."
     509           0 :   (save-excursion
     510           0 :     (goto-char (point-min))
     511           0 :     (unless (re-search-forward "^<<<<<<< " nil t)
     512           0 :       (vc-bzr-command "resolve" nil 0 buffer-file-name)
     513             :       ;; Remove the hook so that it is not called multiple times.
     514           0 :       (remove-hook 'after-save-hook 'vc-bzr-resolve-when-done t))))
     515             : 
     516             : (defun vc-bzr-find-file-hook ()
     517           0 :   (when (and buffer-file-name
     518             :              ;; FIXME: We should check that "bzr status" says "conflict".
     519           0 :              (file-exists-p (concat buffer-file-name ".BASE"))
     520           0 :              (file-exists-p (concat buffer-file-name ".OTHER"))
     521           0 :              (file-exists-p (concat buffer-file-name ".THIS"))
     522             :              ;; If "bzr status" says there's a conflict but there are no
     523             :              ;; conflict markers, it's not clear what we should do.
     524           0 :              (save-excursion
     525           0 :                (goto-char (point-min))
     526           0 :                (re-search-forward "^<<<<<<< " nil t)))
     527             :     ;; TODO: the merge algorithm used in `bzr merge' is nicely configurable,
     528             :     ;; but the one in `bzr pull' isn't, so it would be good to provide an
     529             :     ;; elisp function to remerge from the .BASE/OTHER/THIS files.
     530           0 :     (smerge-start-session)
     531           0 :     (add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
     532           0 :     (vc-message-unresolved-conflicts buffer-file-name)))
     533             : 
     534             : (defun vc-bzr-version-dirstate (dir)
     535             :   "Try to return as a string the bzr revision ID of directory DIR.
     536             : This uses the dirstate file's parent revision entry.
     537             : Returns nil if unable to find this information."
     538           0 :   (let ((file (expand-file-name ".bzr/checkout/dirstate" dir)))
     539           0 :     (when (file-readable-p file)
     540           0 :       (with-temp-buffer
     541           0 :         (insert-file-contents file)
     542           0 :         (and (looking-at "#bazaar dirstate flat format 3")
     543           0 :              (forward-line 3)
     544           0 :              (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
     545           0 :              (match-string 1))))))
     546             : 
     547             : (defun vc-bzr-working-revision (file)
     548           0 :   (let* ((rootdir (vc-bzr-root file))
     549           0 :          (branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
     550           0 :                                                rootdir))
     551           0 :          (revhistory-file (expand-file-name vc-bzr-admin-revhistory rootdir))
     552           0 :          (lastrev-file (expand-file-name vc-bzr-admin-lastrev rootdir)))
     553             :     ;; This looks at internal files to avoid forking a bzr process.
     554             :     ;; May break if they change their format.
     555           0 :     (if (and (file-exists-p branch-format-file)
     556             :              ;; For lightweight checkouts (obtained with bzr co --lightweight)
     557             :              ;; the branch-format-file does not contain the revision
     558             :              ;; information, we need to look up the branch-format-file
     559             :              ;; in the place where the lightweight checkout comes
     560             :              ;; from.  We only do that if it's a local file.
     561           0 :              (let ((location-fname (expand-file-name
     562           0 :                                     (concat vc-bzr-admin-dirname
     563           0 :                                             "/branch/location") rootdir)))
     564             :                ;; The existence of this file is how we distinguish
     565             :                ;; lightweight checkouts.
     566           0 :                (if (file-exists-p location-fname)
     567           0 :                    (with-temp-buffer
     568           0 :                      (insert-file-contents location-fname)
     569             :                      ;; If the lightweight checkout points to a
     570             :                      ;; location in the local file system, then we can
     571             :                      ;; look there for the version information.
     572           0 :                      (when (re-search-forward "file://\\(.+\\)" nil t)
     573           0 :                        (let ((l-c-parent-dir (match-string 1)))
     574           0 :                          (when (and (memq system-type '(ms-dos windows-nt))
     575           0 :                                     (string-match-p "^/[[:alpha:]]:"
     576           0 :                                                     l-c-parent-dir))
     577             :                            ;;; The non-Windows code takes a shortcut by using
     578             :                            ;;; the host/path separator slash as the start of
     579             :                            ;;; the absolute path.  That does not work on
     580             :                            ;;; Windows, so we must remove it (bug#5345)
     581           0 :                            (setq l-c-parent-dir (substring l-c-parent-dir 1)))
     582           0 :                          (setq branch-format-file
     583           0 :                                (expand-file-name vc-bzr-admin-branch-format-file
     584           0 :                                                  l-c-parent-dir))
     585           0 :                          (setq lastrev-file
     586           0 :                                (expand-file-name vc-bzr-admin-lastrev
     587           0 :                                                  l-c-parent-dir))
     588             :                          ;; FIXME: maybe it's overkill to check if both these
     589             :                          ;; files exist.
     590           0 :                          (and (file-exists-p branch-format-file)
     591           0 :                               (file-exists-p lastrev-file)
     592           0 :                               (equal (vc-bzr-version-dirstate l-c-parent-dir)
     593           0 :                                      (vc-bzr-version-dirstate rootdir))))))
     594           0 :                  t)))
     595           0 :         (with-temp-buffer
     596           0 :           (insert-file-contents branch-format-file)
     597           0 :           (goto-char (point-min))
     598           0 :           (cond
     599           0 :            ((or
     600           0 :              (looking-at "Bazaar-NG branch, format 0.0.4")
     601           0 :              (looking-at "Bazaar-NG branch format 5"))
     602             :             ;; count lines in .bzr/branch/revision-history
     603           0 :             (insert-file-contents revhistory-file)
     604           0 :             (number-to-string (count-lines (line-end-position) (point-max))))
     605           0 :            ((or
     606           0 :              (looking-at "Bazaar Branch Format 6 (bzr 0.15)")
     607           0 :              (looking-at "Bazaar Branch Format 7 (needs bzr 1.6)"))
     608             :             ;; revno is the first number in .bzr/branch/last-revision
     609           0 :             (insert-file-contents lastrev-file)
     610           0 :             (when (re-search-forward "[0-9]+" nil t)
     611           0 :               (buffer-substring (match-beginning 0) (match-end 0))))))
     612             :       ;; Fallback to calling "bzr revno --tree".
     613             :       ;; The "--tree" matters for lightweight checkouts not on the same
     614             :       ;; revision as the parent.
     615           0 :       (let* ((result (vc-bzr-command-discarding-stderr
     616           0 :                       vc-bzr-program "revno" "--tree"
     617           0 :                       (file-relative-name file)))
     618           0 :              (exitcode (car result))
     619           0 :              (output (cdr result)))
     620           0 :         (cond
     621           0 :          ((and (eq exitcode 0) (not (zerop (length output))))
     622           0 :           (substring output 0 -1))
     623           0 :          (t nil))))))
     624             : 
     625             : (defun vc-bzr-create-repo ()
     626             :   "Create a new Bzr repository."
     627           0 :   (vc-bzr-command "init" nil 0 nil))
     628             : 
     629             : (defun vc-bzr-previous-revision (_file rev)
     630           0 :   (if (string-match "\\`[0-9]+\\'" rev)
     631           0 :       (number-to-string (1- (string-to-number rev)))
     632           0 :     (concat "before:" rev)))
     633             : 
     634             : (defun vc-bzr-next-revision (_file rev)
     635           0 :   (if (string-match "\\`[0-9]+\\'" rev)
     636           0 :       (number-to-string (1+ (string-to-number rev)))
     637           0 :     (error "Don't know how to compute the next revision of %s" rev)))
     638             : 
     639             : (defun vc-bzr-register (files &optional _comment)
     640             :   "Register FILES under bzr. COMMENT is ignored."
     641           0 :   (vc-bzr-command "add" nil 0 files))
     642             : 
     643             : ;; Could run `bzr status' in the directory and see if it succeeds, but
     644             : ;; that's relatively expensive.
     645             : (defalias 'vc-bzr-responsible-p 'vc-bzr-root
     646             :   "Return non-nil if FILE is (potentially) controlled by bzr.
     647             : The criterion is that there is a `.bzr' directory in the same
     648             : or a superior directory.")
     649             : 
     650             : (defun vc-bzr-unregister (file)
     651             :   "Unregister FILE from bzr."
     652           0 :   (vc-bzr-command "remove" nil 0 file "--keep"))
     653             : 
     654             : (declare-function log-edit-extract-headers "log-edit" (headers string))
     655             : 
     656             : (defun vc-bzr--sanitize-header (arg)
     657             :   ;; Newlines in --fixes (and probably other fields as well) trigger a nasty
     658             :   ;; Bazaar bug; see https://bugs.launchpad.net/bzr/+bug/1094180.
     659           0 :   (lambda (str) (list arg
     660           0 :                  (replace-regexp-in-string "\\`[ \t]+\\|[ \t]+\\'"
     661           0 :                                            "" (replace-regexp-in-string
     662           0 :                                                "\n[ \t]?" " " str)))))
     663             : 
     664             : (defun vc-bzr-checkin (files comment &optional _rev)
     665             :   "Check FILES in to bzr with log message COMMENT."
     666           0 :   (apply 'vc-bzr-command "commit" nil 0 files
     667           0 :          (cons "-m" (log-edit-extract-headers
     668           0 :                      `(("Author" . ,(vc-bzr--sanitize-header "--author"))
     669           0 :                        ("Date" . ,(vc-bzr--sanitize-header "--commit-time"))
     670           0 :                        ("Fixes" . ,(vc-bzr--sanitize-header "--fixes")))
     671           0 :                      comment))))
     672             : 
     673             : (defun vc-bzr-find-revision (file rev buffer)
     674             :   "Fetch revision REV of file FILE and put it into BUFFER."
     675           0 :     (with-current-buffer buffer
     676           0 :       (if (and rev (stringp rev) (not (string= rev "")))
     677           0 :           (vc-bzr-command "cat" t 0 file "-r" rev)
     678           0 :         (vc-bzr-command "cat" t 0 file))))
     679             : 
     680             : (defun vc-bzr-find-ignore-file (file)
     681             :   "Return the root directory of the repository of FILE."
     682           0 :   (expand-file-name ".bzrignore"
     683           0 :                     (vc-bzr-root file)))
     684             : 
     685             : (defun vc-bzr-checkout (_file &optional rev)
     686           0 :   (if rev (error "Operation not supported")
     687             :     ;; Else, there's nothing to do.
     688           0 :     nil))
     689             : 
     690             : (defun vc-bzr-revert (file &optional contents-done)
     691           0 :   (unless contents-done
     692           0 :     (with-temp-buffer (vc-bzr-command "revert" t 0 file "--no-backup"))))
     693             : 
     694             : (defvar log-view-message-re)
     695             : (defvar log-view-file-re)
     696             : (defvar log-view-font-lock-keywords)
     697             : (defvar log-view-current-tag-function)
     698             : (defvar log-view-per-file-logs)
     699             : (defvar log-view-expanded-log-entry-function)
     700             : 
     701             : (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
     702           0 :   (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
     703           0 :   (require 'add-log)
     704           0 :   (set (make-local-variable 'log-view-per-file-logs) nil)
     705           0 :   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
     706           0 :   (set (make-local-variable 'log-view-message-re)
     707           0 :        (if (eq vc-log-view-type 'short)
     708             :            "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?"
     709           0 :          "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)"))
     710             :   ;; Allow expanding short log entries
     711           0 :   (when (eq vc-log-view-type 'short)
     712           0 :     (setq truncate-lines t)
     713           0 :     (set (make-local-variable 'log-view-expanded-log-entry-function)
     714           0 :          'vc-bzr-expanded-log-entry))
     715           0 :   (set (make-local-variable 'log-view-font-lock-keywords)
     716             :        ;; log-view-font-lock-keywords is careful to use the buffer-local
     717             :        ;; value of log-view-message-re only since Emacs-23.
     718           0 :        (if (eq vc-log-view-type 'short)
     719           0 :          (append `((,log-view-message-re
     720             :                     (1 'log-view-message)
     721             :                     (2 'change-log-name)
     722             :                     (3 'change-log-date)
     723           0 :                     (4 'change-log-list nil lax))))
     724           0 :          (append `((,log-view-message-re . 'log-view-message))
     725             :                  ;; log-view-font-lock-keywords
     726             :                  '(("^ *\\(?:committer\\|author\\): \
     727             : \\([^<(]+?\\)[  ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]"
     728             :                     (1 'change-log-name)
     729             :                     (2 'change-log-email))
     730           0 :                    ("^ *timestamp: \\(.*\\)" (1 'change-log-date)))))))
     731             : 
     732             : (autoload 'vc-setup-buffer "vc-dispatcher")
     733             : 
     734             : (defun vc-bzr-print-log (files buffer &optional shortlog start-revision limit)
     735             :   "Print commit log associated with FILES into specified BUFFER.
     736             : If SHORTLOG is non-nil, use --line format.
     737             : If START-REVISION is non-nil, it is the newest revision to show.
     738             : If LIMIT is non-nil, show no more than this many entries."
     739             :   ;; `vc-do-command' creates the buffer, but we need it before running
     740             :   ;; the command.
     741           0 :   (vc-setup-buffer buffer)
     742             :   ;; If the buffer exists from a previous invocation it might be
     743             :   ;; read-only.
     744             :   ;; FIXME: `vc-bzr-command' runs `bzr log' with `LC_MESSAGES=C', so
     745             :   ;; the log display may not what the user wants - but I see no other
     746             :   ;; way of getting the above regexps working.
     747           0 :   (with-current-buffer buffer
     748           0 :     (apply 'vc-bzr-command "log" buffer 'async files
     749           0 :            (append
     750           0 :             (if shortlog '("--line") '("--long"))
     751             :             ;; The extra complications here when start-revision and limit
     752             :             ;; are set are due to bzr log's --forward argument, which
     753             :             ;; could be enabled via an alias in bazaar.conf.
     754             :             ;; Svn, for example, does not have this problem, because
     755             :             ;; it doesn't have --forward.  Instead, you can use
     756             :             ;; svn --log -r HEAD:0 or -r 0:HEAD as you prefer.
     757             :             ;; Bzr, however, insists in -r X..Y that X come before Y.
     758           0 :             (if start-revision
     759           0 :                 (list (format
     760           0 :                        (if (and limit (= limit 1))
     761             :                            ;; This means we don't have to use --no-aliases.
     762             :                            ;; Is -c any different to -r in this case?
     763             :                            "-r%s"
     764           0 :                          "-r..%s") start-revision)))
     765           0 :             (when limit (list "-l" (format "%s" limit)))
     766             :             ;; There is no sensible way to combine --limit and --forward,
     767             :             ;; and it breaks the meaning of START-REVISION as the
     768             :             ;; _newest_ revision.  See bug#14168.
     769             :             ;; Eg bzr log --forward -r ..100 --limit 50 prints
     770             :             ;; revisions 1-50 rather than 50-100.  There
     771             :             ;; seems no way in general to get bzr to print revisions
     772             :             ;; 50-100 in --forward order in that case.
     773             :             ;; FIXME There may be other alias stuff we want to keep.
     774             :             ;; Is there a way to just suppress --forward?
     775             :             ;; As of 2013/4 the only caller uses limit = 1, so it does
     776             :             ;; not matter much.
     777           0 :             (and start-revision limit (> limit 1) '("--no-aliases"))
     778           0 :             (if (stringp vc-bzr-log-switches)
     779           0 :                 (list vc-bzr-log-switches)
     780           0 :               vc-bzr-log-switches)))))
     781             : 
     782             : (defun vc-bzr-expanded-log-entry (revision)
     783           0 :   (with-temp-buffer
     784           0 :     (apply 'vc-bzr-command "log" t nil nil
     785           0 :            (list "--long" (format "-r%s" revision)))
     786           0 :     (goto-char (point-min))
     787           0 :     (when (looking-at "^-+\n")
     788             :       ;; Indent the expanded log entry.
     789           0 :       (indent-region (match-end 0) (point-max) 2)
     790           0 :       (buffer-substring (match-end 0) (point-max)))))
     791             : 
     792             : (defun vc-bzr-log-incoming (buffer remote-location)
     793           0 :   (apply 'vc-bzr-command "missing" buffer 'async nil
     794           0 :          (list "--theirs-only" (unless (string= remote-location "") remote-location))))
     795             : 
     796             : (defun vc-bzr-log-outgoing (buffer remote-location)
     797           0 :   (apply 'vc-bzr-command "missing" buffer 'async nil
     798           0 :          (list "--mine-only" (unless (string= remote-location "") remote-location))))
     799             : 
     800             : (defun vc-bzr-show-log-entry (revision)
     801             :   "Find entry for patch name REVISION in bzr change log buffer."
     802           0 :   (goto-char (point-min))
     803           0 :   (when revision
     804           0 :     (let (case-fold-search
     805             :           found)
     806           0 :       (if (re-search-forward
     807             :            ;; "revno:" can appear either at the beginning of a line,
     808             :            ;; or indented.
     809           0 :            (concat "^[ ]*-+\n[ ]*revno: "
     810             :                    ;; The revision can contain ".", quote it so that it
     811             :                    ;; does not interfere with regexp matching.
     812           0 :                    (regexp-quote revision) "$") nil t)
     813           0 :           (progn
     814           0 :             (beginning-of-line 0)
     815           0 :             (setq found t))
     816           0 :         (goto-char (point-min)))
     817           0 :       found)))
     818             : 
     819             : (autoload 'vc-switches "vc")
     820             : 
     821             : (defun vc-bzr-diff (files &optional rev1 rev2 buffer async)
     822             :   "VC bzr backend for diff."
     823           0 :   (let* ((switches (vc-switches 'bzr 'diff))
     824             :          (args
     825           0 :           (append
     826             :            ;; Only add --diff-options if there are any diff switches.
     827           0 :            (unless (zerop (length switches))
     828           0 :              (list "--diff-options" (mapconcat 'identity switches " ")))
     829             :            ;; This `when' is just an optimization because bzr-1.2 is *much*
     830             :            ;; faster when the revision argument is not given.
     831           0 :            (when (or rev1 rev2)
     832           0 :              (list "-r" (format "%s..%s"
     833           0 :                                 (or rev1 "revno:-1")
     834           0 :                                 (or rev2 "")))))))
     835             :     ;; `bzr diff' exits with code 1 if diff is non-empty.
     836           0 :     (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*")
     837           0 :            (if async 1 'async) files
     838           0 :            args)))
     839             : 
     840             : 
     841             : ;; FIXME: vc-{next,previous}-revision need fixing in vc.el to deal with
     842             : ;; straight integer revisions.
     843             : 
     844             : (defun vc-bzr-delete-file (file)
     845             :   "Delete FILE and delete it in the bzr repository."
     846           0 :   (condition-case ()
     847           0 :       (delete-file file)
     848           0 :     (file-error nil))
     849           0 :   (vc-bzr-command "remove" nil 0 file))
     850             : 
     851             : (defun vc-bzr-rename-file (old new)
     852             :   "Rename file from OLD to NEW using `bzr mv'."
     853           0 :   (setq old (expand-file-name old))
     854           0 :   (setq new (expand-file-name new))
     855           0 :   (vc-bzr-command "mv" nil 0 new old)
     856           0 :   (message "Renamed %s => %s" old new))
     857             : 
     858             : (defvar vc-bzr-annotation-table nil
     859             :   "Internal use.")
     860             : (make-variable-buffer-local 'vc-bzr-annotation-table)
     861             : 
     862             : (defun vc-bzr-annotate-command (file buffer &optional revision)
     863             :   "Prepare BUFFER for `vc-annotate' on FILE.
     864             : Each line is tagged with the revision number, which has a `help-echo'
     865             : property containing author and date information."
     866           0 :   (apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
     867           0 :          (append (vc-switches 'bzr 'annotate)
     868           0 :                  (if revision (list "-r" revision))))
     869           0 :   (let ((table (make-hash-table :test 'equal)))
     870           0 :     (set-process-filter
     871           0 :      (get-buffer-process buffer)
     872             :      (lambda (proc string)
     873           0 :        (when (process-buffer proc)
     874           0 :          (with-current-buffer (process-buffer proc)
     875           0 :            (setq string (concat (process-get proc :vc-left-over) string))
     876             :            ;; Eg: 102020      Gnus developers          20101020 | regexp."
     877             :            ;; As of bzr 2.2.2, no email address in whoami (which can
     878             :            ;; lead to spaces in the author field) is allowed but discouraged.
     879             :            ;; See bug#7792.
     880           0 :            (while (string-match "^\\( *[0-9.]+ *\\) \\(.+?\\) +\\([0-9]\\{8\\}\\)\\( |.*\n\\)" string)
     881           0 :              (let* ((rev (match-string 1 string))
     882           0 :                     (author (match-string 2 string))
     883           0 :                     (date (match-string 3 string))
     884           0 :                     (key (substring string (match-beginning 0)
     885           0 :                                     (match-beginning 4)))
     886           0 :                     (line (match-string 4 string))
     887           0 :                     (tag (gethash key table))
     888             :                     (inhibit-read-only t))
     889           0 :                (setq string (substring string (match-end 0)))
     890           0 :                (unless tag
     891           0 :                  (setq tag
     892           0 :                        (propertize
     893           0 :                         (format "%s %-7.7s" rev author)
     894           0 :                         'help-echo (format "Revision: %d, author: %s, date: %s"
     895           0 :                                            (string-to-number rev)
     896           0 :                                            author date)
     897           0 :                         'mouse-face 'highlight))
     898           0 :                  (puthash key tag table))
     899           0 :                (goto-char (process-mark proc))
     900           0 :                (insert tag line)
     901           0 :                (move-marker (process-mark proc) (point))))
     902           0 :            (process-put proc :vc-left-over string)))))))
     903             : 
     904             : (declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
     905             : 
     906             : (defun vc-bzr-annotate-time ()
     907           0 :   (when (re-search-forward "^ *[0-9.]+ +.+? +|" nil t)
     908           0 :     (let ((prop (get-text-property (line-beginning-position) 'help-echo)))
     909           0 :       (string-match "[0-9]+\\'" prop)
     910           0 :       (let ((str (match-string-no-properties 0 prop)))
     911           0 :       (vc-annotate-convert-time
     912           0 :        (encode-time 0 0 0
     913           0 :                       (string-to-number (substring str 6 8))
     914           0 :                       (string-to-number (substring str 4 6))
     915           0 :                       (string-to-number (substring str 0 4))))))))
     916             : 
     917             : (defun vc-bzr-annotate-extract-revision-at-line ()
     918             :   "Return revision for current line of annotation buffer, or nil.
     919             : Return nil if current line isn't annotated."
     920           0 :   (save-excursion
     921           0 :     (beginning-of-line)
     922           0 :     (if (looking-at "^ *\\([0-9.]+\\) +.* +|")
     923           0 :         (match-string-no-properties 1))))
     924             : 
     925             : (defun vc-bzr-command-discarding-stderr (command &rest args)
     926             :   "Execute shell command COMMAND (with ARGS); return its output and exitcode.
     927             : Return value is a cons (EXITCODE . OUTPUT), where EXITCODE is
     928             : the (numerical) exit code of the process, and OUTPUT is a string
     929             : containing whatever the process sent to its standard output
     930             : stream.  Standard error output is discarded."
     931           0 :   (with-temp-buffer
     932           0 :     (cons
     933           0 :      (apply #'process-file command nil (list (current-buffer) nil) nil args)
     934           0 :      (buffer-substring (point-min) (point-max)))))
     935             : 
     936             : (cl-defstruct (vc-bzr-extra-fileinfo
     937             :             (:copier nil)
     938             :             (:constructor vc-bzr-create-extra-fileinfo (extra-name))
     939             :             (:conc-name vc-bzr-extra-fileinfo->))
     940             :   extra-name)         ;; original name for rename targets, new name for
     941             : 
     942             : (declare-function vc-default-dir-printer "vc-dir" (backend fileentry))
     943             : 
     944             : (defun vc-bzr-dir-printer (info)
     945             :   "Pretty-printer for the vc-dir-fileinfo structure."
     946           0 :   (let ((extra (vc-dir-fileinfo->extra info)))
     947           0 :     (vc-default-dir-printer 'Bzr info)
     948           0 :     (when extra
     949           0 :       (insert (propertize
     950           0 :                (format "   (renamed from %s)"
     951           0 :                        (vc-bzr-extra-fileinfo->extra-name extra))
     952           0 :                'face 'font-lock-comment-face)))))
     953             : 
     954             : ;; FIXME: this needs testing, it's probably incomplete.
     955             : (defun vc-bzr-after-dir-status (update-function relative-dir)
     956           0 :   (let ((status-str nil)
     957             :         (translation '(("+N " . added)
     958             :                        ("-D " . removed)
     959             :                        (" M " . edited) ;; file text modified
     960             :                        ("  *" . edited) ;; execute bit changed
     961             :                        (" M*" . edited) ;; text modified + execute bit changed
     962             :                        ("I  " . ignored)
     963             :                        (" D " . missing)
     964             :                        ;; For conflicts, should we list the .THIS/.BASE/.OTHER?
     965             :                        ("C  " . conflict)
     966             :                        ("?  " . unregistered)
     967             :                        ;; No such state, but we need to distinguish this case.
     968             :                        ("R  " . renamed)
     969             :                        ("RM " . renamed)
     970             :                        ;; For a non existent file FOO, the output is:
     971             :                        ;; bzr: ERROR: Path(s) do not exist: FOO
     972             :                        ("bzr" . not-found)
     973             :                        ;; If the tree is not up to date, bzr will print this warning:
     974             :                        ;; working tree is out of date, run 'bzr update'
     975             :                        ;; ignore it.
     976             :                        ;; FIXME: maybe this warning can be put in the vc-dir header...
     977             :                        ("wor" . not-found)
     978             :                        ;; Ignore "P " and "P." for pending patches.
     979             :                        ("P  " . not-found)
     980             :                        ("P. " . not-found)
     981             :                        ))
     982             :         (translated nil)
     983             :         (result nil))
     984           0 :       (goto-char (point-min))
     985             :       ;; Skip a warning message that can occur in some bzr installations.
     986             :       ;; vc-bzr-dir-extra-headers already reports it.
     987             :       ;; Perhaps we should just discard stderr?
     988           0 :       (and (looking-at "bzr: WARNING: bzrlib version doesn't match")
     989           0 :            (re-search-forward "^bzr is version" nil t)
     990           0 :            (forward-line 1))
     991           0 :       (while (not (eobp))
     992             :         ;; Bzr 2.3.0 added this if there are shelves.  (Bug#8170)
     993           0 :         (unless (looking-at "[0-9]+ shel\\(f\\|ves\\) exists?\\.")
     994           0 :           (setq status-str
     995           0 :                 (buffer-substring-no-properties (point) (+ (point) 3)))
     996           0 :           (setq translated (cdr (assoc status-str translation)))
     997           0 :           (cond
     998           0 :            ((eq translated 'conflict)
     999             :             ;; For conflicts the file appears twice in the listing: once
    1000             :             ;; with the M flag and once with the C flag, so take care
    1001             :             ;; not to add it twice to `result'.  Ugly.
    1002           0 :             (let* ((file
    1003           0 :                     (buffer-substring-no-properties
    1004             :                      ;;For files with conflicts the format is:
    1005             :                      ;;C   Text conflict in FILENAME
    1006             :                      ;; Bah.
    1007           0 :                      (+ (point) 21) (line-end-position)))
    1008           0 :                    (entry (assoc file result)))
    1009           0 :               (when entry
    1010           0 :                 (setf (nth 1 entry) 'conflict))))
    1011           0 :            ((eq translated 'renamed)
    1012           0 :             (re-search-forward "R[ M]  \\(.*\\) => \\(.*\\)$" (line-end-position) t)
    1013           0 :             (let ((new-name (file-relative-name (match-string 2) relative-dir))
    1014           0 :                   (old-name (file-relative-name (match-string 1) relative-dir)))
    1015           0 :               (push (list new-name 'edited
    1016           0 :                           (vc-bzr-create-extra-fileinfo old-name)) result)))
    1017             :            ;; do nothing for non existent files
    1018           0 :            ((eq translated 'not-found))
    1019             :            (t
    1020           0 :             (push (list (file-relative-name
    1021           0 :                          (buffer-substring-no-properties
    1022           0 :                           (+ (point) 4)
    1023           0 :                           (line-end-position)) relative-dir)
    1024           0 :                         translated) result))))
    1025           0 :         (forward-line))
    1026           0 :       (funcall update-function result)))
    1027             : 
    1028             : (defun vc-bzr-dir-status-files (dir files update-function)
    1029             :   "Return a list of conses (file . state) for DIR."
    1030           0 :   (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
    1031           0 :   (vc-run-delayed
    1032           0 :    (vc-bzr-after-dir-status update-function
    1033             :                             ;; "bzr status" results are relative to
    1034             :                             ;; the bzr root directory, NOT to the
    1035             :                             ;; directory "bzr status" was invoked in.
    1036             :                             ;; Ugh.
    1037             :                             ;; We pass the relative directory here so
    1038             :                             ;; that `vc-bzr-after-dir-status' can
    1039             :                             ;; frob the results accordingly.
    1040           0 :                             (file-relative-name dir (vc-bzr-root dir)))))
    1041             : 
    1042             : (defvar vc-bzr-shelve-map
    1043             :   (let ((map (make-sparse-keymap)))
    1044             :     ;; Turn off vc-dir marking
    1045             :     (define-key map [mouse-2] 'ignore)
    1046             : 
    1047             :     (define-key map [down-mouse-3] 'vc-bzr-shelve-menu)
    1048             :     (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point)
    1049             :     (define-key map "=" 'vc-bzr-shelve-show-at-point)
    1050             :     (define-key map "\C-m" 'vc-bzr-shelve-show-at-point)
    1051             :     (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point)
    1052             :     (define-key map "P" 'vc-bzr-shelve-apply-at-point)
    1053             :     (define-key map "S" 'vc-bzr-shelve-snapshot)
    1054             :     map))
    1055             : 
    1056             : (defvar vc-bzr-shelve-menu-map
    1057             :   (let ((map (make-sparse-keymap "Bzr Shelve")))
    1058             :     (define-key map [de]
    1059             :       '(menu-item "Delete Shelf" vc-bzr-shelve-delete-at-point
    1060             :                   :help "Delete the current shelf"))
    1061             :     (define-key map [ap]
    1062             :       '(menu-item "Apply and Keep Shelf" vc-bzr-shelve-apply-and-keep-at-point
    1063             :                   :help "Apply the current shelf and keep it"))
    1064             :     (define-key map [po]
    1065             :       '(menu-item "Apply and Remove Shelf (Pop)" vc-bzr-shelve-apply-at-point
    1066             :                   :help "Apply the current shelf and remove it"))
    1067             :     (define-key map [sh]
    1068             :       '(menu-item "Show Shelve" vc-bzr-shelve-show-at-point
    1069             :                   :help "Show the contents of the current shelve"))
    1070             :     map))
    1071             : 
    1072             : (defvar vc-bzr-extra-menu-map
    1073             :   (let ((map (make-sparse-keymap)))
    1074             :     (define-key map [bzr-sn]
    1075             :       '(menu-item "Shelve a Snapshot" vc-bzr-shelve-snapshot
    1076             :                   :help "Shelve the current state of the tree and keep the current state"))
    1077             :     (define-key map [bzr-sh]
    1078             :       '(menu-item "Shelve..." vc-bzr-shelve
    1079             :                   :help "Shelve changes"))
    1080             :     map))
    1081             : 
    1082           0 : (defun vc-bzr-extra-menu () vc-bzr-extra-menu-map)
    1083             : 
    1084           0 : (defun vc-bzr-extra-status-menu () vc-bzr-extra-menu-map)
    1085             : 
    1086             : (defun vc-bzr-dir-extra-headers (dir)
    1087           0 :   (let*
    1088           0 :       ((str (with-temp-buffer
    1089           0 :               (vc-bzr-command "info" t 0 dir)
    1090           0 :               (buffer-string)))
    1091           0 :        (shelve (vc-bzr-shelve-list))
    1092             :        (shelve-help-echo "Use M-x vc-bzr-shelve to create shelves")
    1093           0 :        (root-dir (vc-bzr-root dir))
    1094             :        (pending-merge
    1095             :         ;; FIXME: looking for .bzr/checkout/merge-hashes is not a
    1096             :         ;; reliable method to detect pending merges, disable this
    1097             :         ;; until a proper solution is implemented.
    1098           0 :         (and nil
    1099           0 :          (file-exists-p
    1100           0 :          (expand-file-name ".bzr/checkout/merge-hashes" root-dir))))
    1101             :        (pending-merge-help-echo
    1102           0 :         (format "A merge has been performed.\nA commit from the top-level directory (%s)\nis required before being able to check in anything else" root-dir))
    1103             :        (light-checkout
    1104           0 :         (when (string-match ".+light checkout root: \\(.+\\)$" str)
    1105           0 :           (match-string 1 str)))
    1106             :        (light-checkout-branch
    1107           0 :         (when light-checkout
    1108           0 :           (when (string-match ".+checkout of branch: \\(.+\\)$" str)
    1109           0 :             (match-string 1 str)))))
    1110           0 :     (concat
    1111           0 :      (propertize "Parent branch      : " 'face 'font-lock-type-face)
    1112           0 :      (propertize
    1113           0 :       (if (string-match "parent branch: \\(.+\\)$" str)
    1114           0 :           (match-string 1 str)
    1115           0 :         "None")
    1116           0 :        'face 'font-lock-variable-name-face)
    1117             :      "\n"
    1118           0 :       (when light-checkout
    1119           0 :         (concat
    1120           0 :          (propertize "Light checkout root: " 'face 'font-lock-type-face)
    1121           0 :          (propertize light-checkout 'face 'font-lock-variable-name-face)
    1122           0 :          "\n"))
    1123           0 :       (when light-checkout-branch
    1124           0 :         (concat
    1125           0 :          (propertize "Checkout of branch : " 'face 'font-lock-type-face)
    1126           0 :          (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
    1127           0 :          "\n"))
    1128           0 :       (when pending-merge
    1129           0 :         (concat
    1130           0 :          (propertize "Warning            : " 'face 'font-lock-warning-face
    1131           0 :                      'help-echo pending-merge-help-echo)
    1132           0 :          (propertize "Pending merges, commit recommended before any other action"
    1133           0 :                      'help-echo pending-merge-help-echo
    1134           0 :                      'face 'font-lock-warning-face)
    1135           0 :          "\n"))
    1136           0 :       (if shelve
    1137           0 :           (concat
    1138           0 :            (propertize "Shelves            :\n" 'face 'font-lock-type-face
    1139           0 :                        'help-echo shelve-help-echo)
    1140           0 :            (mapconcat
    1141             :             (lambda (x)
    1142           0 :               (propertize x
    1143             :                           'face 'font-lock-variable-name-face
    1144             :                           'mouse-face 'highlight
    1145             :                           'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf"
    1146           0 :                           'keymap vc-bzr-shelve-map))
    1147           0 :             shelve "\n"))
    1148           0 :         (concat
    1149           0 :          (propertize "Shelves            : " 'face 'font-lock-type-face
    1150           0 :                      'help-echo shelve-help-echo)
    1151           0 :          (propertize "No shelved changes"
    1152           0 :                      'help-echo shelve-help-echo
    1153           0 :                      'face 'font-lock-variable-name-face))))))
    1154             : 
    1155             : ;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher.
    1156             : (declare-function vc-resynch-buffer "vc-dispatcher"
    1157             :                   (file &optional keep noquery reset-vc-info))
    1158             : 
    1159             : (defun vc-bzr-shelve (name)
    1160             :   "Shelve the changes of the selected files."
    1161             :   (interactive "sShelf name: ")
    1162           0 :   (let ((root (vc-bzr-root default-directory))
    1163           0 :         (fileset (vc-deduce-fileset)))
    1164           0 :     (when root
    1165           0 :       (vc-bzr-command "shelve" nil 0 (nth 1 fileset) "--all" "-m" name)
    1166           0 :       (vc-resynch-buffer root t t))))
    1167             : 
    1168             : (defun vc-bzr-shelve-show (name)
    1169             :   "Show the contents of shelve NAME."
    1170             :   (interactive "sShelve name: ")
    1171           0 :   (vc-setup-buffer "*vc-diff*")
    1172             :   ;; FIXME: how can you show the contents of a shelf?
    1173           0 :   (vc-bzr-command "unshelve" "*vc-diff*" 'async nil "--preview" name)
    1174           0 :   (set-buffer "*vc-diff*")
    1175           0 :   (diff-mode)
    1176           0 :   (setq buffer-read-only t)
    1177           0 :   (pop-to-buffer (current-buffer)))
    1178             : 
    1179             : (defun vc-bzr-shelve-apply (name)
    1180             :   "Apply shelve NAME and remove it afterwards."
    1181             :   (interactive "sApply (and remove) shelf: ")
    1182           0 :   (vc-bzr-command "unshelve" nil 0 nil "--apply" name)
    1183           0 :   (vc-resynch-buffer (vc-bzr-root default-directory) t t))
    1184             : 
    1185             : (defun vc-bzr-shelve-apply-and-keep (name)
    1186             :   "Apply shelve NAME and keep it afterwards."
    1187             :   (interactive "sApply (and keep) shelf: ")
    1188           0 :   (vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep" name)
    1189           0 :   (vc-resynch-buffer (vc-bzr-root default-directory) t t))
    1190             : 
    1191             : (defun vc-bzr-shelve-snapshot ()
    1192             :   "Create a stash with the current tree state."
    1193             :   (interactive)
    1194           0 :   (vc-bzr-command "shelve" nil 0 nil "--all" "-m"
    1195           0 :                   (format-time-string "Snapshot on %Y-%m-%d at %H:%M"))
    1196           0 :   (vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep")
    1197           0 :   (vc-resynch-buffer (vc-bzr-root default-directory) t t))
    1198             : 
    1199             : (defun vc-bzr-shelve-list ()
    1200           0 :   (with-temp-buffer
    1201           0 :     (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q")
    1202           0 :     (delete
    1203             :      ""
    1204           0 :      (split-string
    1205           0 :       (buffer-substring (point-min) (point-max))
    1206           0 :       "\n"))))
    1207             : 
    1208             : (defun vc-bzr-shelve-get-at-point (point)
    1209           0 :   (save-excursion
    1210           0 :     (goto-char point)
    1211           0 :     (beginning-of-line)
    1212           0 :     (if (looking-at "^ +\\([0-9]+\\):")
    1213           0 :         (match-string 1)
    1214           0 :       (error "Cannot find shelf at point"))))
    1215             : 
    1216             : ;; vc-bzr-shelve-delete-at-point must be called from a vc-dir buffer.
    1217             : (declare-function vc-dir-refresh "vc-dir" ())
    1218             : 
    1219             : (defun vc-bzr-shelve-delete-at-point ()
    1220             :   (interactive)
    1221           0 :   (let ((shelve (vc-bzr-shelve-get-at-point (point))))
    1222           0 :     (when (y-or-n-p (format "Remove shelf %s ? " shelve))
    1223           0 :       (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve)
    1224           0 :       (vc-dir-refresh))))
    1225             : 
    1226             : (defun vc-bzr-shelve-show-at-point ()
    1227             :   (interactive)
    1228           0 :   (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point))))
    1229             : 
    1230             : (defun vc-bzr-shelve-apply-at-point ()
    1231             :   (interactive)
    1232           0 :   (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point))))
    1233             : 
    1234             : (defun vc-bzr-shelve-apply-and-keep-at-point ()
    1235             :   (interactive)
    1236           0 :   (vc-bzr-shelve-apply-and-keep (vc-bzr-shelve-get-at-point (point))))
    1237             : 
    1238             : (defun vc-bzr-shelve-menu (e)
    1239             :   (interactive "e")
    1240           0 :   (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e)))
    1241             : 
    1242             : (defun vc-bzr-revision-table (files)
    1243           0 :   (let ((vc-bzr-revisions '())
    1244           0 :         (default-directory (file-name-directory (car files))))
    1245           0 :     (with-temp-buffer
    1246           0 :       (vc-bzr-command "log" t 0 files "--line")
    1247           0 :       (let ((start (point-min))
    1248           0 :             (loglines (buffer-substring-no-properties (point-min) (point-max))))
    1249           0 :         (while (string-match "^\\([0-9]+\\):" loglines)
    1250           0 :           (push (match-string 1 loglines) vc-bzr-revisions)
    1251           0 :           (setq start (+ start (match-end 0)))
    1252           0 :           (setq loglines (buffer-substring-no-properties start (point-max))))))
    1253           0 :     vc-bzr-revisions))
    1254             : 
    1255             : (defun vc-bzr-conflicted-files (dir)
    1256           0 :   (let ((default-directory (vc-bzr-root dir))
    1257             :         (files ()))
    1258           0 :     (with-temp-buffer
    1259           0 :       (vc-bzr-command "status" t 0 default-directory)
    1260           0 :       (goto-char (point-min))
    1261           0 :       (when (re-search-forward "^conflicts:\n" nil t)
    1262           0 :         (while (looking-at "  \\(?:Text conflict in \\(.*\\)\\|.*\\)\n")
    1263           0 :           (if (match-end 1)
    1264           0 :               (push (expand-file-name (match-string 1)) files))
    1265           0 :           (goto-char (match-end 0)))))
    1266           0 :     files))
    1267             : 
    1268             : ;;; Revision completion
    1269             : 
    1270             : (eval-and-compile
    1271             :   (defconst vc-bzr-revision-keywords
    1272             :     ;; bzr help revisionspec  | sed -ne 's/^\([a-z]*\):$/"\1"/p' | sort -u
    1273             :     '("ancestor" "annotate" "before" "branch" "date" "last" "mainline" "revid"
    1274             :       "revno" "submit" "tag")))
    1275             : 
    1276             : (defun vc-bzr-revision-completion-table (files)
    1277             :   ;; What about using `files'?!?  --Stef
    1278             :   (lambda (string pred action)
    1279           0 :     (cond
    1280           0 :      ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
    1281           0 :                     string)
    1282           0 :       (completion-table-with-context (substring string 0 (match-end 0))
    1283           0 :                                      (apply-partially
    1284             :                                       'completion-table-with-predicate
    1285             :                                       'completion-file-name-table
    1286           0 :                                       'file-directory-p t)
    1287           0 :                                      (substring string (match-end 0))
    1288           0 :                                      pred
    1289           0 :                                      action))
    1290           0 :      ((string-match "\\`\\(before\\):" string)
    1291           0 :       (completion-table-with-context (substring string 0 (match-end 0))
    1292           0 :                                      (vc-bzr-revision-completion-table files)
    1293           0 :                                      (substring string (match-end 0))
    1294           0 :                                      pred
    1295           0 :                                      action))
    1296           0 :      ((string-match "\\`\\(tag\\):" string)
    1297           0 :       (let ((prefix (substring string 0 (match-end 0)))
    1298           0 :             (tag (substring string (match-end 0)))
    1299             :             (table nil)
    1300             :             process-file-side-effects)
    1301           0 :         (with-temp-buffer
    1302             :           ;; "bzr-1.2 tags" is much faster with --show-ids.
    1303           0 :           (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
    1304             :           ;; The output is ambiguous, unless we assume that revids do not
    1305             :           ;; contain spaces.
    1306           0 :           (goto-char (point-min))
    1307           0 :           (while (re-search-forward "^\\(.*[^ \n]\\) +[^ \n]*$" nil t)
    1308           0 :             (push (match-string-no-properties 1) table)))
    1309           0 :         (completion-table-with-context prefix table tag pred action)))
    1310             : 
    1311           0 :      ((string-match "\\`annotate:" string)
    1312           0 :       (completion-table-with-context
    1313           0 :        (substring string 0 (match-end 0))
    1314           0 :        (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`")
    1315           0 :                         #'completion-file-name-table)
    1316           0 :        (substring string (match-end 0)) pred action))
    1317             : 
    1318           0 :      ((string-match "\\`date:" string)
    1319           0 :       (completion-table-with-context
    1320           0 :        (substring string 0 (match-end 0))
    1321             :        '("yesterday" "today" "tomorrow")
    1322           0 :        (substring string (match-end 0)) pred action))
    1323             : 
    1324           0 :      ((string-match "\\`\\([a-z]+\\):" string)
    1325             :       ;; no actual completion for the remaining keywords.
    1326           0 :       (completion-table-with-context (substring string 0 (match-end 0))
    1327           0 :                                      (if (member (match-string 1 string)
    1328           0 :                                                  vc-bzr-revision-keywords)
    1329             :                                          ;; If it's a valid keyword,
    1330             :                                          ;; use a non-empty table to
    1331             :                                          ;; indicate it.
    1332           0 :                                          '("") nil)
    1333           0 :                                      (substring string (match-end 0))
    1334           0 :                                      pred
    1335           0 :                                      action))
    1336             :      (t
    1337             :       ;; Could use completion-table-with-terminator, except that it
    1338             :       ;; currently doesn't work right w.r.t pcm and doesn't give
    1339             :       ;; the *Completions* output we want.
    1340           0 :       (complete-with-action action (eval-when-compile
    1341          12 :                                      (mapcar (lambda (s) (concat s ":"))
    1342           1 :                                              vc-bzr-revision-keywords))
    1343           0 :                             string pred)))))
    1344             : 
    1345             : (provide 'vc-bzr)
    1346             : 
    1347             : ;;; vc-bzr.el ends here

Generated by: LCOV version 1.12