500 nil |
500 nil |
501 'hg-rev-history |
501 'hg-rev-history |
502 (or default "tip"))) |
502 (or default "tip"))) |
503 rev)))) |
503 rev)))) |
504 |
504 |
|
505 (defun hg-parents-for-mode-line (root) |
|
506 "Format the parents of the working directory for the mode line." |
|
507 (let ((parents (split-string (hg-chomp |
|
508 (hg-run0 "--cwd" root "parents" "--template" |
|
509 "{rev}\n")) "\n"))) |
|
510 (mapconcat 'identity parents "+"))) |
|
511 |
|
512 (defun hg-buffers-visiting-repo (&optional path) |
|
513 "Return a list of buffers visiting the repository containing PATH." |
|
514 (let ((root-name (hg-root (or path (buffer-file-name)))) |
|
515 bufs) |
|
516 (save-excursion |
|
517 (dolist (buf (buffer-list) bufs) |
|
518 (set-buffer buf) |
|
519 (let ((name (buffer-file-name))) |
|
520 (when (and hg-status name (equal (hg-root name) root-name)) |
|
521 (setq bufs (cons buf bufs)))))))) |
|
522 |
|
523 (defun hg-update-mode-lines (path) |
|
524 "Update the mode lines of all buffers visiting the same repository as PATH." |
|
525 (let* ((root (hg-root path)) |
|
526 (parents (hg-parents-for-mode-line root))) |
|
527 (save-excursion |
|
528 (dolist (info (hg-path-status |
|
529 root |
|
530 (mapcar |
|
531 (function |
|
532 (lambda (buf) |
|
533 (substring (buffer-file-name buf) (length root)))) |
|
534 (hg-buffers-visiting-repo root)))) |
|
535 (let* ((name (car info)) |
|
536 (status (cdr info)) |
|
537 (buf (find-buffer-visiting (concat root name)))) |
|
538 (when buf |
|
539 (set-buffer buf) |
|
540 (hg-mode-line-internal status parents))))))) |
|
541 |
505 (defmacro hg-do-across-repo (path &rest body) |
542 (defmacro hg-do-across-repo (path &rest body) |
506 (let ((root-name (gensym "root-")) |
543 (let ((root-name (gensym "root-")) |
507 (buf-name (gensym "buf-"))) |
544 (buf-name (gensym "buf-"))) |
508 `(let ((,root-name (hg-root ,path))) |
545 `(let ((,root-name (hg-root ,path))) |
509 (save-excursion |
546 (save-excursion |
552 ("? " . nil))))) |
589 ("? " . nil))))) |
553 (if state |
590 (if state |
554 (cdr state) |
591 (cdr state) |
555 'normal))))) |
592 'normal))))) |
556 |
593 |
557 (defun hg-status (&rest paths) |
594 (defun hg-path-status (root paths) |
558 "Return status of PATHS as an alist. |
595 "Return status of PATHS in repo ROOT as an alist. |
559 Each entry is a pair (FILE-NAME . STATUS)." |
596 Each entry is a pair (FILE-NAME . STATUS)." |
560 (let ((s (apply 'hg-run "status" "-marduc" paths)) |
597 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths)) |
561 result) |
598 result) |
562 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result)) |
599 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result)) |
563 (let ((state (cdr (assoc (substring entry 0 2) |
600 (let ((state (cdr (assoc (substring entry 0 2) |
564 '(("M " . modified) |
601 '(("M " . modified) |
565 ("A " . added) |
602 ("A " . added) |
567 ("! " . deleted) |
604 ("! " . deleted) |
568 ("C " . normal) |
605 ("C " . normal) |
569 ("I " . ignored) |
606 ("I " . ignored) |
570 ("? " . nil))))) |
607 ("? " . nil))))) |
571 (name (substring entry 2))) |
608 (name (substring entry 2))) |
572 (setq result (cons (cons name state) result))))))) |
609 (setq result (cons (cons name state) result)))))) |
573 |
610 |
574 (defmacro hg-view-output (args &rest body) |
611 (defmacro hg-view-output (args &rest body) |
575 "Execute BODY in a clean buffer, then quickly display that buffer. |
612 "Execute BODY in a clean buffer, then quickly display that buffer. |
576 If the buffer contains one line, its contents are displayed in the |
613 If the buffer contains one line, its contents are displayed in the |
577 minibuffer. Otherwise, the buffer is displayed in view-mode. |
614 minibuffer. Otherwise, the buffer is displayed in view-mode. |
644 (set-mark (hg-find-context mark-context))))) |
681 (set-mark (hg-find-context mark-context))))) |
645 |
682 |
646 |
683 |
647 ;;; Hooks. |
684 ;;; Hooks. |
648 |
685 |
|
686 (defun hg-mode-line-internal (status parents) |
|
687 (setq hg-status status |
|
688 hg-mode (and status (concat " Hg:" |
|
689 parents |
|
690 (cdr (assq status |
|
691 '((normal . "") |
|
692 (removed . "r") |
|
693 (added . "a") |
|
694 (deleted . "!") |
|
695 (modified . "m")))))))) |
|
696 |
649 (defun hg-mode-line (&optional force) |
697 (defun hg-mode-line (&optional force) |
650 "Update the modeline with the current status of a file. |
698 "Update the modeline with the current status of a file. |
651 An update occurs if optional argument FORCE is non-nil, |
699 An update occurs if optional argument FORCE is non-nil, |
652 hg-update-modeline is non-nil, or we have not yet checked the state of |
700 hg-update-modeline is non-nil, or we have not yet checked the state of |
653 the file." |
701 the file." |
654 (when (and (hg-root) (or force hg-update-modeline (not hg-mode))) |
702 (let ((root (hg-root))) |
655 (let ((status (hg-file-status buffer-file-name)) |
703 (when (and root (or force hg-update-modeline (not hg-mode))) |
656 (parents |
704 (let ((status (hg-file-status buffer-file-name)) |
657 (split-string (hg-chomp |
705 (parents (hg-parents-for-mode-line root))) |
658 (hg-run0 "parents" "--template" "{rev}\n")) "\n"))) |
706 (hg-mode-line-internal status parents) |
659 (setq hg-status status |
707 status)))) |
660 hg-mode (and status (concat " Hg:" |
|
661 (mapconcat 'identity parents "+") |
|
662 (cdr (assq status |
|
663 '((normal . "") |
|
664 (removed . "r") |
|
665 (added . "a") |
|
666 (modified . "m"))))))) |
|
667 status))) |
|
668 |
708 |
669 (defun hg-mode (&optional toggle) |
709 (defun hg-mode (&optional toggle) |
670 "Minor mode for Mercurial distributed SCM integration. |
710 "Minor mode for Mercurial distributed SCM integration. |
671 |
711 |
672 The Mercurial mode user interface is based on that of VC mode, so if |
712 The Mercurial mode user interface is based on that of VC mode, so if |
842 (setq message (concat message "\n")) |
882 (setq message (concat message "\n")) |
843 (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files)) |
883 (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files)) |
844 (let ((buf hg-prev-buffer)) |
884 (let ((buf hg-prev-buffer)) |
845 (kill-buffer nil) |
885 (kill-buffer nil) |
846 (switch-to-buffer buf)) |
886 (switch-to-buffer buf)) |
847 (hg-do-across-repo root |
887 (hg-update-mode-lines root)))) |
848 (hg-mode-line))))) |
|
849 |
888 |
850 (defun hg-commit-mode () |
889 (defun hg-commit-mode () |
851 "Mode for describing a commit of changes to a Mercurial repository. |
890 "Mode for describing a commit of changes to a Mercurial repository. |
852 This involves two actions: describing the changes with a commit |
891 This involves two actions: describing the changes with a commit |
853 message, and choosing the files to commit. |
892 message, and choosing the files to commit. |