Function: vc-rcs-annotate-command
vc-rcs-annotate-command is a byte-compiled function defined in
vc-rcs.el.gz.
Signature
(vc-rcs-annotate-command FILE BUFFER &optional REVISION)
Documentation
Annotate FILE, inserting the results in BUFFER.
Optional arg REVISION is a revision to annotate from.
Source Code
;; Defined in /usr/src/emacs/lisp/vc/vc-rcs.el.gz
(defun vc-rcs-annotate-command (file buffer &optional revision)
"Annotate FILE, inserting the results in BUFFER.
Optional arg REVISION is a revision to annotate from."
(vc-setup-buffer buffer)
;; Aside from the "head revision on the trunk", the instructions for
;; each revision on the trunk are an ordered list of kill and insert
;; commands necessary to go from the chronologically-following
;; revision to this one. That is, associated with revision N are
;; edits that applied to revision N+1 would result in revision N.
;;
;; On a branch, however, (some) things are inverted: the commands
;; listed are those necessary to go from the chronologically-preceding
;; revision to this one. That is, associated with revision N are
;; edits that applied to revision N-1 would result in revision N.
;;
;; So, to get per-line history info, we apply reverse-chronological
;; edits, starting with the head revision on the trunk, all the way
;; back through the initial revision (typically "1.1" or similar),
;; then apply forward-chronological edits -- keeping track of which
;; revision is associated with each inserted line -- until we reach
;; the desired revision for display (which may be either on the trunk
;; or on a branch).
(let* ((tree (with-temp-buffer
(insert-file-contents (vc-rcs-registered file))
(vc-rcs-parse)))
(revisions (cdr (assq 'revisions tree)))
;; The revision N whose instructions we currently are processing.
(cur (cdr (assq 'head (cdr (assq 'headers tree)))))
;; Alist from the parse tree for N.
(meta (cdr (assoc cur revisions)))
;; Point and temporary string, respectively.
p s
;; "Next-branch list". Nil means the desired revision to
;; display lives on the trunk. Non-nil means it lives on a
;; branch, in which case the value is a list of revision pairs
;; (PARENT . CHILD), the first PARENT being on the trunk, that
;; links each series of revisions in the path from the initial
;; revision to the desired revision to display.
nbls
;; "Path-accumulate-predicate plus revision/date/author".
;; Until set, forward-chronological edits are not accumulated.
;; Once set, its value (updated every revision) is used for
;; the text property `:vc-rcs-r/d/a' for inserts during
;; processing of forward-chronological instructions for N.
;; See internal func `r/d/a'.
prda
;; List of forward-chronological instructions, each of the
;; form: (POS . ACTION), where POS is a buffer position. If
;; ACTION is a string, it is inserted, otherwise it is taken as
;; the number of characters to be deleted.
path
;; N+1. When `cur' is "", this is the initial revision.
pre)
(unless revision
(setq revision cur))
(unless (assoc revision revisions)
(error "No such revision: %s" revision))
;; Find which branches (if any) must be included in the edits.
(let ((par revision)
bpt kids)
(while (setq bpt (vc-rcs-branch-part par)
par (vc-rcs-branch-part bpt))
(setq kids (cdr (assq 'branches (cdr (assoc par revisions)))))
;; A branchpoint may have multiple children. Find the right one.
(while (not (string= bpt (vc-rcs-branch-part (car kids))))
(setq kids (cdr kids)))
(push (cons par (car kids)) nbls)))
;; Start with the full text.
(set-buffer buffer)
(insert (cdr (assq 'text meta)))
;; Apply reverse-chronological edits on the trunk, computing and
;; accumulating forward-chronological edits after some point, for
;; later.
(cl-flet ((r/d/a () (vector pre
(cdr (assq 'date meta))
(cdr (assq 'author meta)))))
(while (when (setq pre cur cur (cdr (assq 'next meta)))
(not (string= "" cur)))
(setq
;; Start accumulating the forward-chronological edits when N+1
;; on the trunk is either the desired revision to display, or
;; the appropriate branchpoint for it. Do this before
;; updating `meta' since `r/d/a' uses N+1's `meta' value.
prda (when (or prda (string= (if nbls (caar nbls) revision) pre))
(r/d/a))
meta (cdr (assoc cur revisions)))
;; Edits in the parse tree specify a line number (in the buffer
;; *BEFORE* editing occurs) to start from, but line numbers
;; change as a result of edits. To DTRT, we apply edits in
;; order of descending buffer position so that edits further
;; down in the buffer occur first without corrupting specified
;; buffer positions of edits occurring towards the beginning of
;; the buffer. In this way we avoid using markers. A pleasant
;; property of this approach is ability to push instructions
;; onto `path' directly, without need to maintain rev boundaries.
(dolist (insn (cdr (assq :insn meta)))
(goto-char (point-min))
(forward-line (1- (pop insn)))
(setq p (point))
(pcase (pop insn)
('k (setq s (buffer-substring-no-properties
p (progn (forward-line (car insn))
(point))))
(when prda
(push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path))
(delete-region p (point)))
('i (setq s (car insn))
(when prda
(push `(,p . ,(length s)) path))
(insert s)))))
;; For the initial revision, setting `:vc-rcs-r/d/a' directly is
;; equivalent to pushing an insert instruction (of the entire buffer
;; contents) onto `path' then erasing the buffer, but less wasteful.
(put-text-property (point-min) (point-max) :vc-rcs-r/d/a (r/d/a))
;; Now apply the forward-chronological edits for the trunk.
(dolist (insn path)
(goto-char (pop insn))
(if (stringp insn)
(insert insn)
(delete-char insn)))
;; Now apply the forward-chronological edits (directly from the
;; parse-tree) for the branch(es), if necessary. We reuse vars
;; `pre' and `meta' for the sake of internal func `r/d/a'.
(while nbls
(setq pre (cdr (pop nbls)))
(while (progn
(setq meta (cdr (assoc pre revisions))
prda nil)
(dolist (insn (cdr (assq :insn meta)))
(goto-char (point-min))
(forward-line (1- (pop insn)))
(pcase (pop insn)
('k (delete-region
(point) (progn (forward-line (car insn))
(point))))
('i (insert (propertize
(car insn)
:vc-rcs-r/d/a
(or prda (setq prda (r/d/a))))))))
(prog1 (not (string= (if nbls (caar nbls) revision) pre))
(setq pre (cdr (assq 'next meta)))))))))
;; Lastly, for each line, insert at bol nicely-formatted history info.
;; We do two passes to collect summary information used to minimize
;; the annotation's usage of screen real-estate: (1) Consider rendered
;; width of revision plus author together as a unit; and (2) Omit
;; author entirely if all authors are the same as the user.
(let ((ht (make-hash-table :test 'eq))
(me (user-login-name))
(maxw 0)
(all-me t)
rda w a)
(goto-char (point-max))
(while (not (bobp))
(forward-line -1)
(setq rda (get-text-property (point) :vc-rcs-r/d/a))
(unless (gethash rda ht)
(setq a (aref rda 2)
all-me (and all-me (string= a me)))
(puthash rda (setq w (+ (length (aref rda 0))
(length a)))
ht)
(setq maxw (max w maxw))))
(let ((padding (make-string maxw 32)))
(cl-flet ((pad (w) (substring-no-properties padding w))
(render (rda &rest ls)
(propertize
(apply #'concat
(format-time-string "%Y-%m-%d" (aref rda 1))
" "
(aref rda 0)
ls)
:vc-annotate-prefix t
:vc-rcs-r/d/a rda)))
(maphash
(if all-me
(lambda (rda w)
(puthash rda (render rda (pad w) ": ") ht))
(lambda (rda w)
(puthash rda (render rda " " (pad w) " " (aref rda 2) ": ") ht)))
ht)))
(while (not (eobp))
(insert (gethash (get-text-property (point) :vc-rcs-r/d/a) ht))
(forward-line 1))))