/brz/remove-bazaar

To get this branch, use:
bzr branch http://gegoxaren.bato24.eu/bzr/brz/remove-bazaar

« back to all changes in this revision

Viewing changes to contrib/emacs/bzr-mode.el

  • Committer: Martin Pool
  • Date: 2005-08-24 08:59:32 UTC
  • Revision ID: mbp@sourcefrog.net-20050824085932-c61f1f1f1c930e13
- Add a simple UIFactory 

  The idea of this is to let a client of bzrlib set some 
  policy about how output is displayed.

  In this revision all that's done is that progress bars
  are constructed by a policy established by the application
  rather than being randomly constructed in the library 
  or passed down the calls.  This avoids progress bars
  popping up while running the test suite and cleans up
  some code.

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/emacs/bzr-mode.el
 
1
;;; bzr.el -- version control commands for Bazaar-NG.
 
2
;;; Copyright 2005  Luke Gorrie <luke@member.fsf.org>
 
3
;;;
 
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.
 
7
;;;
 
8
;;; This is MAJOR copy & paste job from darcs.el
 
9
 
 
10
(eval-when-compile
 
11
  (unless (fboundp 'define-minor-mode)
 
12
    (require 'easy-mmode)
 
13
    (defalias 'define-minor-mode 'easy-mmode-define-minor-mode))
 
14
  (when (featurep 'xemacs)
 
15
    (require 'cl)))
 
16
 
 
17
;;;; Configurables
 
18
 
 
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.")
 
24
 
 
25
(defvar bzr-command "bzr"
 
26
  "*Shell command to execute bzr.")
 
27
 
 
28
(defvar bzr-buffer "*bzr-command*"
 
29
  "Buffer for user-visible bzr command output.")
 
30
 
 
31
;;;; Minor-mode
 
32
 
 
33
(define-minor-mode bzr-mode
 
34
  "\\{bzr-mode-map}"
 
35
  nil
 
36
  " bzr"
 
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)))
 
41
 
 
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'.")
 
45
 
 
46
(defconst bzr-command-keys '(("l" bzr-log)
 
47
                             ("d" bzr-diff)
 
48
                             ("s" bzr-status)
 
49
                             ("c" bzr-commit))
 
50
  "Keys to bind in `bzr-mode-commands-map'.")
 
51
 
 
52
(defun bzr-init-command-keymap ()
 
53
  "Bind the bzr-mode keys.
 
54
This command can be called interactively to redefine the keys from
 
55
`bzr-commands-keys'."
 
56
  (interactive)
 
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))
 
61
 
 
62
(bzr-init-command-keymap)
 
63
 
 
64
 
 
65
;;;; Commands
 
66
 
 
67
(defun bzr-log ()
 
68
  "Run \"bzr log\" in the repository top-level."
 
69
  (interactive)
 
70
  (bzr "log"))
 
71
 
 
72
(defun bzr-diff ()
 
73
  "Run \"bzr diff\" in the repository top-level."
 
74
  (interactive)
 
75
  (save-some-buffers)
 
76
  (bzr-run-command (bzr-command "diff") 'diff-mode))
 
77
 
 
78
(defun bzr-status ()
 
79
  "Run \"bzr diff\" in the repository top-level."
 
80
  (interactive)
 
81
  (bzr "status"))
 
82
 
 
83
(defun bzr-commit (message)
 
84
  "Run \"bzr diff\" in the repository top-level."
 
85
  (interactive "sCommit message: ")
 
86
  (save-some-buffers)
 
87
  (bzr "commit -m %s" (shell-quote-argument message)))
 
88
 
 
89
;;;; Utilities
 
90
 
 
91
(defun bzr (format &rest args)
 
92
  (bzr-run-command (apply #'bzr-command format args)))
 
93
 
 
94
(defun bzr-command (format &rest args)
 
95
  (concat bzr-command " " (apply #'format format args)))
 
96
 
 
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."
 
102
  (bzr-cleanup)
 
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))
 
110
      (when pre-view-hook
 
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))))
 
118
 
 
119
(defun bzr-current-file ()
 
120
  (or (buffer-file-name)
 
121
      (error "Don't know what file to use!")))
 
122
 
 
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))))
 
129
 
 
130
(defun bzr-toplevel ()
 
131
  "Return the top-level directory of the repository."
 
132
  (let ((dir (bzr-find-repository)))
 
133
    (if dir
 
134
        (file-name-directory dir)
 
135
      (error "Can't find bzr repository top-level."))))
 
136
  
 
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
 
142
                   default-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)))))))
 
148
 
 
149
;;;; Hook setup
 
150
;;;
 
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.
 
153
 
 
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)))
 
159
 
 
160
(add-hook 'find-file-hooks 'bzr-find-file-hook)
 
161
 
 
162
(provide 'bzr)
 
163