emacs: lisp/vc-bzr.el comparison

comparison lisp/vc-bzr.el @ 82491:962fb740e73f

Merge from emacs--rel--22 Patches applied: * emacs--rel--22 (patch 93-96) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 245) - Update from CVS Revision: emacs@sv.gnu.org/emacs--devo--0--patch-856

author	Miles Bader <miles@gnu.org>
date	Tue, 21 Aug 2007 04:51:30 +0000
parents	e5a68f18fcb9 8f9613d80af0
children	13fc3289f099 aaccdab0ee26

comparison

equal deleted inserted replaced

-:458dcdfc3e27
+:962fb740e73f
 ;; new functions when we reload this file.
 (put 'Bzr 'vc-functions nil)
 (defgroup vc-bzr nil
 "VC bzr backend."
-;;   :version "22"
+:version "22.2"
 :group 'vc)
 (defcustom vc-bzr-program "bzr"
 "Name of the bzr command (excluding any arguments)."
 :group 'vc-bzr
 only parsed if it contains the string `#bazaar dirstate flat
 format 3' in the first line.
 If the `checkout/dirstate' file cannot be parsed, fall back to
 running `vc-bzr-state'."
-(condition-case nil
+(lexical-let ((root (vc-bzr-root file)))
-(lexical-let ((root (vc-bzr-root file)))
+(when root    ; Short cut.
-(and root ; Short cut.
+;; This looks at internal files.  May break if they change
-;; This looks at internal files.  May break if they change
+;; their format.
-;; their format.
+(lexical-let ((dirstate (expand-file-name vc-bzr-admin-dirstate root)))
-(lexical-let
+(if (not (file-readable-p dirstate))
-((dirstate-file (expand-file-name vc-bzr-admin-dirstate root)))
+(vc-bzr-state file)         ; Expensive.
-(if (file-exists-p dirstate-file)
+(with-temp-buffer
-(with-temp-buffer
+(insert-file-contents dirstate)
-(insert-file-contents dirstate-file)
+(goto-char (point-min))
-(goto-char (point-min))
+(if (not (looking-at "#bazaar dirstate flat format 3"))
-(when (looking-at "#bazaar dirstate flat format 3")
+(vc-bzr-state file)     ; Some other unknown format?
 (let* ((relfile (file-relative-name file root))
 (reldir (file-name-directory relfile)))
 (re-search-forward
 (concat "^\0"
 (if reldir (regexp-quote (directory-file-name reldir)))
 "\0"
 (regexp-quote (file-name-nondirectory relfile))
 "\0")
-nil t))))
+nil t)))))))))
-t))
-(vc-bzr-state file)))  ; Expensive.
-(file-error nil))) ; vc-bzr-program not found
-(defun vc-bzr-buffer-nonblank-p (&optional buffer)
-"Return non-nil if BUFFER contains any non-blank characters."
-(or (> (buffer-size buffer) 0)
-(save-excursion
-(set-buffer (or buffer (current-buffer)))
-(goto-char (point-min))
-(re-search-forward "[^ \t\n]" (point-max) t))))
 (defconst vc-bzr-state-words
 "added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
 "Regexp matching file status words as reported in `bzr' output.")
 ;; FIXME:  Also get this in a non-registered sub-directory.
 ;; It already works for me. -- Riccardo
 (defun vc-bzr-status (file)
 "Return FILE status according to Bzr.
 Return value is a cons (STATUS . WARNING), where WARNING is a
-string or nil, and STATUS is one of the symbols: 'added,
+string or nil, and STATUS is one of the symbols: `added',
-'ignored, 'kindchange, 'modified, 'removed, 'renamed, 'unknown,
+`ignored', `kindchanged', `modified', `removed', `renamed', `unknown',
 which directly correspond to `bzr status' output, or 'unchanged
 for files whose copy in the working tree is identical to the one
 in the branch repository, or nil for files that are not
 registered with Bzr.
 If any error occurred in running `bzr status', then return nil."
-(condition-case nil
 (with-temp-buffer
-(let ((ret (vc-bzr-command "status" t 0 file))
+(let ((ret (condition-case nil
-(status 'unchanged))
+(vc-bzr-command "status" t 0 file)
-;; the only secure status indication in `bzr status' output
+(file-error nil)))     ; vc-bzr-program not found.
-;; is a couple of lines following the pattern::
+(status 'unchanged))
-;;   | <status>:
+;; the only secure status indication in `bzr status' output
-;;   |   <file name>
+;; is a couple of lines following the pattern::
-;; if the file is up-to-date, we get no status report from `bzr',
+;;   | <status>:
-;; so if the regexp search for the above pattern fails, we consider
+;;   |   <file name>
-;; the file to be up-to-date.
+;; if the file is up-to-date, we get no status report from `bzr',
-(goto-char (point-min))
+;; so if the regexp search for the above pattern fails, we consider
-(when
+;; the file to be up-to-date.
-(re-search-forward
+(goto-char (point-min))
-;; bzr prints paths relative to the repository root
+(when (re-search-forward
-(concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
+;; bzr prints paths relative to the repository root.
-(regexp-quote (vc-bzr-file-name-relative file))
+(concat "^\\(" vc-bzr-state-words "\\):[ \t\n]+"
-(if (file-directory-p file) "/?" "")
+(regexp-quote (vc-bzr-file-name-relative file))
-"[ \t\n]*$")
+(if (file-directory-p file) "/?" "")
-(point-max) t)
+"[ \t\n]*$")
-(let ((start (match-beginning 0))
+nil t)
-(end (match-end 0)))
+(let ((status (match-string 1)))
-(goto-char start)
+;; Erase the status text that matched.
+(delete-region (match-beginning 0) (match-end 0))
 (setq status
-(cond
+(and (equal ret 0) ; Seems redundant.  --Stef
-((not (equal ret 0)) nil)
+(intern (replace-regexp-in-string " " ""
-((looking-at "added") 'added)
+status))))))
-((looking-at "kind changed") 'kindchange)
+(when status
-((looking-at "renamed") 'renamed)
+(goto-char (point-min))
-((looking-at "modified") 'modified)
+(skip-chars-forward " \n\t") ;Throw away spaces.
-((looking-at "removed") 'removed)
+(cons status
-((looking-at "ignored") 'ignored)
+;; "bzr" will output warnings and informational messages to
-((looking-at "unknown") 'unknown)))
+;; stderr; due to Emacs' `vc-do-command' (and, it seems,
-;; erase the status text that matched
+;; `start-process' itself) limitations, we cannot catch stderr
-(delete-region start end)))
+;; and stdout into different buffers.  So, if there's anything
-(if status
+;; left in the buffer after removing the above status
-(cons status
+;; keywords, let us just presume that any other message from
-;; "bzr" will output warnings and informational messages to
+;; "bzr" is a user warning, and display it.
-;; stderr; due to Emacs' `vc-do-command' (and, it seems,
+(unless (eobp) (buffer-substring (point) (point-max))))))))
-;; `start-process' itself) limitations, we cannot catch stderr
-;; and stdout into different buffers.  So, if there's anything
-;; left in the buffer after removing the above status
-;; keywords, let us just presume that any other message from
-;; "bzr" is a user warning, and display it.
-(if (vc-bzr-buffer-nonblank-p)
-(buffer-substring (point-min) (point-max)))))))
-(file-error nil))) ; vc-bzr-program not found
 (defun vc-bzr-state (file)
 (lexical-let ((result (vc-bzr-status file)))
 (when (consp result)
 (if (cdr result)
 (message "Warnings in `bzr' output: %s" (cdr result)))
 (cdr (assq (car result)
 '((added . edited)
-(kindchange . edited)
+(kindchanged . edited)
 (renamed . edited)
 (modified . edited)
 (removed . edited)
 (ignored . nil)
 (unknown . nil)
 (lastrev-file (concat rootdir "/" "branch/last-revision")))
 ;; Count lines in .bzr/branch/revision-history to avoid forking a
 ;; bzr process.  This looks at internal files.  May break if they
 ;; change their format.
 (if (file-exists-p branch-format-file)
 (with-temp-buffer
 (insert-file-contents branch-format-file)
 (goto-char (point-min))
 (cond
 ((or
 (looking-at "Bazaar-NG branch, format 0.0.4")
 (looking-at "Bazaar-NG branch format 5"))
 ;; count lines in .bzr/branch/revision-history
 (insert-file-contents revhistory-file)
 (number-to-string (count-lines (line-end-position) (point-max))))
 ((looking-at "Bazaar Branch Format 6 (bzr 0.15)")
 ;; revno is the first number in .bzr/branch/last-revision
 (insert-file-contents lastrev-file)
 (goto-char (line-end-position))
 EDITABLE is ignored."
 (unless destfile
 (setq destfile (vc-version-backup-file-name file rev)))
 (let ((coding-system-for-read 'binary)
 (coding-system-for-write 'binary))
 (with-temp-file destfile
 (if rev
 (vc-bzr-command "cat" t 0 file "-r" rev)
 (vc-bzr-command "cat" t 0 file)))))
 (defun vc-bzr-revert (file &optional contents-done)
 (unless contents-done
 (with-temp-buffer (vc-bzr-command "revert" t 0 file))))
 (defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22
 "Get bzr change log for FILES into specified BUFFER."
 ;; Fixme: This might need the locale fixing up if things like `revno'
 ;; got localized, but certainly it shouldn't use LC_ALL=C.
-;; NB.  Can't be async -- see `vc-bzr-post-command-function'.
 (vc-bzr-command "log" buffer 0 files)
 ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for
 ;; the buffer, or at least set the regexps right.
 (unless (fboundp 'vc-default-log-view-mode)
 (add-hook 'log-view-mode-hook 'vc-bzr-log-view-mode)))
 (let ((working (vc-workfile-version (if (consp files) (car files) files))))
 (if (and (equal rev1 working) (not rev2))
 (setq rev1 nil))
 (if (and (not rev1) rev2)
 (setq rev1 working))
-;; NB.  Can't be async -- see `vc-bzr-post-command-function'.
 ;; bzr diff produces condition code 1 for some reason.
 (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files
 "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
 " ")
 (when rev1
 (replace-match "")
 (insert tag " |")))))
 ;; Definition from Emacs 22
 (unless (fboundp 'vc-annotate-convert-time)
 (defun vc-annotate-convert-time (time)
 "Convert a time value to a floating-point number of days.
 The argument TIME is a list as returned by `current-time' or
 `encode-time', only the first two elements of that list are considered."
 (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)))
 (defun vc-bzr-annotate-time ()
 (when (re-search-forward "^ *[0-9]+ |" nil t)
 (let ((prop (get-text-property (line-beginning-position) 'help-echo)))
 (string-match "[0-9]+\\'" prop)
 ((looking-at "^added")
 (setq current-vc-state 'edited)
 (setq current-bzr-state 'added))
 ((looking-at "^kind changed")
 (setq current-vc-state 'edited)
-(setq current-bzr-state 'kindchange))
+(setq current-bzr-state 'kindchanged))
 ((looking-at "^modified")
 (setq current-vc-state 'edited)
 (setq current-bzr-state 'modified))
 ((looking-at "^renamed")
 (setq current-vc-state 'edited)
 (if bzr-state
 (concat "(" (symbol-name bzr-state) ")")
 ;; else fall back to default vc representation
 (vc-default-dired-state-info 'Bzr file)))))
-;; In case of just `(load "vc-bzr")', but that's probably the wrong
-;; way to do it.
-(add-to-list 'vc-handled-backends 'Bzr)
 (eval-after-load "vc"
 '(add-to-list 'vc-directory-exclusion-list vc-bzr-admin-dirname t))
-(defconst vc-bzr-unload-hook
-(lambda ()
-(setq vc-handled-backends (delq 'Bzr vc-handled-backends))
-(remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
 (provide 'vc-bzr)
 ;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
 ;;; vc-bzr.el ends here

Mercurial > emacs

comparison lisp/vc-bzr.el @ 82491:962fb740e73f