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?") |
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) |