(describe-function-1): Don't print extra newline
[bpt/emacs.git] / lisp / vc-bzr.el
index e721cff..a965263 100644 (file)
@@ -52,7 +52,8 @@
 
 (eval-when-compile
   (require 'cl)
-  (require 'vc))                        ; for vc-exec-after
+  (require 'vc)  ;; for vc-exec-after
+  (require 'vc-dir))
 
 ;; Clear up the cache to force vc-call to check again and discover
 ;; new functions when we reload this file.
@@ -92,7 +93,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
          (list* "BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
                 "LC_MESSAGES=C"         ; Force English output
                 process-environment)))
-    (apply 'vc-do-command buffer okstatus vc-bzr-program
+    (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
            file-or-list bzr-command args)))
 
 
@@ -134,7 +135,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
       (when (consp prog)
        (setq args (cdr prog))
         (setq prog (car prog)))
-      (apply 'call-process prog file t nil args)
+      (apply 'process-file prog (file-relative-name file) t nil args)
       (buffer-substring (point-min) (+ (point-min) 40)))))
 
 (defun vc-bzr-state-heuristic (file)
@@ -213,7 +214,7 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
   (lexical-let*
       ((filename* (expand-file-name filename))
        (rootdir (vc-bzr-root filename*)))
-    (when rootdir 
+    (when rootdir
          (file-relative-name filename* rootdir))))
 
 (defun vc-bzr-status (file)
@@ -325,24 +326,24 @@ If any error occurred in running `bzr status', then return nil."
     ;; May break if they change their format.
     (if (file-exists-p branch-format-file)
         (with-temp-buffer
-          (insert-file-contents branch-format-file) 
+          (insert-file-contents branch-format-file)
           (goto-char (point-min))
           (cond
            ((or
              (looking-at "Bazaar-NG branch, format 0.0.4")
              (looking-at "Bazaar-NG branch format 5"))
             ;; count lines in .bzr/branch/revision-history
-            (insert-file-contents revhistory-file) 
+            (insert-file-contents revhistory-file)
             (number-to-string (count-lines (line-end-position) (point-max))))
            ((looking-at "Bazaar Branch Format 6 (bzr 0.15)")
             ;; revno is the first number in .bzr/branch/last-revision
-            (insert-file-contents lastrev-file) 
+            (insert-file-contents lastrev-file)
             (if (re-search-forward "[0-9]+" nil t)
                 (buffer-substring (match-beginning 0) (match-end 0))))))
       ;; fallback to calling "bzr revno"
       (lexical-let*
           ((result (vc-bzr-command-discarding-stderr
-                    vc-bzr-program "revno" file))
+                    vc-bzr-program "revno" (file-relative-name file)))
            (exitcode (car result))
            (output (cdr result)))
         (cond
@@ -403,8 +404,8 @@ REV non-nil gets an error."
   (if rev (error "Can't check in a specific revision with bzr"))
   (vc-bzr-command "commit" nil 0 files "-m" comment))
 
-(defun vc-bzr-find-version (file rev buffer)
-  "Fetch version REV of file FILE and put it into BUFFER."
+(defun vc-bzr-find-revision (file rev buffer)
+  "Fetch revision REV of file FILE and put it into BUFFER."
     (with-current-buffer buffer
       (if (and rev (stringp rev) (not (string= rev "")))
           (vc-bzr-command "cat" t 0 file "-r" rev)
@@ -423,10 +424,12 @@ REV non-nil gets an error."
 (defvar log-view-file-re)
 (defvar log-view-font-lock-keywords)
 (defvar log-view-current-tag-function)
+(defvar log-view-per-file-logs)
 
 (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
   (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
   (require 'add-log)
+  (set (make-local-variable 'log-view-per-file-logs) nil)
   (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)")
   (set (make-local-variable 'log-view-message-re)
        "^ *-+\n *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)")
@@ -468,7 +471,7 @@ REV non-nil gets an error."
   (let (case-fold-search)
     (if (re-search-forward
         ;; "revno:" can appear either at the beginning of a line, or indented.
-        (concat "^[ ]*-+\n[ ]*revno: " 
+        (concat "^[ ]*-+\n[ ]*revno: "
                 ;; The revision can contain ".", quote it so that it
                 ;; does not interfere with regexp matching.
                 (regexp-quote revision) "$") nil t)
@@ -479,14 +482,14 @@ REV non-nil gets an error."
   "VC bzr backend for diff."
   ;; `bzr diff' exits with code 1 if diff is non-empty.
   (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 'async files
-         "--diff-options" (mapconcat 'identity 
+         "--diff-options" (mapconcat 'identity
                                      (vc-diff-switches-list bzr)
                                     " ")
          ;; This `when' is just an optimization because bzr-1.2 is *much*
          ;; faster when the revision argument is not given.
          (when (or rev1 rev2)
            (list "-r" (format "%s..%s"
-                              (or rev1 "revno:-1") 
+                              (or rev1 "revno:-1")
                               (or rev2 ""))))))
 
 
@@ -534,23 +537,25 @@ property containing author and date information."
         (replace-match "")
         (insert tag " |")))))
 
+(declare-function vc-annotate-convert-time "vc-annotate" (time))
+
 (defun vc-bzr-annotate-time ()
   (when (re-search-forward "^ *[0-9.]+ +|" nil t)
     (let ((prop (get-text-property (line-beginning-position) 'help-echo)))
       (string-match "[0-9]+\\'" prop)
+      (let ((str (match-string-no-properties 0 prop)))
       (vc-annotate-convert-time
        (encode-time 0 0 0
-                    (string-to-number (substring (match-string 0 prop) 6 8))
-                    (string-to-number (substring (match-string 0 prop) 4 6))
-                    (string-to-number (substring (match-string 0 prop) 0 4))
-                    )))))
+                      (string-to-number (substring str 6 8))
+                      (string-to-number (substring str 4 6))
+                      (string-to-number (substring str 0 4))))))))
 
 (defun vc-bzr-annotate-extract-revision-at-line ()
   "Return revision for current line of annoation buffer, or nil.
 Return nil if current line isn't annotated."
   (save-excursion
     (beginning-of-line)
-    (if (looking-at " *\\([0-9.]+\\) | ")
+    (if (looking-at " *\\([0-9.]+\\) *| ")
         (match-string-no-properties 1))))
 
 (defun vc-bzr-command-discarding-stderr (command &rest args)
@@ -561,52 +566,83 @@ containing whatever the process sent to its standard output
 stream.  Standard error output is discarded."
   (with-temp-buffer
     (cons
-     (apply #'call-process command nil (list (current-buffer) nil) nil args)
+     (apply #'process-file command nil (list (current-buffer) nil) nil args)
      (buffer-substring (point-min) (point-max)))))
 
 (defun vc-bzr-prettify-state-info (file)
   "Bzr-specific version of `vc-prettify-state-info'."
   (if (eq 'edited (vc-state file))
-        (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state) 
+        (concat "(" (symbol-name (or (vc-file-getprop file 'vc-bzr-state)
                                      'edited)) ")")
     ;; else fall back to default vc.el representation
     (vc-default-prettify-state-info 'Bzr file)))
 
-;; XXX: this needs testing, it's probably incomplete. 
+(defstruct (vc-bzr-extra-fileinfo
+            (:copier nil)
+            (:constructor vc-bzr-create-extra-fileinfo (extra-name))
+            (:conc-name vc-bzr-extra-fileinfo->))
+  extra-name)         ;; original name for rename targets, new name for
+
+(defun vc-bzr-status-printer (info)
+  "Pretty-printer for the vc-dir-fileinfo structure."
+  (let ((extra (vc-dir-fileinfo->extra info)))
+    (vc-default-status-printer 'Bzr info)
+    (when extra
+      (insert (propertize
+              (format "   (renamed from %s)"
+                      (vc-bzr-extra-fileinfo->extra-name extra))
+              'face 'font-lock-comment-face)))))
+
+;; FIXME: this needs testing, it's probably incomplete.
 (defun vc-bzr-after-dir-status (update-function)
   (let ((status-str nil)
-       (file nil)
-       (translation '(("+N" . added)
-                      ("-D" . removed)
-                      (" M" . edited)
-                      ;; XXX: what about ignored files?
-                      (" D" . missing)
-                      ("C " . conflict)
-                      ("? " . unregistered)))
+       (translation '(("+N " . added)
+                      ("-D " . removed)
+                      (" M " . edited) ;; file text modified
+                      ("  *" . edited) ;; execute bit changed
+                      (" M*" . edited) ;; text modified + execute bit changed
+                      ;; FIXME: what about ignored files?
+                      (" D " . missing)
+                       ;; For conflicts, should we list the .THIS/.BASE/.OTHER?
+                      ("C  " . conflict)
+                      ("?  " . unregistered)
+                      ("?  " . unregistered)
+                      ;; No such state, but we need to distinguish this case.
+                      ("R  " . renamed)
+                       ;; Ignore "P " and "P." for pending patches.
+                       ))
        (translated nil)
        (result nil))
       (goto-char (point-min))
       (while (not (eobp))
        (setq status-str
-             (buffer-substring-no-properties (point) (+ (point) 2)))
+             (buffer-substring-no-properties (point) (+ (point) 3)))
        (setq translated (cdr (assoc status-str translation)))
-       ;; For conflicts the file appears twice in the listing: once
-       ;; with the M flag and once with the C flag, so take care not
-       ;; to add it twice to `result'.  Ugly.
-       (if (eq translated 'conflict)
-           (let* ((file
-                   (buffer-substring-no-properties
-                    ;;For files with conflicts the format is:
-                    ;;C   Text conflict in FILENAME
-                    ;; Bah.
-                    (+ (point) 21) (line-end-position)))
-                  (entry (assoc file result)))
-             (when entry
-               (setf (nth 1 entry) 'conflict)))
+       (cond
+        ((eq translated 'conflict)
+         ;; For conflicts the file appears twice in the listing: once
+         ;; with the M flag and once with the C flag, so take care
+         ;; not to add it twice to `result'.  Ugly.
+         (let* ((file
+                 (buffer-substring-no-properties
+                  ;;For files with conflicts the format is:
+                  ;;C   Text conflict in FILENAME
+                  ;; Bah.
+                  (+ (point) 21) (line-end-position)))
+                (entry (assoc file result)))
+           (when entry
+             (setf (nth 1 entry) 'conflict))))
+        ((eq translated 'renamed)
+         (re-search-forward "R   \\(.*\\) => \\(.*\\)$" (line-end-position) t)
+         (let ((new-name (match-string 2))
+               (old-name (match-string 1)))
+           (push (list new-name 'edited
+                     (vc-bzr-create-extra-fileinfo old-name)) result)))
+        (t
          (push (list (buffer-substring-no-properties
                       (+ (point) 4)
-                      (line-end-position)) 
-                     translated) result))
+                      (line-end-position))
+                     translated) result)))
        (forward-line))
       (funcall update-function result)))
 
@@ -626,6 +662,8 @@ stream.  Standard error output is discarded."
        ((string-match "\\`\\(ancestor\\|branch\\|\\(revno:\\)?[-0-9]+:\\):"
                       string)
         (completion-table-with-context (substring string 0 (match-end 0))
+                                       ;; FIXME: only allow directories.
+                                       ;; FIXME: don't allow envvars.
                                        'read-file-name-internal
                                        (substring string (match-end 0))
                                        ;; Dropping `pred'.   Maybe we should
@@ -645,7 +683,7 @@ stream.  Standard error output is discarded."
               (table nil))
           (with-temp-buffer
             ;; "bzr-1.2 tags" is much faster with --show-ids.
-            (call-process vc-bzr-program nil '(t) nil "tags" "--show-ids")
+            (process-file vc-bzr-program nil '(t) nil "tags" "--show-ids")
             ;; The output is ambiguous, unless we assume that revids do not
             ;; contain spaces.
             (goto-char (point-min))
@@ -656,7 +694,14 @@ stream.  Standard error output is discarded."
        ((string-match "\\`\\(revid\\):" string)
         ;; FIXME: How can I get a list of revision ids?
         )
+       ((eq (car-safe action) 'boundaries)
+        (list* 'boundaries
+               (string-match "[^:]*\\'" string)
+               (string-match ":" (cdr action))))
        (t
+        ;; Could use completion-table-with-terminator, except that it
+        ;; currently doesn't work right w.r.t pcm and doesn't give
+        ;; the *Completions* output we want.
         (complete-with-action action '("revno:" "revid:" "last:" "before:"
                                        "tag:" "date:" "ancestor:" "branch:"
                                        "submit:")