Megatest

Check-in [8e7c86ba1f]
Login
Overview
Comment:Want report to be newest at top (similar to fossil timeline).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 8e7c86ba1f2ab404eb33e16385fd9f89b6070212
User & Date: matt on 2017-04-07 23:52:29
Other Links: branch diff | manifest | tags
Context
2017-04-10
09:57
Bump version to v1.6404 check-in: ba56fd8336 user: mrwellan tags: v1.64, v1.6404
2017-04-07
23:52
Want report to be newest at top (similar to fossil timeline). check-in: 8e7c86ba1f user: matt tags: v1.64
23:41
Added nice report generator (thanks to excellent suggestion from Steve Osugi) check-in: f5d0f037cc user: matt tags: v1.64
Changes

Modified utils/fslrept.scm from [a0c39060ae] to [a7525c0b51].

39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
			  "fossil json timeline checkin -n 0"
			json-read)))
	 (timeline   (aref (aref data "payload") "timeline")) ;; extract the timeline alists
	 (start-flag #f)
	 (end-flag   #f))
    ;; now we have all needed data as a list of alists in time order, extract the
    ;; messages for given branch starting at start-tag and ending at end-tag

    (filter
     (lambda (x) x)
     (map
      (lambda (entry)
	(let ((tags (aref entry "tags")))
	  (if (or (not tags) ;; eh?
		  (not (list? tags)))
	      (begin
		;; (with-output-to-port (current-error-port)
		;;   (lambda ()
		;;     (print "ERROR: bad entry. tags: " tags)))
		#f)
	      (let* ((btag (car tags))  ;; first tag is the primary branch
		     (tags (cdr tags))  ;; remainder are actual tags
		     (cmt  (aref entry "comment"))
		     (usr  (aref entry "user"))
		     (tms  (aref entry "timestamp")))
		;; (print "btag: " btag " tags: " tags " usr: " usr)
		(if (equal? btag branch) ;; we are on the branch
		    (begin
		      (if (member start-tag tags)(set! start-flag #t))
		      (let ((res (if (and start-flag
					  (not end-flag))
				     `(,usr
				       ,(time->string (seconds->local-time tms) "WW%U.%w %H:%M")
				       ,cmt)
				     #f)))
			(if (member end-tag tags)(set! end-flag #t))
			res))
		    #f)))))
      (reverse timeline)))))

(define (process-fossil branch start-tag end-tag)
  (print-rows
   (extract-history branch start-tag end-tag)))

;; process command line args and dispatch the call to fossil processing
;;







>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
			  "fossil json timeline checkin -n 0"
			json-read)))
	 (timeline   (aref (aref data "payload") "timeline")) ;; extract the timeline alists
	 (start-flag #f)
	 (end-flag   #f))
    ;; now we have all needed data as a list of alists in time order, extract the
    ;; messages for given branch starting at start-tag and ending at end-tag
    (reverse ;; return results oldest to newest
     (filter
      (lambda (x) x)
      (map
       (lambda (entry)
	 (let ((tags (aref entry "tags")))
	   (if (or (not tags) ;; eh?
		   (not (list? tags)))
	       (begin
		 ;; (with-output-to-port (current-error-port)
		 ;;   (lambda ()
		 ;;     (print "ERROR: bad entry. tags: " tags)))
		 #f)
	       (let* ((btag (car tags))  ;; first tag is the primary branch
		      (tags (cdr tags))  ;; remainder are actual tags
		      (cmt  (aref entry "comment"))
		      (usr  (aref entry "user"))
		      (tms  (aref entry "timestamp")))
		 ;; (print "btag: " btag " tags: " tags " usr: " usr)
		 (if (equal? btag branch) ;; we are on the branch
		     (begin
		       (if (member start-tag tags)(set! start-flag #t))
		       (let ((res (if (and start-flag
					   (not end-flag))
				      `(,usr
					,(time->string (seconds->local-time tms) "WW%U.%w %H:%M")
					,cmt)
				      #f)))
			 (if (member end-tag tags)(set! end-flag #t))
			 res))
		     #f)))))
       (reverse timeline))))))

(define (process-fossil branch start-tag end-tag)
  (print-rows
   (extract-history branch start-tag end-tag)))

;; process command line args and dispatch the call to fossil processing
;;