Mercurial > hg > pyhgsh

comparison contrib/mercurial.el @ 1029:b5f0ccad8917

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Emacs: implement hg-incoming, hg-outgoing and hg-push.
author Bryan O'Sullivan <bos@serpentine.com>
date Tue, 23 Aug 2005 21:53:13 -0700
parents cb31576ed3e4
children 7e909ceeb36a
comparison
equal deleted inserted replaced
1028:25e7ea0f2cff 1029:b5f0ccad8917
90 "Hook run before a commit is performed. 90 "Hook run before a commit is performed.
91 If you want to prevent the commit from proceeding, raise an error." 91 If you want to prevent the commit from proceeding, raise an error."
92 :type 'sexp 92 :type 'sexp
93 :group 'mercurial) 93 :group 'mercurial)
94 94
95 (defcustom hg-log-mode-hook nil
96 "Hook run after a buffer is filled with log information."
97 :type 'sexp
98 :group 'mercurial)
99
95 (defcustom hg-global-prefix "\C-ch" 100 (defcustom hg-global-prefix "\C-ch"
96 "The global prefix for Mercurial keymap bindings." 101 "The global prefix for Mercurial keymap bindings."
97 :type 'sexp 102 :type 'sexp
98 :group 'mercurial) 103 :group 'mercurial)
99 104
123 "Whether to update the modeline with the status of a file after every save. 128 "Whether to update the modeline with the status of a file after every save.
124 Set this to nil on platforms with poor process management, such as Windows." 129 Set this to nil on platforms with poor process management, such as Windows."
125 :type 'boolean 130 :type 'boolean
126 :group 'mercurial) 131 :group 'mercurial)
127 132
133 (defcustom hg-incoming-repository "default"
134 "The repository from which changes are pulled from by default.
135 This should be a symbolic repository name, since it is used for all
136 repository-related commands."
137 :type 'string
138 :group 'mercurial)
139
140 (defcustom hg-outgoing-repository "default-push"
141 "The repository to which changes are pushed to by default.
142 This should be a symbolic repository name, since it is used for all
143 repository-related commands."
144 :type 'string
145 :group 'mercurial)
146
128 147
129 ;;; Other variables. 148 ;;; Other variables.
130 149
131 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version) 150 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version)
132 "Is mercurial.el running under XEmacs?") 151 "Is mercurial.el running under XEmacs?")
150 169
151 (defvar hg-output-buffer-name "*Hg*" 170 (defvar hg-output-buffer-name "*Hg*"
152 "The name to use for Mercurial output buffers.") 171 "The name to use for Mercurial output buffers.")
153 172
154 (defvar hg-file-history nil) 173 (defvar hg-file-history nil)
174 (defvar hg-repo-history nil)
155 (defvar hg-rev-history nil) 175 (defvar hg-rev-history nil)
156 176
157 177
158 ;;; Random constants. 178 ;;; Random constants.
159 179
232 ;;; Commit mode keymaps. 252 ;;; Commit mode keymaps.
233 253
234 (defvar hg-commit-mode-map (make-sparse-keymap)) 254 (defvar hg-commit-mode-map (make-sparse-keymap))
235 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish) 255 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish)
236 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill) 256 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill)
257 (define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo)
237 258
238 (defvar hg-commit-mode-file-map (make-sparse-keymap)) 259 (defvar hg-commit-mode-file-map (make-sparse-keymap))
239 (define-key hg-commit-mode-file-map 260 (define-key hg-commit-mode-file-map
240 (if hg-running-xemacs [button2] [mouse-2]) 261 (if hg-running-xemacs [button2] [mouse-2])
241 'hg-commit-mouse-clicked) 262 'hg-commit-mouse-clicked)
368 nil nil 389 nil nil
369 (and path (file-name-nondirectory path)) 390 (and path (file-name-nondirectory path))
370 'hg-file-history)) 391 'hg-file-history))
371 path)))) 392 path))))
372 393
394 (defun hg-read-config ()
395 "Return an alist of (key . value) pairs of Mercurial config data.
396 Each key is of the form (section . name)."
397 (let (items)
398 (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
399 (string-match "^\\([^=]*\\)=\\(.*\\)" line)
400 (let* ((left (substring line (match-beginning 1) (match-end 1)))
401 (right (substring line (match-beginning 2) (match-end 2)))
402 (key (split-string left "\\."))
403 (value (hg-replace-in-string right "\\\\n" "\n" t)))
404 (setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
405
406 (defun hg-config-section (section config)
407 "Return an alist of (name . value) pairs for SECTION of CONFIG."
408 (let (items)
409 (dolist (item config items)
410 (when (equal (caar item) section)
411 (setq items (cons (cons (cdar item) (cdr item)) items))))))
412
413 (defun hg-string-starts-with (sub str)
414 "Indicate whether string STR starts with the substring or character SUB."
415 (if (not (stringp sub))
416 (and (> (length str) 0) (equal (elt str 0) sub))
417 (let ((sub-len (length sub)))
418 (and (<= sub-len (length str))
419 (string= sub (substring str 0 sub-len))))))
420
421 (defun hg-complete-repo (string predicate all)
422 "Attempt to complete a repository name.
423 We complete on either symbolic names from Mercurial's config or real
424 directory names from the file system. We do not penalise URLs."
425 (or (if all
426 (all-completions string hg-repo-completion-table predicate)
427 (try-completion string hg-repo-completion-table predicate))
428 (let* ((str (expand-file-name string))
429 (dir (file-name-directory str))
430 (file (file-name-nondirectory str)))
431 (if all
432 (let (completions)
433 (dolist (name (delete "./" (file-name-all-completions file dir))
434 completions)
435 (let ((path (concat dir name)))
436 (when (file-directory-p path)
437 (setq completions (cons name completions))))))
438 (let ((comp (file-name-completion file dir)))
439 (if comp
440 (hg-abbrev-file-name (concat dir comp))))))))
441
442 (defun hg-read-repo-name (&optional prompt initial-contents default)
443 "Read the location of a repository."
444 (save-excursion
445 (while hg-prev-buffer
446 (set-buffer hg-prev-buffer))
447 (let (hg-repo-completion-table)
448 (if current-prefix-arg
449 (progn
450 (dolist (path (hg-config-section "paths" (hg-read-config)))
451 (setq hg-repo-completion-table
452 (cons (cons (car path) t) hg-repo-completion-table))
453 (unless (hg-string-starts-with directory-sep-char (cdr path))
454 (setq hg-repo-completion-table
455 (cons (cons (cdr path) t) hg-repo-completion-table))))
456 (completing-read (format "Repository%s: " (or prompt ""))
457 'hg-complete-repo
458 nil
459 nil
460 initial-contents
461 'hg-repo-history
462 default))
463 default))))
464
373 (defun hg-read-rev (&optional prompt default) 465 (defun hg-read-rev (&optional prompt default)
374 "Read a revision or tag, offering completions." 466 "Read a revision or tag, offering completions."
375 (save-excursion 467 (save-excursion
376 (while hg-prev-buffer 468 (while hg-prev-buffer
377 (set-buffer hg-prev-buffer)) 469 (set-buffer hg-prev-buffer))
378 (let ((rev (or default "tip"))) 470 (let ((rev (or default "tip")))
379 (if (or (not rev) current-prefix-arg) 471 (if current-prefix-arg
380 (let ((revs (split-string (hg-chomp 472 (let ((revs (split-string (hg-chomp
381 (hg-run0 "-q" "log" "-r" 473 (hg-run0 "-q" "log" "-r"
382 (format "-%d" 474 (format "-%d"
383 hg-rev-completion-limit) 475 hg-rev-completion-limit)
384 "-r" "tip")) 476 "-r" "tip"))
835 (apply 'call-process (hg-binary) nil t nil (list "forget" path))) 927 (apply 'call-process (hg-binary) nil t nil (list "forget" path)))
836 (when update 928 (when update
837 (with-current-buffer buf 929 (with-current-buffer buf
838 (hg-mode-line))))) 930 (hg-mode-line)))))
839 931
840 (defun hg-incoming () 932 (defun hg-incoming (&optional repo)
933 "Display changesets present in REPO that are not present locally."
934 (interactive (list (hg-read-repo-name " where changes would come from")))
935 (hg-view-output ((format "Mercurial: Incoming from %s to %s"
936 (hg-abbrev-file-name (hg-root))
937 (hg-abbrev-file-name
938 (or repo hg-incoming-repository))))
939 (call-process (hg-binary) nil t nil "incoming"
940 (or repo hg-incoming-repository))
941 (hg-log-mode)))
942
943 (defun hg-init ()
841 (interactive) 944 (interactive)
842 (error "not implemented")) 945 (error "not implemented"))
843 946
844 (defun hg-init () 947 (defun hg-log-mode ()
845 (interactive) 948 "Mode for viewing a Mercurial change log."
846 (error "not implemented")) 949 (goto-char (point-min))
950 (when (looking-at "^searching for changes")
951 (kill-entire-line))
952 (run-hooks 'hg-log-mode-hook))
847 953
848 (defun hg-log (path &optional rev1 rev2) 954 (defun hg-log (path &optional rev1 rev2)
849 "Display the revision history of PATH, between REV1 and REV2. 955 "Display the revision history of PATH, between REV1 and REV2.
850 REV1 defaults to hg-log-limit changes from the tip revision, while 956 REV1 defaults to hg-log-limit changes from the tip revision, while
851 REV2 defaults to the tip. 957 REV2 defaults to the tip.
861 (format "Mercurial: Log from rev %s to %s of %s" 967 (format "Mercurial: Log from rev %s to %s of %s"
862 r1 r2 a-path))) 968 r1 r2 a-path)))
863 (if (> (length path) (length (hg-root path))) 969 (if (> (length path) (length (hg-root path)))
864 (call-process (hg-binary) nil t nil "log" "-r" r1 "-r" r2 path) 970 (call-process (hg-binary) nil t nil "log" "-r" r1 "-r" r2 path)
865 (call-process (hg-binary) nil t nil "log" "-r" r1 "-r" r2)) 971 (call-process (hg-binary) nil t nil "log" "-r" r1 "-r" r2))
866 (font-lock-fontify-buffer)))) 972 (hg-log-mode))))
867 973
868 (defun hg-log-repo (path &optional rev1 rev2) 974 (defun hg-log-repo (path &optional rev1 rev2)
869 "Display the revision history of the repository containing PATH. 975 "Display the revision history of the repository containing PATH.
870 History is displayed between REV1, which defaults to the tip, and 976 History is displayed between REV1, which defaults to the tip, and
871 REV2, which defaults to the initial revision. 977 REV2, which defaults to the initial revision.
873 (interactive (list (hg-read-file-name " to log") 979 (interactive (list (hg-read-file-name " to log")
874 (hg-read-rev " to start with" "tip") 980 (hg-read-rev " to start with" "tip")
875 (hg-read-rev " to end with" (format "-%d" hg-log-limit)))) 981 (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
876 (hg-log (hg-root path) rev1 rev2)) 982 (hg-log (hg-root path) rev1 rev2))
877 983
878 (defun hg-outgoing () 984 (defun hg-outgoing (&optional repo)
985 "Display changesets present locally that are not present in REPO."
986 (interactive (list (hg-read-repo-name " where changes would go to" nil
987 hg-outgoing-repository)))
988 (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
989 (hg-abbrev-file-name (hg-root))
990 (hg-abbrev-file-name
991 (or repo hg-outgoing-repository))))
992 (call-process (hg-binary) nil t nil "outgoing"
993 (or repo hg-outgoing-repository))
994 (hg-log-mode)))
995
996 (defun hg-pull ()
879 (interactive) 997 (interactive)
880 (error "not implemented")) 998 (error "not implemented"))
881 999
882 (defun hg-pull () 1000 (defun hg-push (&optional repo)
883 (interactive) 1001 "Push changes to repository REPO."
884 (error "not implemented")) 1002 (interactive (list (hg-read-repo-name " to push to")))
885 1003 (hg-view-output ((format "Mercurial: Push from %s to %s"
886 (defun hg-push () 1004 (hg-abbrev-file-name (hg-root))
887 (interactive) 1005 (hg-abbrev-file-name
888 (error "not implemented")) 1006 (or repo hg-outgoing-repository))))
1007 (call-process (hg-binary) nil t nil "push"
1008 (or repo hg-outgoing-repository))))
889 1009
890 (defun hg-revert-buffer-internal () 1010 (defun hg-revert-buffer-internal ()
891 (let ((ctx (hg-buffer-context))) 1011 (let ((ctx (hg-buffer-context)))
892 (message "Reverting %s..." buffer-file-name) 1012 (message "Reverting %s..." buffer-file-name)
893 (hg-run0 "revert" buffer-file-name) 1013 (hg-run0 "revert" buffer-file-name)
933 (return dir))))) 1053 (return dir)))))
934 (when (interactive-p) 1054 (when (interactive-p)
935 (if root 1055 (if root
936 (message "The root of this repository is `%s'." root) 1056 (message "The root of this repository is `%s'." root)
937 (message "The path `%s' is not in a Mercurial repository." 1057 (message "The path `%s' is not in a Mercurial repository."
938 (abbreviate-file-name path t)))) 1058 (hg-abbrev-file-name path))))
939 root) 1059 root)
940 hg-root)) 1060 hg-root))
941 1061
942 (defun hg-status (path) 1062 (defun hg-status (path)
943 "Print revision control status of a file or directory. 1063 "Print revision control status of a file or directory.