← Back to branch summary

~bzr-pqm/bzr/bzr.dev

« back to all changes in this revision

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

  • Committer: Martin Pool
  • Date: 2005-07-22 22:37:53 UTC
  • Revision ID: mbp@sourcefrog.net-20050722223753-7dced4e32d3ce21d
- add the start of a test for inventory file-id matching

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