← 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: Ian Clatworthy
  • Date: 2009-12-03 23:21:16 UTC
  • mfrom: (4852.4.1 RCStoVCS)
  • mto: This revision was merged to the branch mainline in revision 4860.
  • Revision ID: ian.clatworthy@canonical.com-20091203232116-f8igfvc6muqrn4yx
Revision Control -> Version Control in docs

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