Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mercurial.el @ 944:41ca6bf19735

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial skeleton for mercurial.el.
author Bryan O'Sullivan <bos@serpentine.com>
date Thu, 18 Aug 2005 12:27:57 -0800
parents
children f15901d053e1
comparison
equal deleted inserted replaced
934:ff484cc157d6 944:41ca6bf19735
1 ;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
2
3 ;; Copyright (C) 2005 Bryan O'Sullivan
4
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com>
6
7 ;; $Id$
8
9 ;; mercurial.el ("this file") is free software; you can redistribute
10 ;; it and/or modify it under the terms of version 2 of the GNU General
11 ;; Public License as published by the Free Software Foundation.
12
13 ;; This file is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this file, GNU Emacs, or XEmacs; see the file COPYING
20 ;; (`C-h C-l'). If not, write to the Free Software Foundation, Inc.,
21 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22
23 ;;; Commentary:
24
25 ;; This mode builds upon Emacs's VC mode to provide flexible
26 ;; integration with the Mercurial distributed SCM tool.
27
28 ;; To get going as quickly as possible, load this file into Emacs and
29 ;; type `C-c h h'; this runs hg-help-overview, which prints a helpful
30 ;; usage overview.
31
32 ;; Much of the inspiration for mercurial.el comes from Rajesh
33 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
34 ;; job for the commercial Perforce SCM product. In fact, substantial
35 ;; chunks of code are adapted from p4.el.
36
37 ;; This code has been developed under XEmacs 21.5, and may will not
38 ;; work as well under GNU Emacs (albeit tested under 21.2). Patches
39 ;; to enhance the portability of this code, fix bugs, and add features
40 ;; are most welcome. You can clone a Mercurial repository for this
41 ;; package from http://www.serpentine.com/hg/hg-emacs
42
43 ;; Please send problem reports and suggestions to bos@serpentine.com.
44
45
46 ;;; Code:
47
48 (require 'advice)
49 (require 'cl)
50 (require 'diff-mode)
51 (require 'easymenu)
52 (require 'vc)
53
54
55 ;;; XEmacs has view-less, while GNU Emacs has view. Joy.
56
57 (condition-case nil
58 (require 'view-less)
59 (error nil))
60 (condition-case nil
61 (require 'view)
62 (error nil))
63
64
65 ;;; Variables accessible through the custom system.
66
67 (defgroup hg nil
68 "Mercurial distributed SCM."
69 :group 'tools)
70
71 (defcustom hg-binary
72 (dolist (path '("~/bin/hg"
73 "/usr/bin/hg"
74 "/usr/local/bin/hg"))
75 (when (file-executable-p path)
76 (return path)))
77 "The path to Mercurial's hg executable."
78 :type '(file :must-match t)
79 :group 'hg)
80
81 (defcustom hg-mode-hook nil
82 "Hook run when a buffer enters hg-mode."
83 :type 'sexp
84 :group 'hg)
85
86 (defcustom hg-global-prefix "\C-ch"
87 "The global prefix for Mercurial keymap bindings."
88 :type 'sexp
89 :group 'hg)
90
91
92 ;;; Other variables.
93
94 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version)
95 "Is mercurial.el running under XEmacs?")
96
97 (defvar hg-mode nil
98 "Is this file managed by Mercurial?")
99
100 (defvar hg-output-buffer-name "*Hg*"
101 "The name to use for Mercurial output buffers.")
102
103 (defvar hg-file-name-history nil)
104
105
106 ;;; hg-mode keymap.
107
108 (defvar hg-prefix-map
109 (let ((map (copy-keymap vc-prefix-map)))
110 (set-keymap-name map 'hg-prefix-map)
111 map)
112 "This keymap overrides some default vc-mode bindings.")
113 (fset 'hg-prefix-map hg-prefix-map)
114 (define-key hg-prefix-map "=" 'hg-diff-file)
115 (define-key hg-prefix-map "c" 'hg-undo)
116 (define-key hg-prefix-map "g" 'hg-annotate)
117 (define-key hg-prefix-map "l" 'hg-log-file)
118 ;; (define-key hg-prefix-map "r" 'hg-update)
119 (define-key hg-prefix-map "u" 'hg-revert-file)
120 (define-key hg-prefix-map "~" 'hg-version-other-window)
121
122 (defvar hg-mode-map (make-sparse-keymap))
123 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
124
125
126 ;;; Global keymap.
127
128 (global-set-key "\C-xvi" 'hg-add-file)
129
130 (defvar hg-global-map (make-sparse-keymap))
131 (fset 'hg-global-map hg-global-map)
132 (global-set-key hg-global-prefix 'hg-global-map)
133 (define-key hg-global-map "," 'hg-incoming)
134 (define-key hg-global-map "." 'hg-outgoing)
135 (define-key hg-global-map "<" 'hg-pull)
136 (define-key hg-global-map "=" 'hg-diff)
137 (define-key hg-global-map ">" 'hg-push)
138 (define-key hg-global-map "?" 'hg-help-overview)
139 (define-key hg-global-map "A" 'hg-addremove)
140 (define-key hg-global-map "U" 'hg-revert)
141 (define-key hg-global-map "a" 'hg-add)
142 (define-key hg-global-map "c" 'hg-commit)
143 (define-key hg-global-map "h" 'hg-help-overview)
144 (define-key hg-global-map "i" 'hg-init)
145 (define-key hg-global-map "l" 'hg-log)
146 (define-key hg-global-map "r" 'hg-root)
147 (define-key hg-global-map "s" 'hg-status)
148 (define-key hg-global-map "u" 'hg-update)
149
150
151 ;;; View mode keymap.
152
153 (defvar hg-view-mode-map
154 (let ((map (copy-keymap (if (boundp 'view-minor-mode-map)
155 view-minor-mode-map
156 view-mode-map))))
157 (set-keymap-name map 'hg-view-mode-map)
158 map))
159 (fset 'hg-view-mode-map hg-view-mode-map)
160 (define-key hg-view-mode-map
161 (if hg-running-xemacs [button2] [mouse-2])
162 'hg-buffer-mouse-clicked)
163
164
165 ;;; Convenience functions.
166
167 (defun hg-binary ()
168 (if hg-binary
169 hg-binary
170 (error "No `hg' executable found!")))
171
172 (defun hg-replace-in-string (str regexp newtext &optional literal)
173 "Replace all matches in STR for REGEXP with NEWTEXT string.
174 Return the new string. Optional LITERAL non-nil means do a literal
175 replacement.
176
177 This function bridges yet another pointless impedance gap between
178 XEmacs and GNU Emacs."
179 (if (fboundp 'replace-in-string)
180 (replace-in-string str regexp newtext literal)
181 (replace-regexp-in-string regexp newtext str nil literal)))
182
183 (defun hg-chomp (str)
184 "Strip trailing newlines from a string."
185 (hg-replace-in-string str "[\r\n]+$" ""))
186
187 (defun hg-run-command (command &rest args)
188 "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
189 The list ARGS contains a list of arguments to pass to the command."
190 (let* (exit-code
191 (output
192 (with-output-to-string
193 (with-current-buffer
194 standard-output
195 (setq exit-code
196 (apply 'call-process command nil t nil args))))))
197 (cons exit-code output)))
198
199 (defun hg-run (command &rest args)
200 "Run the Mercurial command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT)."
201 (apply 'hg-run-command (hg-binary) command args))
202
203 (defun hg-run0 (command &rest args)
204 "Run the Mercurial command COMMAND, returning its output.
205 If the command does not exit with a zero status code, raise an error."
206 (let ((res (apply 'hg-run-command (hg-binary) command args)))
207 (if (not (eq (car res) 0))
208 (error "Mercurial command failed %s - exit code %s"
209 (cons command args)
210 (car res))
211 (cdr res))))
212
213 (defun hg-buffer-commands (pnt)
214 "Use the properties of a character to do something sensible."
215 (interactive "d")
216 (let ((rev (get-char-property pnt 'rev))
217 (file (get-char-property pnt 'file))
218 (date (get-char-property pnt 'date))
219 (user (get-char-property pnt 'user))
220 (host (get-char-property pnt 'host))
221 (prev-buf (current-buffer)))
222 (cond
223 (file
224 (find-file-other-window file))
225 (rev
226 (hg-diff hg-view-file-name rev rev prev-buf))
227 ((message "I don't know how to do that yet")))))
228
229 (defun hg-buffer-mouse-clicked (event)
230 "Translate the mouse clicks in a HG log buffer to character events.
231 These are then handed off to `hg-buffer-commands'.
232
233 Handle frickin' frackin' gratuitous event-related incompatibilities."
234 (interactive "e")
235 (if hg-running-xemacs
236 (progn
237 (select-window (event-window event))
238 (hg-buffer-commands (event-point event)))
239 (select-window (posn-window (event-end event)))
240 (hg-buffer-commands (posn-point (event-start event)))))
241
242 (unless (fboundp 'view-minor-mode)
243 (defun view-minor-mode (prev-buffer exit-func)
244 (view-mode)))
245
246 (defun hg-abbrev-file-name (file)
247 (if hg-running-xemacs
248 (abbreviate-file-name file t)
249 (abbreviate-file-name file)))
250
251
252 ;;; View mode bits.
253
254 (defun hg-exit-view-mode (buf)
255 "Exit from hg-view-mode.
256 We delete the current window if entering hg-view-mode split the
257 current frame."
258 (when (and (eq buf (current-buffer))
259 (> (length (window-list)) 1))
260 (delete-window))
261 (when (buffer-live-p buf)
262 (kill-buffer buf)))
263
264 (defun hg-view-mode (prev-buffer &optional file-name)
265 (goto-char (point-min))
266 (set-buffer-modified-p nil)
267 (toggle-read-only t)
268 (view-minor-mode prev-buffer 'hg-exit-view-mode)
269 (use-local-map hg-view-mode-map)
270 (setq truncate-lines t)
271 (when file-name
272 (set (make-local-variable 'hg-view-file-name)
273 (hg-abbrev-file-name file-name))))
274
275 (defmacro hg-view-output (args &rest body)
276 "Execute BODY in a clean buffer, then switch that buffer to view-mode.
277 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
278 the name of the buffer to create, and FILE is the name of the file
279 being viewed."
280 (let ((prev-buf (gensym "prev-buf-"))
281 (v-b-name (car args))
282 (v-m-rest (cdr args)))
283 `(let ((view-buf-name ,v-b-name)
284 (,prev-buf (current-buffer)))
285 (get-buffer-create view-buf-name)
286 (kill-buffer view-buf-name)
287 (pop-to-buffer view-buf-name)
288 (save-excursion
289 ,@body)
290 (hg-view-mode ,prev-buf ,@v-m-rest))))
291
292 (put 'hg-view-output 'lisp-indent-function 1)
293
294
295 ;;; User interface functions.
296
297 (defun hg-help-overview ()
298 "This is an overview of the Mercurial SCM mode for Emacs.
299
300 You can find the source code, license (GPL v2), and credits for this
301 code by typing `M-x find-library mercurial RET'.
302
303 The Mercurial mode user interface is based on that of the older VC
304 mode, so if you're already familiar with VC, the same keybindings and
305 functions will generally work.
306
307 Below is a list of common SCM tasks, with the key bindings needed to
308 perform them, and the command names. This list is not exhaustive.
309
310 In the list below, `G/L' indicates whether a key binding is global (G)
311 or local (L). Global keybindings work on any file inside a Mercurial
312 repository. Local keybindings only apply to files under the control
313 of Mercurial. Many commands take a prefix argument.
314
315
316 SCM Task G/L Key Binding Command Name
317 -------- --- ----------- ------------
318 Help overview (what you are reading) G C-c h h hg-help-overview
319
320 Tell Mercurial to manage a file G C-x v i hg-add-file
321 Commit changes to current file only L C-x C-q vc-toggle-read-only
322 Undo changes to file since commit L C-x v u hg-revert-file
323
324 Diff file vs last checkin L C-x v = hg-diff-file
325
326 View file change history L C-x v l hg-log-file
327 View annotated file L C-x v a hg-annotate
328
329 Diff repo vs last checkin G C-c h = hg-diff
330 View status of files in repo G C-c h s hg-status
331 Commit all changes G C-c h c hg-commit
332
333 Undo all changes since last commit G C-c h U hg-revert
334 View repo change history G C-c h l hg-log
335
336 See changes that can be pulled G C-c h , hg-incoming
337 Pull changes G C-c h < hg-pull
338 Update working directory after pull G C-c h u hg-update
339 See changes that can be pushed G C-c h . hg-outgoing
340 Push changes G C-c h > hg-push"
341 (interactive)
342 (hg-view-output ("Mercurial Help Overview")
343 (insert (documentation 'hg-help-overview))))
344
345 (defun hg-add ()
346 (interactive)
347 (error "not implemented"))
348
349 (defun hg-add-file ()
350 (interactive)
351 (error "not implemented"))
352
353 (defun hg-addremove ()
354 (interactive)
355 (error "not implemented"))
356
357 (defun hg-annotate ()
358 (interactive)
359 (error "not implemented"))
360
361 (defun hg-commit ()
362 (interactive)
363 (error "not implemented"))
364
365 (defun hg-diff ()
366 (interactive)
367 (error "not implemented"))
368
369 (defun hg-diff-file ()
370 (interactive)
371 (error "not implemented"))
372
373 (defun hg-incoming ()
374 (interactive)
375 (error "not implemented"))
376
377 (defun hg-init ()
378 (interactive)
379 (error "not implemented"))
380
381 (defun hg-log-file ()
382 (interactive)
383 (error "not implemented"))
384
385 (defun hg-log ()
386 (interactive)
387 (error "not implemented"))
388
389 (defun hg-outgoing ()
390 (interactive)
391 (error "not implemented"))
392
393 (defun hg-pull ()
394 (interactive)
395 (error "not implemented"))
396
397 (defun hg-push ()
398 (interactive)
399 (error "not implemented"))
400
401 (defun hg-revert ()
402 (interactive)
403 (error "not implemented"))
404
405 (defun hg-revert-file ()
406 (interactive)
407 (error "not implemented"))
408
409 (defun hg-root (&optional path)
410 (interactive)
411 (unless path
412 (setq path (if (and (interactive-p) current-prefix-arg)
413 (expand-file-name (read-file-name "Path name: "))
414 (or (buffer-file-name) "(none)"))))
415 (let ((root (do ((prev nil dir)
416 (dir (file-name-directory path)
417 (file-name-directory (directory-file-name dir))))
418 ((equal prev dir))
419 (when (file-directory-p (concat dir ".hg"))
420 (return dir)))))
421 (when (interactive-p)
422 (if root
423 (message "The root of this repository is `%s'." root)
424 (message "The path `%s' is not in a Mercurial repository."
425 (abbreviate-file-name path t))))
426 root))
427
428 (defun hg-status ()
429 (interactive)
430 (error "not implemented"))
431
432 (defun hg-undo ()
433 (interactive)
434 (error "not implemented"))
435
436 (defun hg-version-other-window ()
437 (interactive)
438 (error "not implemented"))
439
440
441 (provide 'mercurial)
442
443
444 ;;; Local Variables:
445 ;;; mode: emacs-lisp
446 ;;; prompt-to-byte-compile: nil
447 ;;; end: