Mercurial > emacs
comparison lisp/vc-rcs.el @ 83228:2a3f27a45698
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-694
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-695
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-696
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-697
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-698
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-699
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-700
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-701
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-702
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-703
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-704
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-705
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-706
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-707
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-708
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-709
Update from CVS: src/indent.c (Fvertical_motion): Fix last change.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-710
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-711
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-712
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-713
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-72
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-73
Merge from emacs--cvs-trunk--0
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-268
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Mon, 22 Nov 2004 11:06:39 +0000 |
parents | 42acc7fa8a4f dee7926ded40 |
children | 025da3ba778e |
comparison
equal
deleted
inserted
replaced
83227:3ec251523b3e | 83228:2a3f27a45698 |
---|---|
417 (setq new-version | 417 (setq new-version |
418 (vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1))) | 418 (vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1))) |
419 (vc-file-setprop file 'vc-workfile-version new-version) | 419 (vc-file-setprop file 'vc-workfile-version new-version) |
420 ;; if necessary, adjust the default branch | 420 ;; if necessary, adjust the default branch |
421 (and rev (not (string= rev "")) | 421 (and rev (not (string= rev "")) |
422 (vc-rcs-set-default-branch | 422 (vc-rcs-set-default-branch |
423 file | 423 file |
424 (if (vc-rcs-latest-on-branch-p file new-version) | 424 (if (vc-rcs-latest-on-branch-p file new-version) |
425 (if (vc-trunk-p new-version) nil | 425 (if (vc-trunk-p new-version) nil |
426 (vc-branch-part new-version)) | 426 (vc-branch-part new-version)) |
427 new-version))))) | 427 new-version))))) |
494 (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file | 494 (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file |
495 (append (list "-q" | 495 (append (list "-q" |
496 (concat "-r" oldvers) | 496 (concat "-r" oldvers) |
497 (and newvers (concat "-r" newvers))) | 497 (and newvers (concat "-r" newvers))) |
498 (vc-switches 'RCS 'diff)))) | 498 (vc-switches 'RCS 'diff)))) |
499 | |
500 (defun vc-rcs-annotate-command (file buffer &optional revision) | |
501 "Annotate FILE, inserting the results in BUFFER. | |
502 Optional arg REVISION is a revision to annotate from." | |
503 ;; Aside from the "head revision on the trunk", the instructions for | |
504 ;; each revision on the trunk are an ordered list of kill and insert | |
505 ;; commands necessary to go from the chronologically-following | |
506 ;; revision to this one. That is, associated with revision N are | |
507 ;; edits that applied to revision N+1 would result in revision N. | |
508 ;; | |
509 ;; On a branch, however, (some) things are inverted: the commands | |
510 ;; listed are those necessary to go from the chronologically-preceding | |
511 ;; revision to this one. That is, associated with revision N are | |
512 ;; edits that applied to revision N-1 would result in revision N. | |
513 ;; | |
514 ;; So, to get per-line history info, we apply reverse-chronological | |
515 ;; edits, starting with the head revision on the trunk, all the way | |
516 ;; back through the initial revision (typically "1.1" or similar), | |
517 ;; then apply forward-chronological edits -- keeping track of which | |
518 ;; revision is associated with each inserted line -- until we reach | |
519 ;; the desired revision for display (which may be either on the trunk | |
520 ;; or on a branch). | |
521 (let* ((tree (with-temp-buffer | |
522 (insert-file-contents (vc-rcs-registered file)) | |
523 (vc-rcs-parse))) | |
524 (revisions (cdr (assq 'revisions tree))) | |
525 ;; The revision N whose instructions we currently are processing. | |
526 (cur (cdr (assq 'head (cdr (assq 'headers tree))))) | |
527 ;; Alist from the parse tree for N. | |
528 (meta (cdr (assoc cur revisions))) | |
529 ;; Point and temporary string, respectively. | |
530 p s | |
531 ;; "Next-branch list". Nil means the desired revision to | |
532 ;; display lives on the trunk. Non-nil means it lives on a | |
533 ;; branch, in which case the value is a list of revision pairs | |
534 ;; (PARENT . CHILD), the first PARENT being on the trunk, that | |
535 ;; links each series of revisions in the path from the initial | |
536 ;; revision to the desired revision to display. | |
537 nbls | |
538 ;; "Path-accumulate-predicate plus revision/date/author". | |
539 ;; Until set, forward-chronological edits are not accumulated. | |
540 ;; Once set, its value (updated every revision) is used for | |
541 ;; the text property `:vc-rcs-r/d/a' for inserts during | |
542 ;; processing of forward-chronological instructions for N. | |
543 ;; See internal func `r/d/a'. | |
544 prda | |
545 ;; List of forward-chronological instructions, each of the | |
546 ;; form: (POS . ACTION), where POS is a buffer position. If | |
547 ;; ACTION is a string, it is inserted, otherwise it is taken as | |
548 ;; the number of characters to be deleted. | |
549 path | |
550 ;; N+1. When `cur' is "", this is the initial revision. | |
551 pre) | |
552 (unless revision | |
553 (setq revision cur)) | |
554 (unless (assoc revision revisions) | |
555 (error "No such revision: %s" revision)) | |
556 ;; Find which branches (if any) must be included in the edits. | |
557 (let ((par revision) | |
558 bpt kids) | |
559 (while (setq bpt (vc-branch-part par) | |
560 par (vc-branch-part bpt)) | |
561 (setq kids (cdr (assq 'branches (cdr (assoc par revisions))))) | |
562 ;; A branchpoint may have multiple children. Find the right one. | |
563 (while (not (string= bpt (vc-branch-part (car kids)))) | |
564 (setq kids (cdr kids))) | |
565 (push (cons par (car kids)) nbls))) | |
566 ;; Start with the full text. | |
567 (set-buffer buffer) | |
568 (insert (cdr (assq 'text meta))) | |
569 ;; Apply reverse-chronological edits on the trunk, computing and | |
570 ;; accumulating forward-chronological edits after some point, for | |
571 ;; later. | |
572 (flet ((r/d/a () (vector pre | |
573 (cdr (assq 'date meta)) | |
574 (cdr (assq 'author meta))))) | |
575 (while (when (setq pre cur cur (cdr (assq 'next meta))) | |
576 (not (string= "" cur))) | |
577 (setq | |
578 ;; Start accumulating the forward-chronological edits when N+1 | |
579 ;; on the trunk is either the desired revision to display, or | |
580 ;; the appropriate branchpoint for it. Do this before | |
581 ;; updating `meta' since `r/d/a' uses N+1's `meta' value. | |
582 prda (when (or prda (string= (if nbls (caar nbls) revision) pre)) | |
583 (r/d/a)) | |
584 meta (cdr (assoc cur revisions))) | |
585 ;; Edits in the parse tree specify a line number (in the buffer | |
586 ;; *BEFORE* editing occurs) to start from, but line numbers | |
587 ;; change as a result of edits. To DTRT, we apply edits in | |
588 ;; order of descending buffer position so that edits further | |
589 ;; down in the buffer occur first w/o corrupting specified | |
590 ;; buffer positions of edits occurring towards the beginning of | |
591 ;; the buffer. In this way we avoid using markers. A pleasant | |
592 ;; property of this approach is ability to push instructions | |
593 ;; onto `path' directly, w/o need to maintain rev boundaries. | |
594 (dolist (insn (cdr (assq :insn meta))) | |
595 (goto-line (pop insn)) | |
596 (setq p (point)) | |
597 (case (pop insn) | |
598 (k (setq s (buffer-substring-no-properties | |
599 p (progn (forward-line (car insn)) | |
600 (point)))) | |
601 (when prda | |
602 (push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path)) | |
603 (delete-region p (point))) | |
604 (i (setq s (car insn)) | |
605 (when prda | |
606 (push `(,p . ,(length s)) path)) | |
607 (insert s))))) | |
608 ;; For the initial revision, setting `:vc-rcs-r/d/a' directly is | |
609 ;; equivalent to pushing an insert instruction (of the entire buffer | |
610 ;; contents) onto `path' then erasing the buffer, but less wasteful. | |
611 (put-text-property (point-min) (point-max) :vc-rcs-r/d/a (r/d/a)) | |
612 ;; Now apply the forward-chronological edits for the trunk. | |
613 (dolist (insn path) | |
614 (goto-char (pop insn)) | |
615 (if (stringp insn) | |
616 (insert insn) | |
617 (delete-char insn))) | |
618 ;; Now apply the forward-chronological edits (directly from the | |
619 ;; parse-tree) for the branch(es), if necessary. We re-use vars | |
620 ;; `pre' and `meta' for the sake of internal func `r/d/a'. | |
621 (while nbls | |
622 (setq pre (cdr (pop nbls))) | |
623 (while (progn | |
624 (setq meta (cdr (assoc pre revisions)) | |
625 prda nil) | |
626 (dolist (insn (cdr (assq :insn meta))) | |
627 (goto-line (pop insn)) | |
628 (case (pop insn) | |
629 (k (delete-region | |
630 (point) (progn (forward-line (car insn)) | |
631 (point)))) | |
632 (i (insert (propertize | |
633 (car insn) | |
634 :vc-rcs-r/d/a | |
635 (or prda (setq prda (r/d/a)))))))) | |
636 (prog1 (not (string= (if nbls (caar nbls) revision) pre)) | |
637 (setq pre (cdr (assq 'next meta))))))))) | |
638 ;; Lastly, for each line, insert at bol nicely-formatted history info. | |
639 ;; We do two passes to collect summary information used to minimize | |
640 ;; the annotation's usage of screen real-estate: (1) Consider rendered | |
641 ;; width of revision plus author together as a unit; and (2) Omit | |
642 ;; author entirely if all authors are the same as the user. | |
643 (let ((ht (make-hash-table :test 'eq)) | |
644 (me (user-login-name)) | |
645 (maxw 0) | |
646 (all-me t) | |
647 rda w a) | |
648 (goto-char (point-max)) | |
649 (while (not (bobp)) | |
650 (forward-line -1) | |
651 (setq rda (get-text-property (point) :vc-rcs-r/d/a)) | |
652 (unless (gethash rda ht) | |
653 (setq a (aref rda 2) | |
654 all-me (and all-me (string= a me))) | |
655 (puthash rda (setq w (+ (length (aref rda 0)) | |
656 (length a))) | |
657 ht) | |
658 (setq maxw (max w maxw)))) | |
659 (let ((padding (make-string maxw 32))) | |
660 (flet ((pad (w) (substring-no-properties padding w)) | |
661 (render (rda &rest ls) | |
662 (propertize | |
663 (apply 'concat | |
664 (format-time-string "%Y-%m-%d" (aref rda 1)) | |
665 " " | |
666 (aref rda 0) | |
667 ls) | |
668 :vc-rcs-r/d/a rda))) | |
669 (maphash | |
670 (if all-me | |
671 (lambda (rda w) | |
672 (puthash rda (render rda (pad w) ": ") ht)) | |
673 (lambda (rda w) | |
674 (puthash rda (render rda " " (pad w) " " (aref rda 2) ": ") ht))) | |
675 ht))) | |
676 (while (not (eobp)) | |
677 (insert (gethash (get-text-property (point) :vc-rcs-r/d/a) ht)) | |
678 (forward-line 1)))) | |
679 | |
680 (defun vc-rcs-annotate-current-time () | |
681 "Return the current time, based at midnight of the current day, and | |
682 encoded as fractional days." | |
683 (vc-annotate-convert-time | |
684 (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time)))))) | |
685 | |
686 (defun vc-rcs-annotate-time () | |
687 "Return the time of the next annotation (as fraction of days) | |
688 systime, or nil if there is none. Also, reposition point." | |
689 (unless (eobp) | |
690 (search-forward ": ") | |
691 (vc-annotate-convert-time | |
692 (aref (get-text-property (point) :vc-rcs-r/d/a) 1)))) | |
693 | |
694 (defun vc-rcs-annotate-extract-revision-at-line () | |
695 (aref (get-text-property (point) :vc-rcs-r/d/a) 0)) | |
499 | 696 |
500 | 697 |
501 ;;; | 698 ;;; |
502 ;;; Snapshot system | 699 ;;; Snapshot system |
503 ;;; | 700 ;;; |
759 (let ((installation (vc-rcs-system-release))) | 956 (let ((installation (vc-rcs-system-release))) |
760 (if (and installation | 957 (if (and installation |
761 (not (eq installation 'unknown))) | 958 (not (eq installation 'unknown))) |
762 (vc-release-greater-or-equal installation release)))) | 959 (vc-release-greater-or-equal installation release)))) |
763 | 960 |
764 | |
765 (defun vc-rcs-system-release () | 961 (defun vc-rcs-system-release () |
766 "Return the RCS release installed on this system, as a string. | 962 "Return the RCS release installed on this system, as a string. |
767 Return symbol UNKNOWN if the release cannot be deducted. The user can | 963 Return symbol UNKNOWN if the release cannot be deducted. The user can |
768 override this using variable `vc-rcs-release'. | 964 override this using variable `vc-rcs-release'. |
769 | 965 |
783 | 979 |
784 (defun vc-rcs-set-default-branch (file branch) | 980 (defun vc-rcs-set-default-branch (file branch) |
785 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-b" branch)) | 981 (vc-do-command nil 0 "rcs" (vc-name file) (concat "-b" branch)) |
786 (vc-file-setprop file 'vc-rcs-default-branch branch)) | 982 (vc-file-setprop file 'vc-rcs-default-branch branch)) |
787 | 983 |
984 (defun vc-rcs-parse (&optional buffer) | |
985 "Parse current buffer, presumed to be in RCS-style masterfile format. | |
986 Optional arg BUFFER specifies another buffer to parse. Return an alist | |
987 of two elements, w/ keys `headers' and `revisions' and values in turn | |
988 sub-alists. For `headers', the values unless otherwise specified are | |
989 strings and the keys are: | |
990 | |
991 desc -- description | |
992 head -- latest revision | |
993 branch -- the branch the \"head revision\" lies on; | |
994 absent if the head revision lies on the trunk | |
995 access -- ??? | |
996 symbols -- sub-alist of (SYMBOL . REVISION) elements | |
997 locks -- if file is checked out, something like \"ttn:1.7\" | |
998 strict -- t if \"strict locking\" is in effect, otherwise nil | |
999 comment -- may be absent; typically something like \"# \" or \"; \" | |
1000 expand -- may be absent; ??? | |
1001 | |
1002 For `revisions', the car is REVISION (string), the cdr a sub-alist, | |
1003 with string values (unless otherwise specified) and keys: | |
1004 | |
1005 date -- a time value (like that returned by `encode-time'); as a | |
1006 special case, a year value less than 100 is augmented by 1900 | |
1007 author -- username | |
1008 state -- typically \"Exp\" or \"Rel\" | |
1009 branches -- list of revisions that begin branches from this revision | |
1010 next -- on the trunk: the chronologically-preceding revision, or \"\"; | |
1011 on a branch: the chronologically-following revision, or \"\" | |
1012 log -- change log entry | |
1013 text -- for the head revision on the trunk, the body of the file; | |
1014 other revisions have `:insn' instead | |
1015 :insn -- for non-head revisions, a list of parsed instructions | |
1016 in one of two forms, in both cases START meaning \"first | |
1017 go to line START\": | |
1018 - `(START k COUNT)' -- kill COUNT lines | |
1019 - `(START i TEXT)' -- insert TEXT (a string) | |
1020 The list is in descending order by START. | |
1021 | |
1022 The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." | |
1023 (setq buffer (get-buffer (or buffer (current-buffer)))) | |
1024 (set-buffer buffer) | |
1025 ;; An RCS masterfile can be viewed as containing four regular (for the | |
1026 ;; most part) sections: (a) the "headers", (b) the "rev headers", (c) | |
1027 ;; the "description" and (d) the "rev bodies", in that order. In the | |
1028 ;; returned alist (see docstring), elements from (b) and (d) are | |
1029 ;; combined pairwise to form the "revisions", while those from (a) and | |
1030 ;; (c) are simply combined to form the "headers". | |
1031 ;; | |
1032 ;; Loosely speaking, each section contains a series of alternating | |
1033 ;; "tags" and "printed representations". In the (b) and (d), many | |
1034 ;; such series can appear, and a revision number on a line by itself | |
1035 ;; precedes the series of tags and printed representations associated | |
1036 ;; with it. | |
1037 ;; | |
1038 ;; In (a) and (b), the printed representations (with the exception of | |
1039 ;; the `comment' tag in the headers) terminate with a semicolon, which | |
1040 ;; is NOT part of the "value" finally associated with the tag. All | |
1041 ;; other printed representations are in "@@-format"; there is an "@", | |
1042 ;; the middle part (to be translated into the value), another "@" and | |
1043 ;; a newline. Each "@@" in the middle part indicates the position of | |
1044 ;; a single "@" (and consequently the requirement of an additional | |
1045 ;; initial step when translating to the value). | |
1046 ;; | |
1047 ;; Parser state includes vars that collect parts of the return value... | |
1048 (let ((desc nil) (headers nil) (revs nil) | |
1049 ;; ... as well as vars that support a single-pass, tag-assisted, | |
1050 ;; minimal-data-copying scan. Basically -- skirting around the | |
1051 ;; grouping by revision required in (b) and (d) -- we repeatedly | |
1052 ;; and context-sensitively read a tag (that MUST be present), | |
1053 ;; determine the bounds of the printed representation, translate | |
1054 ;; it into a value, and push the tag plus value onto one of the | |
1055 ;; collection vars. Finally, we return the parse tree | |
1056 ;; incorporating the values of the collection vars (see "rv"). | |
1057 ;; | |
1058 ;; A symbol or string to keep track of context (for error messages). | |
1059 context | |
1060 ;; A symbol, the current tag. | |
1061 tok | |
1062 ;; Region (begin and end buffer positions) of the printed | |
1063 ;; representation for the current tag. | |
1064 b e | |
1065 ;; A list of buffer positions where "@@" can be found within the | |
1066 ;; printed representation region. For each location, we push two | |
1067 ;; elements onto the list, 1+ and 2+ the location, respectively, | |
1068 ;; with the 2+ appearing at the head. In this way, the expression | |
1069 ;; `(,e ,@@-holes ,b) | |
1070 ;; describes regions that can be concatenated (in reverse order) | |
1071 ;; to "de-@@-format" the printed representation as the first step | |
1072 ;; to translating it into some value. See internal func `gather'. | |
1073 @-holes) | |
1074 (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]' | |
1075 (at (tag) (save-excursion (eq tag (read buffer)))) | |
1076 (to-eol () (buffer-substring-no-properties | |
1077 (point) (progn (forward-line 1) | |
1078 (1- (point))))) | |
1079 (to-semi () (setq b (point) | |
1080 e (progn (search-forward ";") | |
1081 (1- (point))))) | |
1082 (to-one@ () (setq @-holes nil | |
1083 b (progn (search-forward "@") (point)) | |
1084 e (progn (while (and (search-forward "@") | |
1085 (= ?@ (char-after)) | |
1086 (progn | |
1087 (push (point) @-holes) | |
1088 (forward-char 1) | |
1089 (push (point) @-holes)))) | |
1090 (1- (point))))) | |
1091 (tok+val (set-b+e name &optional proc) | |
1092 (unless (eq name (setq tok (read buffer))) | |
1093 (error "Missing `%s' while parsing %s" name context)) | |
1094 (sw) | |
1095 (funcall set-b+e) | |
1096 (cons tok (if proc | |
1097 (funcall proc) | |
1098 (buffer-substring-no-properties b e)))) | |
1099 (k-semi (name &optional proc) (tok+val 'to-semi name proc)) | |
1100 (gather () (let ((pairs `(,e ,@@-holes ,b)) | |
1101 acc) | |
1102 (while pairs | |
1103 (push (buffer-substring-no-properties | |
1104 (cadr pairs) (car pairs)) | |
1105 acc) | |
1106 (setq pairs (cddr pairs))) | |
1107 (apply 'concat acc))) | |
1108 (k-one@ (name &optional later) (tok+val 'to-one@ name | |
1109 (if later | |
1110 (lambda () t) | |
1111 'gather)))) | |
1112 (save-excursion | |
1113 (goto-char (point-min)) | |
1114 ;; headers | |
1115 (setq context 'headers) | |
1116 (flet ((hpush (name &optional proc) | |
1117 (push (k-semi name proc) headers))) | |
1118 (hpush 'head) | |
1119 (when (at 'branch) | |
1120 (hpush 'branch)) | |
1121 (hpush 'access) | |
1122 (hpush 'symbols | |
1123 (lambda () | |
1124 (mapcar (lambda (together) | |
1125 (let ((two (split-string together ":"))) | |
1126 (setcar two (intern (car two))) | |
1127 (setcdr two (cadr two)) | |
1128 two)) | |
1129 (split-string | |
1130 (buffer-substring-no-properties b e))))) | |
1131 (hpush 'locks)) | |
1132 (push `(strict . ,(when (at 'strict) | |
1133 (search-forward ";") | |
1134 t)) | |
1135 headers) | |
1136 (when (at 'comment) | |
1137 (push (k-one@ 'comment) headers) | |
1138 (search-forward ";")) | |
1139 (when (at 'expand) | |
1140 (push (k-one@ 'expand) headers) | |
1141 (search-forward ";")) | |
1142 (setq headers (nreverse headers)) | |
1143 ;; rev headers | |
1144 (sw) (setq context 'rev-headers) | |
1145 (while (looking-at "[0-9]") | |
1146 (push `(,(to-eol) | |
1147 ,(k-semi 'date | |
1148 (lambda () | |
1149 (let ((ls (mapcar 'string-to-number | |
1150 (split-string | |
1151 (buffer-substring-no-properties | |
1152 b e) | |
1153 "\\.")))) | |
1154 ;; Hack the year -- verified to be the | |
1155 ;; same algorithm used in RCS 5.7. | |
1156 (when (< (car ls) 100) | |
1157 (setcar ls (+ 1900 (car ls)))) | |
1158 (apply 'encode-time (nreverse ls))))) | |
1159 ,@(mapcar 'k-semi '(author state)) | |
1160 ,(k-semi 'branches | |
1161 (lambda () | |
1162 (split-string | |
1163 (buffer-substring-no-properties b e)))) | |
1164 ,(k-semi 'next)) | |
1165 revs) | |
1166 (sw)) | |
1167 (setq revs (nreverse revs)) | |
1168 ;; desc | |
1169 (sw) (setq context 'desc | |
1170 desc (k-one@ 'desc)) | |
1171 ;; rev bodies | |
1172 (let (acc | |
1173 ;; Element of `revs' that initially holds only header info. | |
1174 ;; "Pairwise combination" occurs when we add body info. | |
1175 rev | |
1176 ;; Components of the editing commands (aside from the actual | |
1177 ;; text) that comprise the `text' printed representations | |
1178 ;; (not including the "head" revision). | |
1179 cmd start act | |
1180 ;; Ascending (reversed) `@-holes' which the internal func | |
1181 ;; `incg' pops to effect incremental gathering. | |
1182 asc | |
1183 ;; Function to extract text (for the `a' command), either | |
1184 ;; `incg' or `buffer-substring-no-properties'. (This is | |
1185 ;; for speed; strictly speaking, it is sufficient to use | |
1186 ;; only the former since it behaves identically to the | |
1187 ;; latter in the absense of "@@".) | |
1188 sub) | |
1189 (flet ((incg (beg end) (let ((b beg) (e end) @-holes) | |
1190 (while (and asc (< (car asc) e)) | |
1191 (push (pop asc) @-holes)) | |
1192 ;; Self-deprecate when work is done. | |
1193 ;; Folding many dimensions into one. | |
1194 ;; Thanks B.Mandelbrot, for complex sum. | |
1195 ;; O beauteous math! --the Unvexed Bum | |
1196 (unless asc | |
1197 (setq sub 'buffer-substring-no-properties)) | |
1198 (gather)))) | |
1199 (while (and (sw) | |
1200 (not (eobp)) | |
1201 (setq context (to-eol) | |
1202 rev (or (assoc context revs) | |
1203 (error "Rev `%s' has body but no head" | |
1204 context)))) | |
1205 (push (k-one@ 'log) (cdr rev)) | |
1206 ;; For rev body `text' tags, delay translation slightly... | |
1207 (push (k-one@ 'text t) (cdr rev)) | |
1208 ;; ... until we decide which tag and value is appropriate to | |
1209 ;; collect. For the "head" revision, compute the value of the | |
1210 ;; `text' printed representation by simple `gather'. For all | |
1211 ;; other revisions, replace the `text' tag+value with `:insn' | |
1212 ;; plus value, always scanning in-place. | |
1213 (if (string= context (cdr (assq 'head headers))) | |
1214 (setcdr (cadr rev) (gather)) | |
1215 (if @-holes | |
1216 (setq asc (nreverse @-holes) | |
1217 sub 'incg) | |
1218 (setq sub 'buffer-substring-no-properties)) | |
1219 (goto-char b) | |
1220 (setq acc nil) | |
1221 (while (< (point) e) | |
1222 (forward-char 1) | |
1223 (setq cmd (char-before) | |
1224 start (read (current-buffer)) | |
1225 act (read (current-buffer))) | |
1226 (forward-char 1) | |
1227 (push (case cmd | |
1228 (?d | |
1229 ;; `d' means "delete lines". | |
1230 ;; For Emacs spirit, we use `k' for "kill". | |
1231 `(,start k ,act)) | |
1232 (?a | |
1233 ;; `a' means "append after this line" but | |
1234 ;; internally we normalize it so that START | |
1235 ;; specifies the actual line for insert, thus | |
1236 ;; requiring less hair in the realization algs. | |
1237 ;; For Emacs spirit, we use `i' for "insert". | |
1238 `(,(1+ start) i | |
1239 ,(funcall sub (point) (progn (forward-line act) | |
1240 (point))))) | |
1241 (t (error "Bad command `%c' in `text' for rev `%s'" | |
1242 cmd context))) | |
1243 acc)) | |
1244 (goto-char (1+ e)) | |
1245 (setcar (cdr rev) (cons :insn acc))))))) | |
1246 ;; rv | |
1247 `((headers ,desc ,@headers) | |
1248 (revisions ,@revs))))) | |
1249 | |
788 (provide 'vc-rcs) | 1250 (provide 'vc-rcs) |
789 | 1251 |
790 ;; arch-tag: 759b4916-5b0d-431d-b647-b185b8c652cf | 1252 ;; arch-tag: 759b4916-5b0d-431d-b647-b185b8c652cf |
791 ;;; vc-rcs.el ends here | 1253 ;;; vc-rcs.el ends here |