1
;;; bzr.el -- version control commands for Bazaar-NG.
2
;;; Copyright 2005 Luke Gorrie <luke@member.fsf.org>
4
;;; bzr.el is free software distributed under the terms of the GNU
5
;;; General Public Licence, version 2. For details see the file
6
;;; COPYING in the GNU Emacs distribution.
8
;;; This is MAJOR copy & paste job from darcs.el
11
(unless (fboundp 'define-minor-mode)
13
(defalias 'define-minor-mode 'easy-mmode-define-minor-mode))
14
(when (featurep 'xemacs)
19
(defvar bzr-command-prefix "\C-cb"
20
;; This default value breaks the Emacs rules and uses a sequence
21
;; reserved for the user's own custom bindings. That's not good but
22
;; I can't think of a decent standard one. -luke (14/Mar/2005)
23
"Prefix sequence for bzr-mode commands.")
25
(defvar bzr-command "bzr"
26
"*Shell command to execute bzr.")
28
(defvar bzr-buffer "*bzr-command*"
29
"Buffer for user-visible bzr command output.")
33
(define-minor-mode bzr-mode
37
;; Coax define-minor-mode into creating a keymap.
38
;; We'll fill it in manually though because define-minor-mode seems
39
;; hopeless for changing bindings without restarting Emacs.
40
`((,bzr-command-prefix . fake)))
42
(defvar bzr-mode-commands-map nil
43
"Keymap for bzr-mode commands.
44
This map is bound to a prefix sequence in `bzr-mode-map'.")
46
(defconst bzr-command-keys '(("l" bzr-log)
50
"Keys to bind in `bzr-mode-commands-map'.")
52
(defun bzr-init-command-keymap ()
53
"Bind the bzr-mode keys.
54
This command can be called interactively to redefine the keys from
57
(setq bzr-mode-commands-map (make-sparse-keymap))
58
(dolist (spec bzr-command-keys)
59
(define-key bzr-mode-commands-map (car spec) (cadr spec)))
60
(define-key bzr-mode-map bzr-command-prefix bzr-mode-commands-map))
62
(bzr-init-command-keymap)
68
"Run \"bzr log\" in the repository top-level."
73
"Run \"bzr diff\" in the repository top-level."
76
(bzr-run-command (bzr-command "diff") 'diff-mode))
79
"Run \"bzr diff\" in the repository top-level."
83
(defun bzr-commit (message)
84
"Run \"bzr diff\" in the repository top-level."
85
(interactive "sCommit message: ")
87
(bzr "commit -m %s" (shell-quote-argument message)))
91
(defun bzr (format &rest args)
92
(bzr-run-command (apply #'bzr-command format args)))
94
(defun bzr-command (format &rest args)
95
(concat bzr-command " " (apply #'format format args)))
97
(defun bzr-run-command (command &optional pre-view-hook)
98
"Run COMMAND at the top-level and view the result in another window.
99
PRE-VIEW-HOOK is an optional function to call before entering
100
view-mode. This is useful to set the major-mode of the result buffer,
101
because if you did it afterwards then it would zap view-mode."
103
(let ((toplevel (bzr-toplevel)))
104
(with-current-buffer (get-buffer-create bzr-buffer)
105
;; prevent `shell-command' from printing output in a message
106
(let ((max-mini-window-height 0))
107
(let ((default-directory toplevel))
108
(shell-command command t)))
109
(goto-char (point-min))
111
(funcall pre-view-hook))))
112
(if (zerop (buffer-size (get-buffer bzr-buffer)))
113
(message "(bzr command finished with no output.)")
114
(view-buffer-other-window bzr-buffer)
115
;; Bury the buffer when dismissed.
116
(with-current-buffer (get-buffer bzr-buffer)
117
(setq view-exit-action #'bury-buffer))))
119
(defun bzr-current-file ()
120
(or (buffer-file-name)
121
(error "Don't know what file to use!")))
123
(defun bzr-cleanup (&optional buffer-name)
124
"Cleanup before executing a command.
125
BUFFER-NAME is the command's output buffer."
126
(let ((name (or buffer-name bzr-buffer)))
127
(when (get-buffer bzr-buffer)
128
(kill-buffer bzr-buffer))))
130
(defun bzr-toplevel ()
131
"Return the top-level directory of the repository."
132
(let ((dir (bzr-find-repository)))
134
(file-name-directory dir)
135
(error "Can't find bzr repository top-level."))))
137
(defun bzr-find-repository (&optional start-directory)
138
"Return the enclosing \".bzr\" directory, or nil if there isn't one."
139
(when (and (buffer-file-name)
140
(file-directory-p (file-name-directory (buffer-file-name))))
141
(let ((dir (or start-directory
143
(error "No start directory given."))))
144
(or (car (directory-files dir t "^\\.bzr$"))
145
(let ((next-dir (file-name-directory (directory-file-name dir))))
146
(unless (equal dir next-dir)
147
(bzr-find-repository next-dir)))))))
151
;;; Automaticaly enter bzr-mode when we open a file that's under bzr
152
;;; control, i.e. if the .bzr directory can be found.
154
(defun bzr-find-file-hook ()
155
"Enable bzr-mode if the file is inside a bzr repository."
156
;; Note: This function is called for every file that Emacs opens so
157
;; it mustn't make any mistakes.
158
(when (bzr-find-repository) (bzr-mode 1)))
160
(add-hook 'find-file-hooks 'bzr-find-file-hook)
added
removed
contrib/emacs/bzr-mode.el
