1 ;;; mercurial.el --- Emacs support for the Mercurial distributed SCM |
1 ;;; mercurial.el --- Emacs support for the Mercurial distributed SCM |
2 |
2 |
3 ;; Copyright (C) 2005 Bryan O'Sullivan |
3 ;; Copyright (C) 2005, 2006 Bryan O'Sullivan |
4 |
4 |
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com> |
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com> |
6 |
6 |
7 ;; mercurial.el is free software; you can redistribute it and/or |
7 ;; mercurial.el is free software; you can redistribute it and/or |
8 ;; modify it under the terms of version 2 of the GNU General Public |
8 ;; modify it under the terms of version 2 of the GNU General Public |
722 (if (not hg-root-dir) |
722 (if (not hg-root-dir) |
723 (error "error: %s: directory is not part of a Mercurial repository." |
723 (error "error: %s: directory is not part of a Mercurial repository." |
724 default-directory) |
724 default-directory) |
725 (cd hg-root-dir))))) |
725 (cd hg-root-dir))))) |
726 |
726 |
|
727 (defun hg-fix-paths () |
|
728 "Fix paths reported by some Mercurial commands." |
|
729 (save-excursion |
|
730 (goto-char (point-min)) |
|
731 (while (re-search-forward " \\.\\.." nil t) |
|
732 (replace-match " " nil nil)))) |
|
733 |
727 (defun hg-add (path) |
734 (defun hg-add (path) |
728 "Add PATH to the Mercurial repository on the next commit. |
735 "Add PATH to the Mercurial repository on the next commit. |
729 With a prefix argument, prompt for the path to add." |
736 With a prefix argument, prompt for the path to add." |
730 (interactive (list (hg-read-file-name " to add"))) |
737 (interactive (list (hg-read-file-name " to add"))) |
731 (let ((buf (current-buffer)) |
738 (let ((buf (current-buffer)) |
732 (update (equal buffer-file-name path))) |
739 (update (equal buffer-file-name path))) |
733 (hg-view-output (hg-output-buffer-name) |
740 (hg-view-output (hg-output-buffer-name) |
734 (apply 'call-process (hg-binary) nil t nil (list "add" path)) |
741 (apply 'call-process (hg-binary) nil t nil (list "add" path)) |
735 ;; "hg add" shows pathes relative NOT TO ROOT BUT TO REPOSITORY |
742 (hg-fix-paths) |
736 (replace-regexp " \\.\\.." " " nil 0 (buffer-size)) |
|
737 (goto-char 0) |
743 (goto-char 0) |
738 (cd (hg-root path))) |
744 (cd (hg-root path))) |
739 (when update |
745 (when update |
740 (unless vc-make-backup-files |
746 (unless vc-make-backup-files |
741 (set (make-local-variable 'backup-inhibited) t)) |
747 (set (make-local-variable 'backup-inhibited) t)) |
971 (let ((buf (current-buffer)) |
977 (let ((buf (current-buffer)) |
972 (update (equal buffer-file-name path))) |
978 (update (equal buffer-file-name path))) |
973 (hg-view-output (hg-output-buffer-name) |
979 (hg-view-output (hg-output-buffer-name) |
974 (apply 'call-process (hg-binary) nil t nil (list "forget" path)) |
980 (apply 'call-process (hg-binary) nil t nil (list "forget" path)) |
975 ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY |
981 ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY |
976 (replace-regexp " \\.\\.." " " nil 0 (buffer-size)) |
982 (hg-fix-paths) |
977 (goto-char 0) |
983 (goto-char 0) |
978 (cd (hg-root path))) |
984 (cd (hg-root path))) |
979 (when update |
985 (when update |
980 (with-current-buffer buf |
986 (with-current-buffer buf |
981 (when (local-variable-p 'backup-inhibited) |
987 (when (local-variable-p 'backup-inhibited) |