(vc-annotate-compcar): Iterate instead of recursing.

(vc-annotate-car-last-cons, vc-annotate-time-span):
Rename arg assoc-list to a-list.

(vc-annotate-display): All support for XEmacs extents removed.
Functions `set-face-*' are called only when a face is created.

diff --git a/lisp/vc.el b/lisp/vc.el
index 0f85e31b1e7efd35f9f21e4b0963862d047606c8..2a60a9f0cd0e0c4e24dc88da914f5b8a63ae7870 100644 (file)
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -2159,35 +2159,35 @@ colors. `vc-annotate-background' specifies the background color."
                    "annotate" (file-name-nondirectory (buffer-file-name)))))
   (message "Annotating... done"))
 
-(defun vc-annotate-car-last-cons (assoc-list)
-  "Return car of last cons in ASSOC-LIST."
-  (if (not (eq nil (cdr assoc-list)))
-      (vc-annotate-car-last-cons (cdr assoc-list))
-    (car (car assoc-list))))
-
-;; Return an association list with span factor applied to the
-;; time-span of assoc-list.  Optionaly quantize to the factor of
-;; quantize.
-(defun vc-annotate-time-span (assoc-list span &optional quantize)
+(defun vc-annotate-car-last-cons (a-list)
+  "Return car of last cons in association list A-LIST."
+  (if (not (eq nil (cdr a-list)))
+      (vc-annotate-car-last-cons (cdr a-list))
+    (car (car a-list))))
+
+(defun vc-annotate-time-span (a-list span &optional quantize)
+"Return an association list with factor SPAN applied to the time-span
+of association list A-LIST.  Optionaly quantize to the factor of
+QUANTIZE."
   ;; Apply span to each car of every cons
-  (if (not (eq nil assoc-list)) 
-      (append (list (cons (* (car (car assoc-list)) span)
-                         (cdr (car assoc-list))))
+  (if (not (eq nil a-list)) 
+      (append (list (cons (* (car (car a-list)) span)
+                         (cdr (car a-list))))
              (vc-annotate-time-span (nthcdr (cond (quantize) ; optional
                                                   (1)) ; Default to cdr
-                                            assoc-list) span quantize))))
-
-(defun vc-annotate-compcar (threshold &rest args)
-  "Test successive cars of ARGS against THRESHOLD.
-Return the first cons which CAR is not less than THRESHOLD, nil otherwise"
-  ;; If no list is exhausted,
-  (if (and (not (memq 'nil args)) (< (car (car (car args))) threshold))
-      ;; apply to CARs.
-      (apply 'vc-annotate-compcar threshold
-            ;; Recurse for rest of elements.
-            (mapcar 'cdr args))
-    ;; Return the proper result
-    (car (car args))))
+                                            a-list) span quantize))))
+
+(defun vc-annotate-compcar (threshold a-list)
+  "Test successive cons cells of association list A-LIST against
+THRESHOLD.  Return the first cons cell which car is not less than
+THRESHOLD, nil otherwise"
+ (let ((i 1)
+       (tmp-cons (car a-list)))
+   (while (and tmp-cons (< (car tmp-cons) threshold))
+     (setq tmp-cons (car (nthcdr i a-list)))
+     (setq i (+ i 1)))
+   tmp-cons))                          ; Return the appropriate value
+
 
 (defun vc-annotate-display (buffer &optional color-map)
   "Do the VC-Annotate display in BUFFER using COLOR-MAP."
@@ -2206,29 +2206,23 @@ Return the first cons which CAR is not less than THRESHOLD, nil otherwise"
   (let* ((local-month-numbers 
          '(("Jan" . 1) ("Feb" .  2) ("Mar" .  3) ("Apr" .  4)
            ("May" . 5) ("Jun" .  6) ("Jul" .  7) ("Aug" .  8) 
-           ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)))
-        ;; XEmacs use extents, GNU Emacs overlays.
-        (overlay-or-extent (if (string-match "XEmacs" emacs-version)
-                               (cons 'make-extent 'set-extent-property)
-                             (cons 'make-overlay 'overlay-put)))
-        (make-overlay-or-extent (car overlay-or-extent))
-        (set-property-overlay-or-extent (cdr overlay-or-extent)))
-
+           ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))))
     (set-buffer buffer)
     (display-buffer buffer)
     (if (not vc-annotate-mode)         ; Turn on vc-annotate-mode if not done
        (vc-annotate-mode))
     (goto-char (point-min))            ; Position at the top of the buffer.
-    (while (re-search-forward 
-           "^[0-9]+\\(\.[0-9]+\\)*\\s-+(\\sw+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): "
+    (while (re-search-forward
+           "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): "
+;;         "^[0-9]+\\(\.[0-9]+\\)*\\s-+(\\sw+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): "
            nil t)
 
       (let* (;; Unfortunately, order is important. match-string will
              ;; be corrupted by extent functions in XEmacs. Access
              ;; string-matches first.
-            (day (string-to-number (match-string 2)))
-             (month (cdr (assoc (match-string 3) local-month-numbers)))
-            (year-tmp (string-to-number (match-string 4)))
+            (day (string-to-number (match-string 1)))
+             (month (cdr (assoc (match-string 2) local-month-numbers)))
+            (year-tmp (string-to-number (match-string 3)))
             (year (+ (if (> 100 year-tmp) 1900 0) year-tmp)) ; Possible millenium problem
             (high (- (car (current-time))
                      (car (encode-time 0 0 0 day month year))))
@@ -2239,19 +2233,16 @@ Return the first cons which CAR is not less than THRESHOLD, nil otherwise"
             (face-name (concat "vc-annotate-face-" (substring (cdr color) 1)))
             ;; Make the face if not done.
             (face (cond ((intern-soft face-name))
-                        ((make-face (intern face-name)))))
-            (point (point))
-            (foo (forward-line 1))
-            (overlay (cond ((if (string-match "XEmacs" emacs-version)
-                                (extent-at point)
-                              (car (overlays-at point ))))
-                           ((apply make-overlay-or-extent point (point) nil)))))
-
-       (if vc-annotate-background
-           (set-face-background face vc-annotate-background))
-       (set-face-foreground face (cdr color))
-       (apply set-property-overlay-or-extent overlay
-              'face face nil)))))
+                        ((let ((tmp-face (make-face (intern face-name))))
+                           (set-face-foreground tmp-face (cdr color))
+                           (if vc-annotate-background
+                               (set-face-background tmp-face vc-annotate-background))
+                           tmp-face)))) ; Return the face
+            (point (point)))
+
+       (forward-line 1)
+       (overlay-put (make-overlay point (point) nil) 'face face)))))
+
 \f
 ;; Collect back-end-dependent stuff here