Mercurial > hg > mercurial-crew-with-dirclash
comparison contrib/mercurial.el @ 2988:65efeb7b2c56
mercurial.el: speed up mode line updates.
author | Bryan O'Sullivan <bos@serpentine.com> |
---|---|
date | Tue, 22 Aug 2006 14:02:43 -0700 |
parents | a7c4c7537999 |
children | 78fe7e2c2e1e |
comparison
equal
deleted
inserted
replaced
2987:a7c4c7537999 | 2988:65efeb7b2c56 |
---|---|
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. |