comparison contrib/mercurial.el @ 2454:74518478d2bf

Emacs: change directory of output buffer to the root of the repository.
author FUJIWARA Katsunori <foozy@lares.dti.ne.jp>
date Sun, 18 Jun 2006 04:02:56 +0900
parents 6d0a9de9a8ac
children 8e1004c61796
comparison
equal deleted inserted replaced
2451:134227b82a96 2454:74518478d2bf
710 (hg-view-output ("Mercurial Help Overview") 710 (hg-view-output ("Mercurial Help Overview")
711 (insert (documentation 'hg-help-overview)) 711 (insert (documentation 'hg-help-overview))
712 (let ((pos (point))) 712 (let ((pos (point)))
713 (insert (documentation 'hg-mode)) 713 (insert (documentation 'hg-mode))
714 (goto-char pos) 714 (goto-char pos)
715 (kill-line)))) 715 (kill-line))
716 (cd (hg-root))))
716 717
717 (defun hg-add (path) 718 (defun hg-add (path)
718 "Add PATH to the Mercurial repository on the next commit. 719 "Add PATH to the Mercurial repository on the next commit.
719 With a prefix argument, prompt for the path to add." 720 With a prefix argument, prompt for the path to add."
720 (interactive (list (hg-read-file-name " to add"))) 721 (interactive (list (hg-read-file-name " to add")))
721 (let ((buf (current-buffer)) 722 (let ((buf (current-buffer))
722 (update (equal buffer-file-name path))) 723 (update (equal buffer-file-name path)))
723 (hg-view-output (hg-output-buffer-name) 724 (hg-view-output (hg-output-buffer-name)
724 (apply 'call-process (hg-binary) nil t nil (list "add" path))) 725 (apply 'call-process (hg-binary) nil t nil (list "add" path))
726 ;; "hg add" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
727 (replace-regexp " \\.\\.." " " nil 0 (buffer-size))
728 (goto-char 0)
729 (cd (hg-root path)))
725 (when update 730 (when update
726 (with-current-buffer buf 731 (with-current-buffer buf
727 (hg-mode-line))))) 732 (hg-mode-line)))))
728 733
729 (defun hg-addremove () 734 (defun hg-addremove ()
888 '(read-only t)) 893 '(read-only t))
889 (goto-char (point-min)) 894 (goto-char (point-min))
890 (search-forward hg-commit-message-start) 895 (search-forward hg-commit-message-start)
891 (add-text-properties (match-beginning 0) (match-end 0) 896 (add-text-properties (match-beginning 0) (match-end 0)
892 '(read-only t))) 897 '(read-only t)))
893 (hg-commit-mode)))))) 898 (hg-commit-mode)
899 (cd root))))))
894 900
895 (defun hg-diff (path &optional rev1 rev2) 901 (defun hg-diff (path &optional rev1 rev2)
896 "Show the differences between REV1 and REV2 of PATH. 902 "Show the differences between REV1 and REV2 of PATH.
897 When called interactively, the default behaviour is to treat REV1 as 903 When called interactively, the default behaviour is to treat REV1 as
898 the tip revision, REV2 as the current edited version of the file, and 904 the tip revision, REV2 as the current edited version of the file, and
917 (if rev2 923 (if rev2
918 (call-process (hg-binary) nil t nil "diff" "-r" r1 "-r" rev2 path) 924 (call-process (hg-binary) nil t nil "diff" "-r" r1 "-r" rev2 path)
919 (call-process (hg-binary) nil t nil "diff" "-r" r1 path)) 925 (call-process (hg-binary) nil t nil "diff" "-r" r1 path))
920 (diff-mode) 926 (diff-mode)
921 (setq diff (not (= (point-min) (point-max)))) 927 (setq diff (not (= (point-min) (point-max))))
922 (font-lock-fontify-buffer)) 928 (font-lock-fontify-buffer)
929 (cd (hg-root path)))
923 diff)) 930 diff))
924 931
925 (defun hg-diff-repo () 932 (defun hg-diff-repo ()
926 "Show the differences between the working copy and the tip revision." 933 "Show the differences between the working copy and the tip revision."
927 (interactive) 934 (interactive)
934 With a prefix argument, prompt for the path to forget." 941 With a prefix argument, prompt for the path to forget."
935 (interactive (list (hg-read-file-name " to forget"))) 942 (interactive (list (hg-read-file-name " to forget")))
936 (let ((buf (current-buffer)) 943 (let ((buf (current-buffer))
937 (update (equal buffer-file-name path))) 944 (update (equal buffer-file-name path)))
938 (hg-view-output (hg-output-buffer-name) 945 (hg-view-output (hg-output-buffer-name)
939 (apply 'call-process (hg-binary) nil t nil (list "forget" path))) 946 (apply 'call-process (hg-binary) nil t nil (list "forget" path))
947 ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
948 (replace-regexp " \\.\\.." " " nil 0 (buffer-size))
949 (goto-char 0)
950 (cd (hg-root path)))
940 (when update 951 (when update
941 (with-current-buffer buf 952 (with-current-buffer buf
942 (hg-mode-line))))) 953 (hg-mode-line)))))
943 954
944 (defun hg-incoming (&optional repo) 955 (defun hg-incoming (&optional repo)
948 (hg-abbrev-file-name (hg-root)) 959 (hg-abbrev-file-name (hg-root))
949 (hg-abbrev-file-name 960 (hg-abbrev-file-name
950 (or repo hg-incoming-repository)))) 961 (or repo hg-incoming-repository))))
951 (call-process (hg-binary) nil t nil "incoming" 962 (call-process (hg-binary) nil t nil "incoming"
952 (or repo hg-incoming-repository)) 963 (or repo hg-incoming-repository))
953 (hg-log-mode))) 964 (hg-log-mode)
965 (cd (hg-root))))
954 966
955 (defun hg-init () 967 (defun hg-init ()
956 (interactive) 968 (interactive)
957 (error "not implemented")) 969 (error "not implemented"))
958 970
992 "-r" (format "%s:%s" r1 r2) 1004 "-r" (format "%s:%s" r1 r2)
993 "-l" limit 1005 "-l" limit
994 (if (> (length path) (length (hg-root path))) 1006 (if (> (length path) (length (hg-root path)))
995 (cons path nil) 1007 (cons path nil)
996 nil))) 1008 nil)))
997 (hg-log-mode)))) 1009 (hg-log-mode)
1010 (cd (hg-root path)))))
998 1011
999 (defun hg-log-repo (path &optional rev1 rev2 log-limit) 1012 (defun hg-log-repo (path &optional rev1 rev2 log-limit)
1000 "Display the revision history of the repository containing PATH. 1013 "Display the revision history of the repository containing PATH.
1001 History is displayed between REV1 and REV2. 1014 History is displayed between REV1 and REV2.
1002 Number of displayed changesets is limited to LOG-LIMIT, 1015 Number of displayed changesets is limited to LOG-LIMIT,
1021 (hg-abbrev-file-name (hg-root)) 1034 (hg-abbrev-file-name (hg-root))
1022 (hg-abbrev-file-name 1035 (hg-abbrev-file-name
1023 (or repo hg-outgoing-repository)))) 1036 (or repo hg-outgoing-repository))))
1024 (call-process (hg-binary) nil t nil "outgoing" 1037 (call-process (hg-binary) nil t nil "outgoing"
1025 (or repo hg-outgoing-repository)) 1038 (or repo hg-outgoing-repository))
1026 (hg-log-mode))) 1039 (hg-log-mode)
1040 (cd (hg-root))))
1027 1041
1028 (defun hg-pull (&optional repo) 1042 (defun hg-pull (&optional repo)
1029 "Pull changes from repository REPO. 1043 "Pull changes from repository REPO.
1030 This does not update the working directory." 1044 This does not update the working directory."
1031 (interactive (list (hg-read-repo-name " to pull from"))) 1045 (interactive (list (hg-read-repo-name " to pull from")))
1032 (hg-view-output ((format "Mercurial: Pull to %s from %s" 1046 (hg-view-output ((format "Mercurial: Pull to %s from %s"
1033 (hg-abbrev-file-name (hg-root)) 1047 (hg-abbrev-file-name (hg-root))
1034 (hg-abbrev-file-name 1048 (hg-abbrev-file-name
1035 (or repo hg-incoming-repository)))) 1049 (or repo hg-incoming-repository))))
1036 (call-process (hg-binary) nil t nil "pull" 1050 (call-process (hg-binary) nil t nil "pull"
1037 (or repo hg-incoming-repository)))) 1051 (or repo hg-incoming-repository))
1052 (cd (hg-root))))
1038 1053
1039 (defun hg-push (&optional repo) 1054 (defun hg-push (&optional repo)
1040 "Push changes to repository REPO." 1055 "Push changes to repository REPO."
1041 (interactive (list (hg-read-repo-name " to push to"))) 1056 (interactive (list (hg-read-repo-name " to push to")))
1042 (hg-view-output ((format "Mercurial: Push from %s to %s" 1057 (hg-view-output ((format "Mercurial: Push from %s to %s"
1043 (hg-abbrev-file-name (hg-root)) 1058 (hg-abbrev-file-name (hg-root))
1044 (hg-abbrev-file-name 1059 (hg-abbrev-file-name
1045 (or repo hg-outgoing-repository)))) 1060 (or repo hg-outgoing-repository))))
1046 (call-process (hg-binary) nil t nil "push" 1061 (call-process (hg-binary) nil t nil "push"
1047 (or repo hg-outgoing-repository)))) 1062 (or repo hg-outgoing-repository))
1063 (cd (hg-root))))
1048 1064
1049 (defun hg-revert-buffer-internal () 1065 (defun hg-revert-buffer-internal ()
1050 (let ((ctx (hg-buffer-context))) 1066 (let ((ctx (hg-buffer-context)))
1051 (message "Reverting %s..." buffer-file-name) 1067 (message "Reverting %s..." buffer-file-name)
1052 (hg-run0 "revert" buffer-file-name) 1068 (hg-run0 "revert" buffer-file-name)
1110 (if (> (length name) 0) 1126 (if (> (length name) 0)
1111 name 1127 name
1112 "*")) 1128 "*"))
1113 (hg-abbrev-file-name root))) 1129 (hg-abbrev-file-name root)))
1114 (apply 'call-process (hg-binary) nil t nil 1130 (apply 'call-process (hg-binary) nil t nil
1115 (list "--cwd" root "status" path))))) 1131 (list "--cwd" root "status" path))
1132 (cd (hg-root path)))))
1116 1133
1117 (defun hg-undo () 1134 (defun hg-undo ()
1118 (interactive) 1135 (interactive)
1119 (error "not implemented")) 1136 (error "not implemented"))
1120 1137