Mercurial > emacs
comparison lisp/vc.el @ 90261:7beb78bc1f8e
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-97
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 616-696)
- Add lisp/mh-e/.arch-inventory
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords.
- lisp/gnus/ChangeLog: Remove duplicate entry
* gnus--rel--5.10 (patch 147-181)
- Update from CVS
- Merge from emacs--cvs-trunk--0
- Update from CVS: lisp/mml.el (mml-preview): Doc fix.
- Update from CVS: texi/message.texi: Fix default values.
- Update from CVS: texi/gnus.texi (RSS): Addition.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 16 Jan 2006 08:37:27 +0000 |
parents | ee12d75eb214 e60b008e862d |
children | 7432ca837c8d |
comparison
equal
deleted
inserted
replaced
90260:0ca0d9181b5e | 90261:7beb78bc1f8e |
---|---|
467 (defgroup vc nil | 467 (defgroup vc nil |
468 "Version-control system in Emacs." | 468 "Version-control system in Emacs." |
469 :group 'tools) | 469 :group 'tools) |
470 | 470 |
471 (defcustom vc-suppress-confirm nil | 471 (defcustom vc-suppress-confirm nil |
472 "*If non-nil, treat user as expert; suppress yes-no prompts on some things." | 472 "If non-nil, treat user as expert; suppress yes-no prompts on some things." |
473 :type 'boolean | 473 :type 'boolean |
474 :group 'vc) | 474 :group 'vc) |
475 | 475 |
476 (defcustom vc-delete-logbuf-window t | 476 (defcustom vc-delete-logbuf-window t |
477 "*If non-nil, delete the *VC-log* buffer and window after each logical action. | 477 "If non-nil, delete the *VC-log* buffer and window after each logical action. |
478 If nil, bury that buffer instead. | 478 If nil, bury that buffer instead. |
479 This is most useful if you have multiple windows on a frame and would like to | 479 This is most useful if you have multiple windows on a frame and would like to |
480 preserve the setting." | 480 preserve the setting." |
481 :type 'boolean | 481 :type 'boolean |
482 :group 'vc) | 482 :group 'vc) |
483 | 483 |
484 (defcustom vc-initial-comment nil | 484 (defcustom vc-initial-comment nil |
485 "*If non-nil, prompt for initial comment when a file is registered." | 485 "If non-nil, prompt for initial comment when a file is registered." |
486 :type 'boolean | 486 :type 'boolean |
487 :group 'vc) | 487 :group 'vc) |
488 | 488 |
489 (defcustom vc-default-init-version "1.1" | 489 (defcustom vc-default-init-version "1.1" |
490 "*A string used as the default version number when a new file is registered. | 490 "A string used as the default version number when a new file is registered. |
491 This can be overridden by giving a prefix argument to \\[vc-register]. This | 491 This can be overridden by giving a prefix argument to \\[vc-register]. This |
492 can also be overridden by a particular VC backend." | 492 can also be overridden by a particular VC backend." |
493 :type 'string | 493 :type 'string |
494 :group 'vc | 494 :group 'vc |
495 :version "20.3") | 495 :version "20.3") |
496 | 496 |
497 (defcustom vc-command-messages nil | 497 (defcustom vc-command-messages nil |
498 "*If non-nil, display run messages from back-end commands." | 498 "If non-nil, display run messages from back-end commands." |
499 :type 'boolean | 499 :type 'boolean |
500 :group 'vc) | 500 :group 'vc) |
501 | 501 |
502 (defcustom vc-checkin-switches nil | 502 (defcustom vc-checkin-switches nil |
503 "*A string or list of strings specifying extra switches for checkin. | 503 "A string or list of strings specifying extra switches for checkin. |
504 These are passed to the checkin program by \\[vc-checkin]." | 504 These are passed to the checkin program by \\[vc-checkin]." |
505 :type '(choice (const :tag "None" nil) | 505 :type '(choice (const :tag "None" nil) |
506 (string :tag "Argument String") | 506 (string :tag "Argument String") |
507 (repeat :tag "Argument List" | 507 (repeat :tag "Argument List" |
508 :value ("") | 508 :value ("") |
509 string)) | 509 string)) |
510 :group 'vc) | 510 :group 'vc) |
511 | 511 |
512 (defcustom vc-checkout-switches nil | 512 (defcustom vc-checkout-switches nil |
513 "*A string or list of strings specifying extra switches for checkout. | 513 "A string or list of strings specifying extra switches for checkout. |
514 These are passed to the checkout program by \\[vc-checkout]." | 514 These are passed to the checkout program by \\[vc-checkout]." |
515 :type '(choice (const :tag "None" nil) | 515 :type '(choice (const :tag "None" nil) |
516 (string :tag "Argument String") | 516 (string :tag "Argument String") |
517 (repeat :tag "Argument List" | 517 (repeat :tag "Argument List" |
518 :value ("") | 518 :value ("") |
519 string)) | 519 string)) |
520 :group 'vc) | 520 :group 'vc) |
521 | 521 |
522 (defcustom vc-register-switches nil | 522 (defcustom vc-register-switches nil |
523 "*A string or list of strings; extra switches for registering a file. | 523 "A string or list of strings; extra switches for registering a file. |
524 These are passed to the checkin program by \\[vc-register]." | 524 These are passed to the checkin program by \\[vc-register]." |
525 :type '(choice (const :tag "None" nil) | 525 :type '(choice (const :tag "None" nil) |
526 (string :tag "Argument String") | 526 (string :tag "Argument String") |
527 (repeat :tag "Argument List" | 527 (repeat :tag "Argument List" |
528 :value ("") | 528 :value ("") |
529 string)) | 529 string)) |
530 :group 'vc) | 530 :group 'vc) |
531 | 531 |
532 (defcustom vc-dired-listing-switches "-al" | 532 (defcustom vc-dired-listing-switches "-al" |
533 "*Switches passed to `ls' for vc-dired. MUST contain the `l' option." | 533 "Switches passed to `ls' for vc-dired. MUST contain the `l' option." |
534 :type 'string | 534 :type 'string |
535 :group 'vc | 535 :group 'vc |
536 :version "21.1") | 536 :version "21.1") |
537 | 537 |
538 (defcustom vc-dired-recurse t | 538 (defcustom vc-dired-recurse t |
539 "*If non-nil, show directory trees recursively in VC Dired." | 539 "If non-nil, show directory trees recursively in VC Dired." |
540 :type 'boolean | 540 :type 'boolean |
541 :group 'vc | 541 :group 'vc |
542 :version "20.3") | 542 :version "20.3") |
543 | 543 |
544 (defcustom vc-dired-terse-display t | 544 (defcustom vc-dired-terse-display t |
545 "*If non-nil, show only locked files in VC Dired." | 545 "If non-nil, show only locked files in VC Dired." |
546 :type 'boolean | 546 :type 'boolean |
547 :group 'vc | 547 :group 'vc |
548 :version "20.3") | 548 :version "20.3") |
549 | 549 |
550 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn") | 550 (defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}") |
551 "*List of directory names to be ignored when walking directory trees." | 551 "List of directory names to be ignored when walking directory trees." |
552 :type '(repeat string) | 552 :type '(repeat string) |
553 :group 'vc) | 553 :group 'vc) |
554 | 554 |
555 (defcustom vc-diff-switches nil | 555 (defcustom vc-diff-switches nil |
556 "*A string or list of strings specifying switches for diff under VC. | 556 "A string or list of strings specifying switches for diff under VC. |
557 When running diff under a given BACKEND, VC concatenates the values of | 557 When running diff under a given BACKEND, VC concatenates the values of |
558 `diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to | 558 `diff-switches', `vc-diff-switches', and `vc-BACKEND-diff-switches' to |
559 get the switches for that command. Thus, `vc-diff-switches' should | 559 get the switches for that command. Thus, `vc-diff-switches' should |
560 contain switches that are specific to version control, but not | 560 contain switches that are specific to version control, but not |
561 specific to any particular backend." | 561 specific to any particular backend." |
566 string)) | 566 string)) |
567 :group 'vc | 567 :group 'vc |
568 :version "21.1") | 568 :version "21.1") |
569 | 569 |
570 (defcustom vc-allow-async-revert nil | 570 (defcustom vc-allow-async-revert nil |
571 "*Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous. | 571 "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous. |
572 Enabling this option means that you can confirm a revert operation even | 572 Enabling this option means that you can confirm a revert operation even |
573 if the local changes in the file have not been found and displayed yet." | 573 if the local changes in the file have not been found and displayed yet." |
574 :type '(choice (const :tag "No" nil) | 574 :type '(choice (const :tag "No" nil) |
575 (const :tag "Yes" t)) | 575 (const :tag "Yes" t)) |
576 :group 'vc | 576 :group 'vc |
577 :version "22.1") | 577 :version "22.1") |
578 | 578 |
579 ;;;###autoload | 579 ;;;###autoload |
580 (defcustom vc-checkout-hook nil | 580 (defcustom vc-checkout-hook nil |
581 "*Normal hook (list of functions) run after checking out a file. | 581 "Normal hook (list of functions) run after checking out a file. |
582 See `run-hooks'." | 582 See `run-hooks'." |
583 :type 'hook | 583 :type 'hook |
584 :group 'vc | 584 :group 'vc |
585 :version "21.1") | 585 :version "21.1") |
586 | 586 |
593 :value "20.5")) | 593 :value "20.5")) |
594 :group 'vc) | 594 :group 'vc) |
595 | 595 |
596 ;;;###autoload | 596 ;;;###autoload |
597 (defcustom vc-checkin-hook nil | 597 (defcustom vc-checkin-hook nil |
598 "*Normal hook (list of functions) run after a checkin is done. | 598 "Normal hook (list of functions) run after a checkin is done. |
599 See also `log-edit-done-hook'." | 599 See also `log-edit-done-hook'." |
600 :type 'hook | 600 :type 'hook |
601 :options '(log-edit-comment-to-change-log) | 601 :options '(log-edit-comment-to-change-log) |
602 :group 'vc) | 602 :group 'vc) |
603 | 603 |
604 ;;;###autoload | 604 ;;;###autoload |
605 (defcustom vc-before-checkin-hook nil | 605 (defcustom vc-before-checkin-hook nil |
606 "*Normal hook (list of functions) run before a file is checked in. | 606 "Normal hook (list of functions) run before a file is checked in. |
607 See `run-hooks'." | 607 See `run-hooks'." |
608 :type 'hook | 608 :type 'hook |
609 :group 'vc) | 609 :group 'vc) |
610 | 610 |
611 (defcustom vc-logentry-check-hook nil | 611 (defcustom vc-logentry-check-hook nil |
612 "*Normal hook run by `vc-backend-logentry-check'. | 612 "Normal hook run by `vc-backend-logentry-check'. |
613 Use this to impose your own rules on the entry in addition to any the | 613 Use this to impose your own rules on the entry in addition to any the |
614 version control backend imposes itself." | 614 version control backend imposes itself." |
615 :type 'hook | 615 :type 'hook |
616 :group 'vc) | 616 :group 'vc) |
617 | 617 |
632 (260. . "#66CC00") | 632 (260. . "#66CC00") |
633 (280. . "#33CC33") | 633 (280. . "#33CC33") |
634 (300. . "#00CCFF") | 634 (300. . "#00CCFF") |
635 (320. . "#00CC99") | 635 (320. . "#00CC99") |
636 (340. . "#0099FF")) | 636 (340. . "#0099FF")) |
637 "*Association list of age versus color, for \\[vc-annotate]. | 637 "Association list of age versus color, for \\[vc-annotate]. |
638 Ages are given in units of fractional days. Default is eighteen steps | 638 Ages are given in units of fractional days. Default is eighteen steps |
639 using a twenty day increment." | 639 using a twenty day increment." |
640 :type 'alist | 640 :type 'alist |
641 :group 'vc) | 641 :group 'vc) |
642 | 642 |
643 (defcustom vc-annotate-very-old-color "#0046FF" | 643 (defcustom vc-annotate-very-old-color "#0046FF" |
644 "*Color for lines older than the current color range in \\[vc-annotate]]." | 644 "Color for lines older than the current color range in \\[vc-annotate]]." |
645 :type 'string | 645 :type 'string |
646 :group 'vc) | 646 :group 'vc) |
647 | 647 |
648 (defcustom vc-annotate-background "black" | 648 (defcustom vc-annotate-background "black" |
649 "*Background color for \\[vc-annotate]. | 649 "Background color for \\[vc-annotate]. |
650 Default color is used if nil." | 650 Default color is used if nil." |
651 :type 'string | 651 :type 'string |
652 :group 'vc) | 652 :group 'vc) |
653 | 653 |
654 (defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01) | 654 (defcustom vc-annotate-menu-elements '(2 0.5 0.1 0.01) |
655 "*Menu elements for the mode-specific menu of VC-Annotate mode. | 655 "Menu elements for the mode-specific menu of VC-Annotate mode. |
656 List of factors, used to expand/compress the time scale. See `vc-annotate'." | 656 List of factors, used to expand/compress the time scale. See `vc-annotate'." |
657 :type '(repeat number) | 657 :type '(repeat number) |
658 :group 'vc) | 658 :group 'vc) |
659 | 659 |
660 (defvar vc-annotate-mode-map | 660 (defvar vc-annotate-mode-map |
661 (let ((m (make-sparse-keymap))) | 661 (let ((m (make-sparse-keymap))) |
662 (define-key m [menu-bar] (make-sparse-keymap "VC-Annotate")) | 662 (define-key m "A" 'vc-annotate-revision-previous-to-line) |
663 (define-key m "D" 'vc-annotate-show-diff-revision-at-line) | |
664 (define-key m "J" 'vc-annotate-revision-at-line) | |
665 (define-key m "L" 'vc-annotate-show-log-revision-at-line) | |
666 (define-key m "N" 'vc-annotate-next-version) | |
667 (define-key m "P" 'vc-annotate-prev-version) | |
668 (define-key m "W" 'vc-annotate-workfile-version) | |
663 m) | 669 m) |
664 "Local keymap used for VC-Annotate mode.") | 670 "Local keymap used for VC-Annotate mode.") |
665 | 671 |
666 (define-key vc-annotate-mode-map "A" 'vc-annotate-revision-previous-to-line) | |
667 (define-key vc-annotate-mode-map "D" 'vc-annotate-show-diff-revision-at-line) | |
668 (define-key vc-annotate-mode-map "J" 'vc-annotate-revision-at-line) | |
669 (define-key vc-annotate-mode-map "L" 'vc-annotate-show-log-revision-at-line) | |
670 (define-key vc-annotate-mode-map "N" 'vc-annotate-next-version) | |
671 (define-key vc-annotate-mode-map "P" 'vc-annotate-prev-version) | |
672 (define-key vc-annotate-mode-map "W" 'vc-annotate-workfile-version) | |
673 | |
674 (defvar vc-annotate-mode-menu nil | |
675 "Local keymap used for VC-Annotate mode's menu bar menu.") | |
676 | |
677 ;; Header-insertion hair | 672 ;; Header-insertion hair |
678 | 673 |
679 (defcustom vc-static-header-alist | 674 (defcustom vc-static-header-alist |
680 '(("\\.c$" . | 675 '(("\\.c\\'" . |
681 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) | 676 "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n")) |
682 "*Associate static header string templates with file types. | 677 "*Associate static header string templates with file types. |
683 A \%s in the template is replaced with the first string associated with | 678 A \%s in the template is replaced with the first string associated with |
684 the file's version control type in `vc-header-alist'." | 679 the file's version control type in `vc-header-alist'." |
685 :type '(repeat (cons :format "%v" | 680 :type '(repeat (cons :format "%v" |
711 | 706 |
712 | 707 |
713 ;; Variables the user doesn't need to know about. | 708 ;; Variables the user doesn't need to know about. |
714 (defvar vc-log-operation nil) | 709 (defvar vc-log-operation nil) |
715 (defvar vc-log-after-operation-hook nil) | 710 (defvar vc-log-after-operation-hook nil) |
716 (defvar vc-annotate-buffers nil | 711 |
717 "Alist of current \"Annotate\" buffers and their corresponding backends. | |
718 The keys are \(BUFFER . BACKEND\). See also `vc-annotate-get-backend'.") | |
719 ;; In a log entry buffer, this is a local variable | 712 ;; In a log entry buffer, this is a local variable |
720 ;; that points to the buffer for which it was made | 713 ;; that points to the buffer for which it was made |
721 ;; (either a file, or a VC dired buffer). | 714 ;; (either a file, or a VC dired buffer). |
722 (defvar vc-parent-buffer nil) | 715 (defvar vc-parent-buffer nil) |
723 (put 'vc-parent-buffer 'permanent-local t) | 716 (put 'vc-parent-buffer 'permanent-local t) |
760 (substring rev (match-beginning 0) (match-end 0))) | 753 (substring rev (match-beginning 0) (match-end 0))) |
761 | 754 |
762 (defun vc-default-previous-version (backend file rev) | 755 (defun vc-default-previous-version (backend file rev) |
763 "Return the version number immediately preceding REV for FILE, | 756 "Return the version number immediately preceding REV for FILE, |
764 or nil if there is no previous version. This default | 757 or nil if there is no previous version. This default |
765 implementation works for <major>.<minor>-style version numbers as | 758 implementation works for MAJOR.MINOR-style version numbers as |
766 used by RCS and CVS." | 759 used by RCS and CVS." |
767 (let ((branch (vc-branch-part rev)) | 760 (let ((branch (vc-branch-part rev)) |
768 (minor-num (string-to-number (vc-minor-part rev)))) | 761 (minor-num (string-to-number (vc-minor-part rev)))) |
769 (when branch | 762 (when branch |
770 (if (> minor-num 1) | 763 (if (> minor-num 1) |
779 (vc-branch-part branch)))))) | 772 (vc-branch-part branch)))))) |
780 | 773 |
781 (defun vc-default-next-version (backend file rev) | 774 (defun vc-default-next-version (backend file rev) |
782 "Return the version number immediately following REV for FILE, | 775 "Return the version number immediately following REV for FILE, |
783 or nil if there is no next version. This default implementation | 776 or nil if there is no next version. This default implementation |
784 works for <major>.<minor>-style version numbers as used by RCS | 777 works for MAJOR.MINOR-style version numbers as used by RCS |
785 and CVS." | 778 and CVS." |
786 (when (not (string= rev (vc-workfile-version file))) | 779 (when (not (string= rev (vc-workfile-version file))) |
787 (let ((branch (vc-branch-part rev)) | 780 (let ((branch (vc-branch-part rev)) |
788 (minor-num (string-to-number (vc-minor-part rev)))) | 781 (minor-num (string-to-number (vc-minor-part rev)))) |
789 (concat branch "." (number-to-string (1+ minor-num)))))) | 782 (concat branch "." (number-to-string (1+ minor-num)))))) |
928 "Execute a VC command, notifying user and checking for errors. | 921 "Execute a VC command, notifying user and checking for errors. |
929 Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the | 922 Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the |
930 current buffer if BUFFER is t. If the destination buffer is not | 923 current buffer if BUFFER is t. If the destination buffer is not |
931 already current, set it up properly and erase it. The command is | 924 already current, set it up properly and erase it. The command is |
932 considered successful if its exit status does not exceed OKSTATUS (if | 925 considered successful if its exit status does not exceed OKSTATUS (if |
933 OKSTATUS is nil, that means to ignore errors, if it is 'async, that | 926 OKSTATUS is nil, that means to ignore error status, if it is `async', that |
934 means not to wait for termination of the subprocess). FILE is the | 927 means not to wait for termination of the subprocess; if it is t it means to |
928 ignore all execution errors). FILE is the | |
935 name of the working file (may also be nil, to execute commands that | 929 name of the working file (may also be nil, to execute commands that |
936 don't expect a file name). If an optional list of FLAGS is present, | 930 don't expect a file name). If an optional list of FLAGS is present, |
937 that is inserted into the command line before the filename." | 931 that is inserted into the command line before the filename." |
938 (and file (setq file (expand-file-name file))) | 932 (and file (setq file (expand-file-name file))) |
939 (if vc-command-messages | 933 (if vc-command-messages |
974 (set-process-filter proc 'vc-process-filter) | 968 (set-process-filter proc 'vc-process-filter) |
975 (vc-exec-after | 969 (vc-exec-after |
976 `(unless (active-minibuffer-window) | 970 `(unless (active-minibuffer-window) |
977 (message "Running %s in the background... done" ',command)))) | 971 (message "Running %s in the background... done" ',command)))) |
978 (setq status (apply 'process-file command nil t nil squeezed)) | 972 (setq status (apply 'process-file command nil t nil squeezed)) |
979 (when (or (not (integerp status)) (and okstatus (< okstatus status))) | 973 (when (and (not (eq t okstatus)) |
974 (or (not (integerp status)) | |
975 (and okstatus (< okstatus status)))) | |
980 (pop-to-buffer (current-buffer)) | 976 (pop-to-buffer (current-buffer)) |
981 (goto-char (point-min)) | 977 (goto-char (point-min)) |
982 (shrink-window-if-larger-than-buffer) | 978 (shrink-window-if-larger-than-buffer) |
983 (error "Running %s...FAILED (%s)" command | 979 (error "Running %s...FAILED (%s)" command |
984 (if (integerp status) (format "status %d" status) status)))) | 980 (if (integerp status) (format "status %d" status) status)))) |
1362 (vc-next-action-on-file buffer-file-name verbose) | 1358 (vc-next-action-on-file buffer-file-name verbose) |
1363 (error "Buffer %s is not associated with a file" (buffer-name))))) | 1359 (error "Buffer %s is not associated with a file" (buffer-name))))) |
1364 | 1360 |
1365 ;; These functions help the vc-next-action entry point | 1361 ;; These functions help the vc-next-action entry point |
1366 | 1362 |
1363 (defun vc-default-init-version (backend) vc-default-init-version) | |
1364 | |
1367 ;;;###autoload | 1365 ;;;###autoload |
1368 (defun vc-register (&optional set-version comment) | 1366 (defun vc-register (&optional set-version comment) |
1369 "Register the current file into a version control system. | 1367 "Register the current file into a version control system. |
1370 With prefix argument SET-VERSION, allow user to specify initial version | 1368 With prefix argument SET-VERSION, allow user to specify initial version |
1371 level. If COMMENT is present, use that as an initial comment. | 1369 level. If COMMENT is present, use that as an initial comment. |
1393 | 1391 |
1394 (vc-start-entry buffer-file-name | 1392 (vc-start-entry buffer-file-name |
1395 (if set-version | 1393 (if set-version |
1396 (read-string (format "Initial version level for %s: " | 1394 (read-string (format "Initial version level for %s: " |
1397 (buffer-name))) | 1395 (buffer-name))) |
1398 (let ((backend (vc-responsible-backend buffer-file-name))) | 1396 (vc-call-backend (vc-responsible-backend buffer-file-name) |
1399 (if (vc-find-backend-function backend 'init-version) | 1397 'init-version)) |
1400 (vc-call-backend backend 'init-version) | |
1401 vc-default-init-version))) | |
1402 (or comment (not vc-initial-comment)) | 1398 (or comment (not vc-initial-comment)) |
1403 nil | 1399 nil |
1404 "Enter initial comment." | 1400 "Enter initial comment." |
1405 (lambda (file rev comment) | 1401 (lambda (file rev comment) |
1406 (message "Registering %s... " file) | 1402 (message "Registering %s... " file) |
1932 (save-excursion | 1928 (save-excursion |
1933 (save-restriction | 1929 (save-restriction |
1934 (widen) | 1930 (widen) |
1935 (if (or (not (vc-check-headers)) | 1931 (if (or (not (vc-check-headers)) |
1936 (y-or-n-p "Version headers already exist. Insert another set? ")) | 1932 (y-or-n-p "Version headers already exist. Insert another set? ")) |
1937 (progn | 1933 (let* ((delims (cdr (assq major-mode vc-comment-alist))) |
1938 (let* ((delims (cdr (assq major-mode vc-comment-alist))) | 1934 (comment-start-vc (or (car delims) comment-start "#")) |
1939 (comment-start-vc (or (car delims) comment-start "#")) | 1935 (comment-end-vc (or (car (cdr delims)) comment-end "")) |
1940 (comment-end-vc (or (car (cdr delims)) comment-end "")) | 1936 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name) |
1941 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name) | 1937 'header)) |
1942 'header)) | 1938 (hdstrings (and (boundp hdsym) (symbol-value hdsym)))) |
1943 (hdstrings (and (boundp hdsym) (symbol-value hdsym)))) | 1939 (dolist (s hdstrings) |
1944 (mapcar (lambda (s) | 1940 (insert comment-start-vc "\t" s "\t" |
1945 (insert comment-start-vc "\t" s "\t" | 1941 comment-end-vc "\n")) |
1946 comment-end-vc "\n")) | 1942 (if vc-static-header-alist |
1947 hdstrings) | 1943 (dolist (f vc-static-header-alist) |
1948 (if vc-static-header-alist | 1944 (if (string-match (car f) buffer-file-name) |
1949 (mapcar (lambda (f) | 1945 (insert (format (cdr f) (car hdstrings))))))))))) |
1950 (if (string-match (car f) buffer-file-name) | |
1951 (insert (format (cdr f) (car hdstrings))))) | |
1952 vc-static-header-alist)) | |
1953 ) | |
1954 ))))) | |
1955 | 1946 |
1956 (defun vc-clear-headers (&optional file) | 1947 (defun vc-clear-headers (&optional file) |
1957 "Clear all version headers in the current buffer (or FILE). | 1948 "Clear all version headers in the current buffer (or FILE). |
1958 The headers are reset to their non-expanded form." | 1949 The headers are reset to their non-expanded form." |
1959 (let* ((filename (or file buffer-file-name)) | 1950 (let* ((filename (or file buffer-file-name)) |
2059 ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20. | 2050 ;; define-derived-mode does it for us in Emacs-21, but not in Emacs-20. |
2060 ;; We do it here because dired might not be loaded yet | 2051 ;; We do it here because dired might not be loaded yet |
2061 ;; when vc-dired-mode-map is initialized. | 2052 ;; when vc-dired-mode-map is initialized. |
2062 (set-keymap-parent vc-dired-mode-map dired-mode-map) | 2053 (set-keymap-parent vc-dired-mode-map dired-mode-map) |
2063 (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t) | 2054 (add-hook 'dired-after-readin-hook 'vc-dired-hook nil t) |
2064 ;; The following is slightly modified from dired.el, | 2055 ;; The following is slightly modified from files.el, |
2065 ;; because file lines look a bit different in vc-dired-mode | 2056 ;; because file lines look a bit different in vc-dired-mode |
2066 ;; (the column before the date does not end in a digit). | 2057 ;; (the column before the date does not end in a digit). |
2067 (set (make-local-variable 'dired-move-to-filename-regexp) | 2058 ;; albinus: It should be done in the original declaration. Problem |
2059 ;; is the optional empty state-info; otherwise ")" would be good | |
2060 ;; enough as delimeter. | |
2061 (set (make-local-variable 'directory-listing-before-filename-regexp) | |
2068 (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") | 2062 (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)") |
2069 ;; In some locales, month abbreviations are as short as 2 letters, | 2063 ;; In some locales, month abbreviations are as short as 2 letters, |
2070 ;; and they can be followed by ".". | 2064 ;; and they can be followed by ".". |
2071 (month (concat l l "+\\.?")) | 2065 (month (concat l l "+\\.?")) |
2072 (s " ") | 2066 (s " ") |
2521 ;; there is no automatic backup, but maybe the user made one manually | 2515 ;; there is no automatic backup, but maybe the user made one manually |
2522 (setq backup-file (vc-version-backup-file-name file rev 'manual)) | 2516 (setq backup-file (vc-version-backup-file-name file rev 'manual)) |
2523 (if (file-exists-p backup-file) | 2517 (if (file-exists-p backup-file) |
2524 backup-file))))) | 2518 backup-file))))) |
2525 | 2519 |
2520 (defun vc-default-revert (backend file contents-done) | |
2521 (unless contents-done | |
2522 (let ((rev (vc-workfile-version file)) | |
2523 (file-buffer (or (get-file-buffer file) (current-buffer)))) | |
2524 (message "Checking out %s..." file) | |
2525 (let ((failed t) | |
2526 (backup-name (car (find-backup-file-name file)))) | |
2527 (when backup-name | |
2528 (copy-file file backup-name 'ok-if-already-exists 'keep-date) | |
2529 (unless (file-writable-p file) | |
2530 (set-file-modes file (logior (file-modes file) 128)))) | |
2531 (unwind-protect | |
2532 (let ((coding-system-for-read 'no-conversion) | |
2533 (coding-system-for-write 'no-conversion)) | |
2534 (with-temp-file file | |
2535 (let ((outbuf (current-buffer))) | |
2536 ;; Change buffer to get local value of vc-checkout-switches. | |
2537 (with-current-buffer file-buffer | |
2538 (let ((default-directory (file-name-directory file))) | |
2539 (vc-call find-version file rev outbuf))))) | |
2540 (setq failed nil)) | |
2541 (when backup-name | |
2542 (if failed | |
2543 (rename-file backup-name file 'ok-if-already-exists) | |
2544 (and (not vc-make-backup-files) (delete-file backup-name)))))) | |
2545 (message "Checking out %s...done" file)))) | |
2546 | |
2526 (defun vc-revert-file (file) | 2547 (defun vc-revert-file (file) |
2527 "Revert FILE back to the version it was based on." | 2548 "Revert FILE back to the version it was based on." |
2528 (with-vc-properties | 2549 (with-vc-properties |
2529 file | 2550 file |
2530 (let ((backup-file (vc-version-backup-file file))) | 2551 (let ((backup-file (vc-version-backup-file file))) |
2591 VC's perspective on FILE, it does not register or unregister it. | 2612 VC's perspective on FILE, it does not register or unregister it. |
2592 By default, this command cycles through the registered backends. | 2613 By default, this command cycles through the registered backends. |
2593 To get a prompt, use a prefix argument." | 2614 To get a prompt, use a prefix argument." |
2594 (interactive | 2615 (interactive |
2595 (list | 2616 (list |
2596 buffer-file-name | 2617 (or buffer-file-name |
2618 (error "There is no version-controlled file in this buffer")) | |
2597 (let ((backend (vc-backend buffer-file-name)) | 2619 (let ((backend (vc-backend buffer-file-name)) |
2598 (backends nil)) | 2620 (backends nil)) |
2621 (unless backend | |
2622 (error "File %s is not under version control" buffer-file-name)) | |
2599 ;; Find the registered backends. | 2623 ;; Find the registered backends. |
2600 (dolist (backend vc-handled-backends) | 2624 (dolist (backend vc-handled-backends) |
2601 (when (vc-call-backend backend 'registered buffer-file-name) | 2625 (when (vc-call-backend backend 'registered buffer-file-name) |
2602 (push backend backends))) | 2626 (push backend backends))) |
2603 ;; Find the next backend. | 2627 ;; Find the next backend. |
2859 (if (file-name-absolute-p f) | 2883 (if (file-name-absolute-p f) |
2860 f | 2884 f |
2861 (concat odefault f)))) | 2885 (concat odefault f)))) |
2862 files))) | 2886 files))) |
2863 "done" | 2887 "done" |
2864 (pop-to-buffer | 2888 (pop-to-buffer (get-buffer-create "*vc*")) |
2865 (set-buffer (get-buffer-create "*vc*"))) | |
2866 (erase-buffer) | 2889 (erase-buffer) |
2867 (insert-file-contents tempfile) | 2890 (insert-file-contents tempfile) |
2868 "failed")) | 2891 "failed")) |
2869 (setq default-directory (file-name-directory changelog)) | 2892 (setq default-directory (file-name-directory changelog)) |
2870 (delete-file tempfile))))) | 2893 (delete-file tempfile))))) |
2875 ;; temp-buffer-show-function (not possible to pass more than one | 2898 ;; temp-buffer-show-function (not possible to pass more than one |
2876 ;; parameter). The use of annotate-ratio is deprecated in favor of | 2899 ;; parameter). The use of annotate-ratio is deprecated in favor of |
2877 ;; annotate-mode, which replaces it with the more sensible "span-to | 2900 ;; annotate-mode, which replaces it with the more sensible "span-to |
2878 ;; days", along with autoscaling support. | 2901 ;; days", along with autoscaling support. |
2879 (defvar vc-annotate-ratio nil "Global variable.") | 2902 (defvar vc-annotate-ratio nil "Global variable.") |
2880 (defvar vc-annotate-backend nil "Global variable.") | |
2881 | 2903 |
2882 ;; internal buffer-local variables | 2904 ;; internal buffer-local variables |
2905 (defvar vc-annotate-backend nil) | |
2883 (defvar vc-annotate-parent-file nil) | 2906 (defvar vc-annotate-parent-file nil) |
2884 (defvar vc-annotate-parent-rev nil) | 2907 (defvar vc-annotate-parent-rev nil) |
2885 (defvar vc-annotate-parent-display-mode nil) | 2908 (defvar vc-annotate-parent-display-mode nil) |
2886 | 2909 |
2887 (defconst vc-annotate-font-lock-keywords | 2910 (defconst vc-annotate-font-lock-keywords |
2888 ;; The fontification is done by vc-annotate-lines instead of font-lock. | 2911 ;; The fontification is done by vc-annotate-lines instead of font-lock. |
2889 '((vc-annotate-lines))) | 2912 '((vc-annotate-lines))) |
2890 | |
2891 (defun vc-annotate-get-backend (buffer) | |
2892 "Return the backend matching \"Annotate\" buffer BUFFER. | |
2893 Return nil if no match made. Associations are made based on | |
2894 `vc-annotate-buffers'." | |
2895 (cdr (assoc buffer vc-annotate-buffers))) | |
2896 | 2913 |
2897 (define-derived-mode vc-annotate-mode fundamental-mode "Annotate" | 2914 (define-derived-mode vc-annotate-mode fundamental-mode "Annotate" |
2898 "Major mode for output buffers of the `vc-annotate' command. | 2915 "Major mode for output buffers of the `vc-annotate' command. |
2899 | 2916 |
2900 You can use the mode-specific menu to alter the time-span of the used | 2917 You can use the mode-specific menu to alter the time-span of the used |
2901 colors. See variable `vc-annotate-menu-elements' for customizing the | 2918 colors. See variable `vc-annotate-menu-elements' for customizing the |
2902 menu items." | 2919 menu items." |
2903 (set (make-local-variable 'truncate-lines) t) | 2920 (set (make-local-variable 'truncate-lines) t) |
2904 (set (make-local-variable 'font-lock-defaults) | 2921 (set (make-local-variable 'font-lock-defaults) |
2905 '(vc-annotate-font-lock-keywords t)) | 2922 '(vc-annotate-font-lock-keywords t)) |
2906 (view-mode 1) | 2923 (view-mode 1)) |
2907 (vc-annotate-add-menu)) | 2924 |
2908 | 2925 (defun vc-annotate-display-default (ratio) |
2909 (defun vc-annotate-display-default (&optional ratio) | |
2910 "Display the output of \\[vc-annotate] using the default color range. | 2926 "Display the output of \\[vc-annotate] using the default color range. |
2911 The color range is given by `vc-annotate-color-map', scaled by RATIO | 2927 The color range is given by `vc-annotate-color-map', scaled by RATIO. |
2912 if present. The current time is used as the offset." | 2928 The current time is used as the offset." |
2913 (interactive "e") | 2929 (interactive (progn (kill-local-variable 'vc-annotate-color-map) '(1.0))) |
2914 (message "Redisplaying annotation...") | 2930 (message "Redisplaying annotation...") |
2915 (vc-annotate-display | 2931 (vc-annotate-display ratio) |
2916 (if ratio (vc-annotate-time-span vc-annotate-color-map ratio))) | |
2917 (message "Redisplaying annotation...done")) | 2932 (message "Redisplaying annotation...done")) |
2933 | |
2934 (defun vc-annotate-oldest-in-map (color-map) | |
2935 "Return the oldest time in the COLOR-MAP." | |
2936 ;; Since entries should be sorted, we can just use the last one. | |
2937 (caar (last color-map))) | |
2918 | 2938 |
2919 (defun vc-annotate-display-autoscale (&optional full) | 2939 (defun vc-annotate-display-autoscale (&optional full) |
2920 "Highlight the output of \\[vc-annotate] using an autoscaled color map. | 2940 "Highlight the output of \\[vc-annotate] using an autoscaled color map. |
2921 Autoscaling means that the map is scaled from the current time to the | 2941 Autoscaling means that the map is scaled from the current time to the |
2922 oldest annotation in the buffer, or, with prefix argument FULL, to | 2942 oldest annotation in the buffer, or, with prefix argument FULL, to |
2936 (if (> date newest) | 2956 (if (> date newest) |
2937 (setq newest date)) | 2957 (setq newest date)) |
2938 (if (< date oldest) | 2958 (if (< date oldest) |
2939 (setq oldest date)))) | 2959 (setq oldest date)))) |
2940 (vc-annotate-display | 2960 (vc-annotate-display |
2941 (vc-annotate-time-span ;return the scaled colormap. | 2961 (/ (- (if full newest current) oldest) |
2942 vc-annotate-color-map | 2962 (vc-annotate-oldest-in-map vc-annotate-color-map)) |
2943 (/ (- (if full newest current) oldest) | |
2944 (vc-annotate-car-last-cons vc-annotate-color-map))) | |
2945 (if full newest)) | 2963 (if full newest)) |
2946 (message "Redisplaying annotation...done \(%s\)" | 2964 (message "Redisplaying annotation...done \(%s\)" |
2947 (if full | 2965 (if full |
2948 (format "Spanned from %.1f to %.1f days old" | 2966 (format "Spanned from %.1f to %.1f days old" |
2949 (- current oldest) | 2967 (- current oldest) |
2950 (- current newest)) | 2968 (- current newest)) |
2951 (format "Spanned to %.1f days old" (- current oldest)))))) | 2969 (format "Spanned to %.1f days old" (- current oldest)))))) |
2952 | 2970 |
2953 ;; Menu -- Using easymenu.el | 2971 ;; Menu -- Using easymenu.el |
2954 (defun vc-annotate-add-menu () | 2972 (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map |
2955 "Add the menu 'Annotate' to the menu bar in VC-Annotate mode." | 2973 "VC Annotate Display Menu" |
2956 (let ((menu-elements vc-annotate-menu-elements) | 2974 `("VC-Annotate" |
2957 (menu-def | 2975 ["Default" (unless (null vc-annotate-display-mode) |
2958 '("VC-Annotate" | 2976 (setq vc-annotate-display-mode nil) |
2959 ["Default" (unless (null vc-annotate-display-mode) | 2977 (vc-annotate-display-select)) |
2960 (setq vc-annotate-display-mode nil) | 2978 :style toggle :selected (null vc-annotate-display-mode)] |
2961 (vc-annotate-display-select)) | 2979 ,@(let ((oldest-in-map (vc-annotate-oldest-in-map vc-annotate-color-map))) |
2962 :style toggle :selected (null vc-annotate-display-mode)])) | 2980 (mapcar (lambda (element) |
2963 (oldest-in-map (vc-annotate-car-last-cons vc-annotate-color-map))) | 2981 (let ((days (* element oldest-in-map))) |
2964 (while menu-elements | 2982 `[,(format "Span %.1f days" days) |
2965 (let* ((element (car menu-elements)) | 2983 (vc-annotate-display-select nil ,days) |
2966 (days (* element oldest-in-map))) | 2984 :style toggle :selected |
2967 (setq menu-elements (cdr menu-elements)) | 2985 (eql vc-annotate-display-mode ,days) ])) |
2968 (setq menu-def | 2986 vc-annotate-menu-elements)) |
2969 (append menu-def | 2987 ["Span ..." |
2970 `([,(format "Span %.1f days" days) | 2988 (vc-annotate-display-select |
2971 (unless (and (numberp vc-annotate-display-mode) | 2989 nil (float (string-to-number (read-string "Span how many days? "))))] |
2972 (= vc-annotate-display-mode ,days)) | 2990 "--" |
2973 (vc-annotate-display-select nil ,days)) | 2991 ["Span to Oldest" |
2974 :style toggle :selected | 2992 (unless (eq vc-annotate-display-mode 'scale) |
2975 (and (numberp vc-annotate-display-mode) | 2993 (vc-annotate-display-select nil 'scale)) |
2976 (= vc-annotate-display-mode ,days)) ]))))) | 2994 :style toggle :selected |
2977 (setq menu-def | 2995 (eq vc-annotate-display-mode 'scale)] |
2978 (append menu-def | 2996 ["Span Oldest->Newest" |
2979 (list | 2997 (unless (eq vc-annotate-display-mode 'fullscale) |
2980 ["Span ..." | 2998 (vc-annotate-display-select nil 'fullscale)) |
2981 (let ((days | 2999 :style toggle :selected |
2982 (float (string-to-number | 3000 (eq vc-annotate-display-mode 'fullscale)] |
2983 (read-string "Span how many days? "))))) | 3001 "--" |
2984 (vc-annotate-display-select nil days)) t]) | 3002 ["Annotate previous revision" vc-annotate-prev-version] |
2985 (list "--") | 3003 ["Annotate next revision" vc-annotate-next-version] |
2986 (list | 3004 ["Annotate revision at line" vc-annotate-revision-at-line] |
2987 ["Span to Oldest" | 3005 ["Annotate revision previous to line" vc-annotate-revision-previous-to-line] |
2988 (unless (eq vc-annotate-display-mode 'scale) | 3006 ["Annotate latest revision" vc-annotate-workfile-version] |
2989 (vc-annotate-display-select nil 'scale)) | 3007 ["Show log of revision at line" vc-annotate-show-log-revision-at-line] |
2990 :style toggle :selected | 3008 ["Show diff of revision at line" vc-annotate-show-diff-revision-at-line])) |
2991 (eq vc-annotate-display-mode 'scale)]) | |
2992 (list | |
2993 ["Span Oldest->Newest" | |
2994 (unless (eq vc-annotate-display-mode 'fullscale) | |
2995 (vc-annotate-display-select nil 'fullscale)) | |
2996 :style toggle :selected | |
2997 (eq vc-annotate-display-mode 'fullscale)]) | |
2998 (list "--") | |
2999 (list ["Annotate previous revision" | |
3000 (call-interactively 'vc-annotate-prev-version)]) | |
3001 (list ["Annotate next revision" | |
3002 (call-interactively 'vc-annotate-next-version)]) | |
3003 (list ["Annotate revision at line" | |
3004 (vc-annotate-revision-at-line)]) | |
3005 (list ["Annotate revision previous to line" | |
3006 (vc-annotate-revision-previous-to-line)]) | |
3007 (list ["Annotate latest revision" | |
3008 (vc-annotate-workfile-version)]) | |
3009 (list ["Show log of revision at line" | |
3010 (vc-annotate-show-log-revision-at-line)]) | |
3011 (list ["Show diff of revision at line" | |
3012 (vc-annotate-show-diff-revision-at-line)]))) | |
3013 | |
3014 ;; Define the menu | |
3015 (if (or (featurep 'easymenu) (load "easymenu" t)) | |
3016 (easy-menu-define vc-annotate-mode-menu vc-annotate-mode-map | |
3017 "VC Annotate Display Menu" menu-def)))) | |
3018 | 3009 |
3019 (defun vc-annotate-display-select (&optional buffer mode) | 3010 (defun vc-annotate-display-select (&optional buffer mode) |
3020 "Highlight the output of \\[vc-annotate]. | 3011 "Highlight the output of \\[vc-annotate]. |
3021 By default, the current buffer is highlighted, unless overridden by | 3012 By default, the current buffer is highlighted, unless overridden by |
3022 BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to | 3013 BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to |
3027 (set-buffer buffer) | 3018 (set-buffer buffer) |
3028 (display-buffer buffer)) | 3019 (display-buffer buffer)) |
3029 (if (not vc-annotate-parent-rev) | 3020 (if (not vc-annotate-parent-rev) |
3030 (vc-annotate-mode)) | 3021 (vc-annotate-mode)) |
3031 (cond ((null vc-annotate-display-mode) | 3022 (cond ((null vc-annotate-display-mode) |
3032 (vc-annotate-display-default vc-annotate-ratio)) | 3023 ;; The ratio is global, thus relative to the global color-map. |
3033 ;; One of the auto-scaling modes | 3024 (kill-local-variable 'vc-annotate-color-map) |
3025 (vc-annotate-display-default (or vc-annotate-ratio 1.0))) | |
3026 ;; One of the auto-scaling modes | |
3034 ((eq vc-annotate-display-mode 'scale) | 3027 ((eq vc-annotate-display-mode 'scale) |
3035 (vc-annotate-display-autoscale)) | 3028 (vc-annotate-display-autoscale)) |
3036 ((eq vc-annotate-display-mode 'fullscale) | 3029 ((eq vc-annotate-display-mode 'fullscale) |
3037 (vc-annotate-display-autoscale t)) | 3030 (vc-annotate-display-autoscale t)) |
3038 ((numberp vc-annotate-display-mode) ; A fixed number of days lookback | 3031 ((numberp vc-annotate-display-mode) ; A fixed number of days lookback |
3039 (vc-annotate-display-default | 3032 (vc-annotate-display-default |
3040 (/ vc-annotate-display-mode (vc-annotate-car-last-cons | 3033 (/ vc-annotate-display-mode |
3041 vc-annotate-color-map)))) | 3034 (vc-annotate-oldest-in-map vc-annotate-color-map)))) |
3042 (t (error "No such display mode: %s" | 3035 (t (error "No such display mode: %s" |
3043 vc-annotate-display-mode)))) | 3036 vc-annotate-display-mode)))) |
3044 | 3037 |
3045 ;;;; (defun vc-BACKEND-annotate-command (file buffer) ...) | |
3046 ;;;; Execute "annotate" on FILE by using `call-process' and insert | |
3047 ;;;; the contents in BUFFER. | |
3048 | |
3049 ;;;###autoload | 3038 ;;;###autoload |
3050 (defun vc-annotate (prefix &optional revision display-mode) | 3039 (defun vc-annotate (file rev &optional display-mode buf) |
3051 "Display the edit history of the current file using colors. | 3040 "Display the edit history of the current file using colors. |
3052 | 3041 |
3053 This command creates a buffer that shows, for each line of the current | 3042 This command creates a buffer that shows, for each line of the current |
3054 file, when it was last edited and by whom. Additionally, colors are | 3043 file, when it was last edited and by whom. Additionally, colors are |
3055 used to show the age of each line--blue means oldest, red means | 3044 used to show the age of each line--blue means oldest, red means |
3070 | 3059 |
3071 `vc-annotate-menu-elements' customizes the menu elements of the | 3060 `vc-annotate-menu-elements' customizes the menu elements of the |
3072 mode-specific menu. `vc-annotate-color-map' and | 3061 mode-specific menu. `vc-annotate-color-map' and |
3073 `vc-annotate-very-old-color' defines the mapping of time to | 3062 `vc-annotate-very-old-color' defines the mapping of time to |
3074 colors. `vc-annotate-background' specifies the background color." | 3063 colors. `vc-annotate-background' specifies the background color." |
3075 (interactive "P") | 3064 (interactive |
3065 (save-current-buffer | |
3066 (vc-ensure-vc-buffer) | |
3067 (list buffer-file-name | |
3068 (let ((def (vc-workfile-version buffer-file-name))) | |
3069 (if (null current-prefix-arg) def | |
3070 (read-string | |
3071 (format "Annotate from version (default %s): " def) | |
3072 nil nil def))) | |
3073 (if (null current-prefix-arg) | |
3074 vc-annotate-display-mode | |
3075 (float (string-to-number | |
3076 (read-string "Annotate span days (default 20): " | |
3077 nil nil "20"))))))) | |
3076 (vc-ensure-vc-buffer) | 3078 (vc-ensure-vc-buffer) |
3077 (let* ((temp-buffer-name nil) | 3079 (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef |
3078 (temp-buffer-show-function 'vc-annotate-display-select) | 3080 (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev)) |
3079 (rev (or revision (vc-workfile-version buffer-file-name))) | 3081 (temp-buffer-show-function 'vc-annotate-display-select)) |
3080 (bfn buffer-file-name) | |
3081 (vc-annotate-version | |
3082 (if prefix (read-string | |
3083 (format "Annotate from version (default %s): " rev) | |
3084 nil nil rev) | |
3085 rev))) | |
3086 (if display-mode | |
3087 (setq vc-annotate-display-mode display-mode) | |
3088 (if prefix | |
3089 (setq vc-annotate-display-mode | |
3090 (float (string-to-number | |
3091 (read-string "Annotate span days (default 20): " | |
3092 nil nil "20")))))) | |
3093 (setq temp-buffer-name (format "*Annotate %s (rev %s)*" | |
3094 (buffer-name) vc-annotate-version)) | |
3095 (setq vc-annotate-backend (vc-backend buffer-file-name)) | |
3096 (message "Annotating...") | 3082 (message "Annotating...") |
3097 (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command)) | 3083 ;; If BUF is specified it tells in which buffer we should put the |
3098 (error "Sorry, annotating is not implemented for %s" | 3084 ;; annotations. This is used when switching annotations to another |
3099 vc-annotate-backend)) | 3085 ;; revision, so we should update the buffer's name. |
3086 (if buf (with-current-buffer buf | |
3087 (rename-buffer temp-buffer-name t) | |
3088 ;; In case it had to be uniquified. | |
3089 (setq temp-buffer-name (buffer-name)))) | |
3100 (with-output-to-temp-buffer temp-buffer-name | 3090 (with-output-to-temp-buffer temp-buffer-name |
3101 (vc-call-backend vc-annotate-backend 'annotate-command | 3091 (vc-call annotate-command file (get-buffer temp-buffer-name) rev)) |
3102 buffer-file-name | 3092 (with-current-buffer temp-buffer-name |
3103 (get-buffer temp-buffer-name) | 3093 (set (make-local-variable 'vc-annotate-backend) (vc-backend file)) |
3104 vc-annotate-version)) | 3094 (set (make-local-variable 'vc-annotate-parent-file) file) |
3105 (save-excursion | 3095 (set (make-local-variable 'vc-annotate-parent-rev) rev) |
3106 (set-buffer temp-buffer-name) | |
3107 (set (make-local-variable 'vc-annotate-parent-file) bfn) | |
3108 (set (make-local-variable 'vc-annotate-parent-rev) vc-annotate-version) | |
3109 (set (make-local-variable 'vc-annotate-parent-display-mode) | 3096 (set (make-local-variable 'vc-annotate-parent-display-mode) |
3110 vc-annotate-display-mode)) | 3097 display-mode)) |
3111 | 3098 |
3112 ;; Don't use the temp-buffer-name until the buffer is created | |
3113 ;; (only after `with-output-to-temp-buffer'.) | |
3114 (setq vc-annotate-buffers | |
3115 (append vc-annotate-buffers | |
3116 (list (cons (get-buffer temp-buffer-name) vc-annotate-backend)))) | |
3117 (message "Annotating... done"))) | 3099 (message "Annotating... done"))) |
3118 | 3100 |
3119 (defun vc-annotate-prev-version (prefix) | 3101 (defun vc-annotate-prev-version (prefix) |
3120 "Visit the annotation of the version previous to this one. | 3102 "Visit the annotation of the version previous to this one. |
3121 | 3103 |
3143 (vc-annotate-warp-version warp-rev))))) | 3125 (vc-annotate-warp-version warp-rev))))) |
3144 | 3126 |
3145 (defun vc-annotate-extract-revision-at-line () | 3127 (defun vc-annotate-extract-revision-at-line () |
3146 "Extract the revision number of the current line." | 3128 "Extract the revision number of the current line." |
3147 ;; This function must be invoked from a buffer in vc-annotate-mode | 3129 ;; This function must be invoked from a buffer in vc-annotate-mode |
3148 (save-window-excursion | |
3149 (vc-ensure-vc-buffer) | |
3150 (setq vc-annotate-backend (vc-backend buffer-file-name))) | |
3151 (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line)) | 3130 (vc-call-backend vc-annotate-backend 'annotate-extract-revision-at-line)) |
3152 | 3131 |
3153 (defun vc-annotate-revision-at-line () | 3132 (defun vc-annotate-revision-at-line () |
3154 "Visit the annotation of the version identified in the current line." | 3133 "Visit the annotation of the version identified in the current line." |
3155 (interactive) | 3134 (interactive) |
3236 (message "Cannot decrement %d versions from version %s" | 3215 (message "Cannot decrement %d versions from version %s" |
3237 (- 0 revspeccopy) vc-annotate-parent-rev))) | 3216 (- 0 revspeccopy) vc-annotate-parent-rev))) |
3238 ((stringp revspec) (setq newrev revspec)) | 3217 ((stringp revspec) (setq newrev revspec)) |
3239 (t (error "Invalid argument to vc-annotate-warp-version"))) | 3218 (t (error "Invalid argument to vc-annotate-warp-version"))) |
3240 (when newrev | 3219 (when newrev |
3241 (save-window-excursion | 3220 (vc-annotate vc-annotate-parent-file newrev |
3242 (find-file vc-annotate-parent-file) | 3221 vc-annotate-parent-display-mode |
3243 (vc-annotate nil newrev vc-annotate-parent-display-mode)) | 3222 (current-buffer)) |
3244 (kill-buffer (current-buffer)) ;; kill the buffer we started from | |
3245 (switch-to-buffer (car (car (last vc-annotate-buffers)))) | |
3246 (goto-line (min oldline (progn (goto-char (point-max)) | 3223 (goto-line (min oldline (progn (goto-char (point-max)) |
3247 (previous-line) | 3224 (previous-line) |
3248 (line-number-at-pos)))))))) | 3225 (line-number-at-pos)))))))) |
3249 | |
3250 (defun vc-annotate-car-last-cons (a-list) | |
3251 "Return car of last cons in association list A-LIST." | |
3252 (if (not (eq nil (cdr a-list))) | |
3253 (vc-annotate-car-last-cons (cdr a-list)) | |
3254 (car (car a-list)))) | |
3255 | |
3256 (defun vc-annotate-time-span (a-list span &optional quantize) | |
3257 "Apply factor SPAN to the time-span of association list A-LIST. | |
3258 Return the new alist. | |
3259 Optionally quantize to the factor of QUANTIZE." | |
3260 ;; Apply span to each car of every cons | |
3261 (if (not (eq nil a-list)) | |
3262 (append (list (cons (* (car (car a-list)) span) | |
3263 (cdr (car a-list)))) | |
3264 (vc-annotate-time-span (nthcdr (or quantize ; optional | |
3265 1) ; Default to cdr | |
3266 a-list) span quantize)))) | |
3267 | 3226 |
3268 (defun vc-annotate-compcar (threshold a-list) | 3227 (defun vc-annotate-compcar (threshold a-list) |
3269 "Test successive cons cells of A-LIST against THRESHOLD. | 3228 "Test successive cons cells of A-LIST against THRESHOLD. |
3270 Return the first cons cell with a car that is not less than THRESHOLD, | 3229 Return the first cons cell with a car that is not less than THRESHOLD, |
3271 nil if no such cell exists." | 3230 nil if no such cell exists." |
3297 "Return the current time, encoded as fractional days." | 3256 "Return the current time, encoded as fractional days." |
3298 (vc-annotate-convert-time (current-time))) | 3257 (vc-annotate-convert-time (current-time))) |
3299 | 3258 |
3300 (defvar vc-annotate-offset nil) | 3259 (defvar vc-annotate-offset nil) |
3301 | 3260 |
3302 (defun vc-annotate-display (&optional color-map offset) | 3261 (defun vc-annotate-display (ratio &optional offset) |
3303 "Highlight `vc-annotate' output in the current buffer. | 3262 "Highlight `vc-annotate' output in the current buffer. |
3304 COLOR-MAP, if present, overrides `vc-annotate-color-map'. | 3263 RATIO, is the expansion that should be applied to `vc-annotate-color-map'. |
3305 The annotations are relative to the current time, unless overridden by OFFSET." | 3264 The annotations are relative to the current time, unless overridden by OFFSET." |
3306 (if (and color-map (not (eq color-map vc-annotate-color-map))) | 3265 (if (/= ratio 1.0) |
3307 (set (make-local-variable 'vc-annotate-color-map) color-map)) | 3266 (set (make-local-variable 'vc-annotate-color-map) |
3267 (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem))) | |
3268 vc-annotate-color-map))) | |
3308 (set (make-local-variable 'vc-annotate-offset) offset) | 3269 (set (make-local-variable 'vc-annotate-offset) offset) |
3309 (font-lock-mode 1)) | 3270 (font-lock-mode 1)) |
3310 | 3271 |
3311 (defun vc-annotate-lines (limit) | 3272 (defun vc-annotate-lines (limit) |
3312 (let (difference) | 3273 (let (difference) |