Megatest

Hex Artifact Content
Login

Artifact 18dabc5fe96d486e5d8bd3d0b4e9f445d0f235ff:


0000: 28 75 73 65 20 79 61 6d 6c 20 6d 61 74 63 68 61  (use yaml matcha
0010: 62 6c 65 20 73 72 66 69 2d 31 20 73 71 6c 69 74  ble srfi-1 sqlit
0020: 65 33 20 72 65 67 65 78 29 0a 0a 28 64 65 66 69  e3 regex)..(defi
0030: 6e 65 20 28 67 65 74 2d 74 69 6d 65 6c 69 6e 65  ne (get-timeline
0040: 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 6e 70 20  ).  (let* ((inp 
0050: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 70 69 70 65  (open-input-pipe
0060: 20 22 66 6f 73 73 69 6c 20 6a 73 6f 6e 20 74 69   "fossil json ti
0070: 6d 65 6c 69 6e 65 20 63 68 65 63 6b 69 6e 20 2d  meline checkin -
0080: 6e 20 30 22 29 29 0a 09 20 28 72 65 73 20 28 79  n 0")).. (res (y
0090: 61 6d 6c 2d 6c 6f 61 64 20 69 6e 70 29 29 29 0a  aml-load inp))).
00a0: 20 20 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75 74      (close-input
00b0: 2d 70 69 70 65 20 69 6e 70 29 0a 20 20 20 20 72  -pipe inp).    r
00c0: 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67  es))..(define (g
00d0: 65 74 2d 76 61 6c 20 64 61 74 61 20 6b 65 79 29  et-val data key)
00e0: 0a 20 20 28 61 6c 69 73 74 2d 72 65 66 20 6b 65  .  (alist-ref ke
00f0: 79 20 64 61 74 61 20 65 71 75 61 6c 3f 29 29 0a  y data equal?)).
0100: 0a 28 64 65 66 69 6e 65 20 28 61 6e 79 2d 3e 73  .(define (any->s
0110: 74 72 69 6e 67 20 76 61 6c 29 0a 20 20 28 69 66  tring val).  (if
0120: 20 28 73 74 72 69 6e 67 3f 20 76 61 6c 29 0a 20   (string? val). 
0130: 20 20 20 20 20 76 61 6c 0a 20 20 20 20 20 20 28       val.      (
0140: 63 6f 6e 63 20 76 61 6c 29 29 29 0a 0a 28 64 65  conc val)))..(de
0150: 66 69 6e 65 20 28 62 72 61 6e 63 68 2d 6d 61 74  fine (branch-mat
0160: 63 68 20 62 72 61 6e 63 68 65 73 20 74 61 67 73  ch branches tags
0170: 29 0a 20 20 28 69 66 20 28 6c 69 73 74 3f 20 74  ).  (if (list? t
0180: 61 67 73 29 0a 20 20 20 20 20 20 28 61 6e 79 20  ags).      (any 
0190: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 20 20  (lambda (x)..   
01a0: 20 20 28 6d 65 6d 62 65 72 20 78 20 62 72 61 6e    (member x bran
01b0: 63 68 65 73 29 29 0a 09 20 20 20 74 61 67 73 29  ches))..   tags)
01c0: 0a 20 20 20 20 20 20 28 6d 65 6d 62 65 72 20 74  .      (member t
01d0: 61 67 73 20 62 72 61 6e 63 68 65 73 29 29 29 0a  ags branches))).
01e0: 0a 28 64 65 66 69 6e 65 20 28 72 65 66 64 62 2d  .(define (refdb-
01f0: 73 65 74 2d 76 61 6c 75 65 20 64 62 6e 61 6d 65  set-value dbname
0200: 20 73 68 65 65 74 6e 61 6d 65 20 72 6f 77 20 63   sheetname row c
0210: 6f 6c 20 76 61 6c 75 65 29 0a 20 20 28 6c 65 74  ol value).  (let
0220: 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d   ((pid (process-
0230: 72 75 6e 20 22 72 65 66 64 62 22 20 60 28 22 73  run "refdb" `("s
0240: 65 74 22 20 2c 64 62 6e 61 6d 65 20 2c 73 68 65  et" ,dbname ,she
0250: 65 74 6e 61 6d 65 20 2c 72 6f 77 20 2c 63 6f 6c  etname ,row ,col
0260: 20 2c 76 61 6c 75 65 29 29 29 29 0a 20 20 20 20   ,value)))).    
0270: 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 61  (let-values (((a
0280: 20 62 20 63 29 28 70 72 6f 63 65 73 73 2d 77 61   b c)(process-wa
0290: 69 74 20 70 69 64 29 29 29 0a 20 20 20 20 20 20  it pid))).      
02a0: 62 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73  b)))..(define (s
02b0: 65 63 6f 6e 64 73 2d 3e 73 74 64 2d 74 69 6d 65  econds->std-time
02c0: 2d 73 74 72 20 73 65 63 29 0a 20 20 28 74 69 6d  -str sec).  (tim
02d0: 65 2d 3e 73 74 72 69 6e 67 20 0a 20 20 20 28 73  e->string .   (s
02e0: 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69  econds->local-ti
02f0: 6d 65 20 73 65 63 29 0a 20 20 20 22 25 59 2d 25  me sec).   "%Y-%
0300: 6d 2d 25 64 20 25 48 3a 25 4d 3a 25 53 22 29 29  m-%d %H:%M:%S"))
0310: 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 6e 2d 72  ..(define (gen-r
0320: 65 66 64 62 20 64 62 6e 61 6d 65 20 62 72 61 6e  efdb dbname bran
0330: 63 68 65 73 29 0a 20 20 28 69 66 20 28 6e 6f 74  ches).  (if (not
0340: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28   (file-exists? (
0350: 63 6f 6e 63 20 64 62 6e 61 6d 65 20 22 2f 73 68  conc dbname "/sh
0360: 65 65 74 2d 6e 61 6d 65 73 2e 63 66 67 22 29 29  eet-names.cfg"))
0370: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09  ).      (begin..
0380: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 59  (print "ERROR: Y
0390: 6f 75 20 6d 75 73 74 20 70 72 65 63 72 65 61 74  ou must precreat
03a0: 65 20 74 68 65 20 72 65 66 64 62 20 77 69 74 68  e the refdb with
03b0: 20 5c 22 72 65 66 64 62 20 65 64 69 74 20 3c 64   \"refdb edit <d
03c0: 62 6e 61 6d 65 3e 5c 22 22 29 0a 09 28 65 78 69  bname>\"")..(exi
03d0: 74 20 31 29 29 29 0a 20 20 28 70 72 69 6e 74 20  t 1))).  (print 
03e0: 22 47 65 74 74 69 6e 67 20 64 61 74 61 20 66 72  "Getting data fr
03f0: 6f 6d 20 74 69 6d 65 6c 69 6e 65 2e 2e 2e 22 29  om timeline...")
0400: 0a 20 20 28 6c 65 74 2a 20 28 28 64 61 74 61 20  .  (let* ((data 
0410: 28 67 65 74 2d 74 69 6d 65 6c 69 6e 65 29 29 0a  (get-timeline)).
0420: 09 20 28 62 72 61 6e 63 68 65 73 20 28 73 74 72  . (branches (str
0430: 69 6e 67 2d 73 70 6c 69 74 20 62 72 61 6e 63 68  ing-split branch
0440: 65 73 20 22 2c 22 29 29 29 0a 20 20 20 20 28 70  es ","))).    (p
0450: 72 69 6e 74 20 22 47 6f 74 20 64 61 74 61 20 66  rint "Got data f
0460: 72 6f 6d 20 74 69 6d 65 6c 69 6e 65 2e 2e 2e 22  rom timeline..."
0470: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 69  ).    (let* ((ti
0480: 6d 65 6c 69 6e 65 20 28 67 65 74 2d 76 61 6c 20  meline (get-val 
0490: 28 67 65 74 2d 76 61 6c 20 64 61 74 61 20 22 70  (get-val data "p
04a0: 61 79 6c 6f 61 64 22 29 20 22 74 69 6d 65 6c 69  ayload") "timeli
04b0: 6e 65 22 29 29 29 0a 20 20 20 20 20 20 28 70 72  ne"))).      (pr
04c0: 69 6e 74 20 22 47 6f 74 20 22 20 28 6c 65 6e 67  int "Got " (leng
04d0: 74 68 20 74 69 6d 65 6c 69 6e 65 29 20 22 20 74  th timeline) " t
04e0: 69 6d 65 6c 69 6e 65 20 72 65 63 6f 72 64 73 2e  imeline records.
04f0: 20 46 69 6c 6c 69 6e 67 20 72 65 66 64 62 2e 2e   Filling refdb..
0500: 2e 22 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63  .").    (for-eac
0510: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28  h.     (lambda (
0520: 72 65 63 29 0a 20 20 20 20 20 20 20 28 6c 65 74  rec).       (let
0530: 20 28 28 75 75 69 64 20 28 67 65 74 2d 76 61 6c   ((uuid (get-val
0540: 20 72 65 63 20 22 75 75 69 64 22 29 29 29 0a 09   rec "uuid")))..
0550: 20 28 69 66 20 28 62 72 61 6e 63 68 2d 6d 61 74   (if (branch-mat
0560: 63 68 20 62 72 61 6e 63 68 65 73 20 28 67 65 74  ch branches (get
0570: 2d 76 61 6c 20 72 65 63 20 22 74 61 67 73 22 29  -val rec "tags")
0580: 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 74  )..     (let ((t
0590: 61 67 6e 75 6d 20 30 29 0a 09 09 20 20 20 28 74  agnum 0)...   (t
05a0: 61 67 73 20 20 20 28 67 65 74 2d 76 61 6c 20 72  ags   (get-val r
05b0: 65 63 20 22 74 61 67 73 22 29 29 29 0a 09 20 20  ec "tags")))..  
05c0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 75 75 69       (print "uui
05d0: 64 3a 20 22 20 75 75 69 64 20 22 20 74 61 67 73  d: " uuid " tags
05e0: 3a 20 22 20 28 67 65 74 2d 76 61 6c 20 72 65 63  : " (get-val rec
05f0: 20 22 74 61 67 73 22 29 29 0a 09 20 20 20 20 20   "tags"))..     
0600: 20 20 3b 3b 20 46 69 72 73 74 20 74 68 65 20 74    ;; First the t
0610: 61 67 73 20 73 6f 20 74 68 65 79 20 61 72 65 20  ags so they are 
0620: 76 69 73 69 62 6c 65 20 74 6f 20 6c 65 66 74 0a  visible to left.
0630: 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63  .       (for-eac
0640: 68 0a 09 09 28 6c 61 6d 62 64 61 20 28 74 61 67  h...(lambda (tag
0650: 76 29 0a 09 09 20 20 28 72 65 66 64 62 2d 73 65  v)...  (refdb-se
0660: 74 2d 76 61 6c 75 65 20 64 62 6e 61 6d 65 20 22  t-value dbname "
0670: 74 69 6d 65 6c 69 6e 65 22 20 75 75 69 64 20 28  timeline" uuid (
0680: 63 6f 6e 63 20 22 74 61 67 22 20 74 61 67 6e 75  conc "tag" tagnu
0690: 6d 29 20 74 61 67 76 29 0a 09 09 20 20 28 73 65  m) tagv)...  (se
06a0: 74 21 20 74 61 67 6e 75 6d 20 28 2b 20 74 61 67  t! tagnum (+ tag
06b0: 6e 75 6d 20 31 29 29 29 0a 09 09 28 69 66 20 28  num 1)))...(if (
06c0: 6c 69 73 74 3f 20 74 61 67 73 29 0a 09 09 20 20  list? tags)...  
06d0: 20 20 74 61 67 73 0a 09 09 20 20 20 20 28 6c 69    tags...    (li
06e0: 73 74 20 74 61 67 73 29 29 29 0a 09 20 20 20 20  st tags)))..    
06f0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 28     (for-each...(
0700: 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 20  lambda (key)... 
0710: 20 28 72 65 66 64 62 2d 73 65 74 2d 76 61 6c 75   (refdb-set-valu
0720: 65 20 64 62 6e 61 6d 65 20 22 74 69 6d 65 6c 69  e dbname "timeli
0730: 6e 65 22 20 75 75 69 64 20 6b 65 79 20 28 61 6e  ne" uuid key (an
0740: 79 2d 3e 73 74 72 69 6e 67 20 28 67 65 74 2d 76  y->string (get-v
0750: 61 6c 20 72 65 63 20 6b 65 79 29 29 29 29 0a 09  al rec key))))..
0760: 09 27 28 22 75 73 65 72 22 20 22 63 6f 6d 6d 65  .'("user" "comme
0770: 6e 74 22 29 29 0a 09 20 20 20 20 20 20 20 28 72  nt"))..       (r
0780: 65 66 64 62 2d 73 65 74 2d 76 61 6c 75 65 20 64  efdb-set-value d
0790: 62 6e 61 6d 65 20 22 65 78 74 72 61 22 20 75 75  bname "extra" uu
07a0: 69 64 20 22 70 61 72 65 6e 74 73 22 20 28 73 74  id "parents" (st
07b0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65  ring-intersperse
07c0: 20 28 67 65 74 2d 76 61 6c 20 72 65 63 20 22 70   (get-val rec "p
07d0: 61 72 65 6e 74 73 22 29 20 22 2c 22 29 29 0a 09  arents") ","))..
07e0: 20 20 20 20 20 20 20 28 72 65 66 64 62 2d 73 65         (refdb-se
07f0: 74 2d 76 61 6c 75 65 20 64 62 6e 61 6d 65 20 22  t-value dbname "
0800: 74 69 6d 65 6c 69 6e 65 22 20 75 75 69 64 20 22  timeline" uuid "
0810: 74 69 6d 65 73 74 61 6d 70 22 20 28 73 65 63 6f  timestamp" (seco
0820: 6e 64 73 2d 3e 73 74 64 2d 74 69 6d 65 2d 73 74  nds->std-time-st
0830: 72 20 28 67 65 74 2d 76 61 6c 20 72 65 63 20 22  r (get-val rec "
0840: 74 69 6d 65 73 74 61 6d 70 22 29 29 29 0a 09 20  timestamp"))).. 
0850: 20 20 20 20 20 20 28 72 65 66 64 62 2d 73 65 74        (refdb-set
0860: 2d 76 61 6c 75 65 20 64 62 6e 61 6d 65 20 22 74  -value dbname "t
0870: 69 6d 65 6c 69 6e 65 22 20 75 75 69 64 20 22 74  imeline" uuid "t
0880: 69 6d 65 73 74 61 6d 70 5f 73 65 63 22 20 28 61  imestamp_sec" (a
0890: 6e 79 2d 3e 73 74 72 69 6e 67 20 28 67 65 74 2d  ny->string (get-
08a0: 76 61 6c 20 72 65 63 20 22 74 69 6d 65 73 74 61  val rec "timesta
08b0: 6d 70 22 29 29 29 0a 09 20 20 20 20 20 20 20 29  mp")))..       )
08c0: 29 29 29 0a 20 20 20 20 20 74 69 6d 65 6c 69 6e  ))).     timelin
08d0: 65 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28  e))))..(define (
08e0: 65 73 63 61 70 65 2d 73 74 72 69 6e 67 2d 66 6f  escape-string-fo
08f0: 72 2d 62 61 73 68 20 73 74 72 29 0a 20 20 28 73  r-bash str).  (s
0900: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65  tring-substitute
0910: 20 22 27 22 20 22 27 27 22 20 73 74 72 20 23 74   "'" "''" str #t
0920: 29 29 0a 0a 3b 3b 20 74 61 67 30 20 74 61 67 31  ))..;; tag0 tag1
0930: 20 74 61 67 32 20 63 68 65 72 72 79 70 69 63 6b   tag2 cherrypick
0940: 20 62 61 63 6b 6f 75 74 20 68 69 64 65 20 75 73   backout hide us
0950: 65 64 61 74 65 20 72 65 63 6f 6d 6d 65 6e 74 20  edate recomment 
0960: 75 73 65 72 0a 3b 3b 20 63 6f 6d 6d 65 6e 74 20  user.;; comment 
0970: 74 69 6d 65 73 74 61 6d 70 20 74 69 6d 65 73 74  timestamp timest
0980: 61 6d 70 5f 73 65 63 0a 3b 3b 0a 28 64 65 66 69  amp_sec.;;.(defi
0990: 6e 65 20 28 67 65 74 2d 6e 6f 64 65 2d 64 65 74  ne (get-node-det
09a0: 61 69 6c 73 20 64 62 20 6e 6f 64 65 2d 69 64 29  ails db node-id)
09b0: 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 75 6c  .  (let* ((resul
09c0: 74 20 23 66 29 0a 09 20 28 63 6f 75 6e 74 20 20  t #f).. (count  
09d0: 30 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63  0)).    (for-eac
09e0: 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62  h-row.     (lamb
09f0: 64 61 20 28 72 6f 77 6b 65 79 20 74 61 67 30 20  da (rowkey tag0 
0a00: 63 6d 64 6e 75 6d 20 63 68 65 72 72 79 70 69 63  cmdnum cherrypic
0a10: 6b 20 64 6f 2d 63 6f 6d 6d 69 74 20 62 61 63 6b  k do-commit back
0a20: 6f 75 74 20 68 69 64 65 20 75 73 65 64 61 74 65  out hide usedate
0a30: 20 72 65 63 6f 6d 6d 65 6e 74 20 75 73 65 72 20   recomment user 
0a40: 63 6f 6d 6d 65 6e 74 20 74 69 6d 65 73 74 61 6d  comment timestam
0a50: 70 20 74 69 6d 65 73 74 61 6d 70 5f 73 65 63 29  p timestamp_sec)
0a60: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65  .       (set! re
0a70: 73 75 6c 74 20 60 28 28 75 75 69 64 20 2e 20 2c  sult `((uuid . ,
0a80: 72 6f 77 6b 65 79 29 0a 09 09 20 20 20 20 20 20  rowkey)...      
0a90: 28 74 61 67 30 20 2e 20 2c 74 61 67 30 29 0a 09  (tag0 . ,tag0)..
0aa0: 09 20 20 20 20 20 20 28 63 6d 64 6e 75 6d 20 2e  .      (cmdnum .
0ab0: 20 2c 63 6d 64 6e 75 6d 29 0a 09 09 20 20 20 20   ,cmdnum)...    
0ac0: 20 20 28 63 68 65 72 72 79 70 69 63 6b 20 2e 20    (cherrypick . 
0ad0: 2c 63 68 65 72 72 79 70 69 63 6b 29 0a 09 09 20  ,cherrypick)... 
0ae0: 20 20 20 20 20 28 64 6f 2d 63 6f 6d 6d 69 74 20       (do-commit 
0af0: 20 2e 20 2c 64 6f 2d 63 6f 6d 6d 69 74 29 0a 09   . ,do-commit)..
0b00: 09 20 20 20 20 20 20 28 62 61 63 6b 6f 75 74 20  .      (backout 
0b10: 20 20 20 2e 20 2c 62 61 63 6b 6f 75 74 29 0a 09     . ,backout)..
0b20: 09 20 20 20 20 20 20 28 68 69 64 65 20 2e 20 2c  .      (hide . ,
0b30: 68 69 64 65 29 0a 09 09 20 20 20 20 20 20 28 75  hide)...      (u
0b40: 73 65 64 61 74 65 20 2e 20 2c 75 73 65 64 61 74  sedate . ,usedat
0b50: 65 29 0a 09 09 20 20 20 20 20 20 28 72 65 63 6f  e)...      (reco
0b60: 6d 6d 65 6e 74 20 2e 20 2c 72 65 63 6f 6d 6d 65  mment . ,recomme
0b70: 6e 74 29 0a 09 09 20 20 20 20 20 20 28 75 73 65  nt)...      (use
0b80: 72 20 2e 20 2c 75 73 65 72 29 0a 09 09 20 20 20  r . ,user)...   
0b90: 20 20 20 28 63 6f 6d 6d 65 6e 74 20 2e 20 2c 63     (comment . ,c
0ba0: 6f 6d 6d 65 6e 74 29 0a 09 09 20 20 20 20 20 20  omment)...      
0bb0: 28 74 69 6d 65 73 74 61 6d 70 20 2e 20 2c 74 69  (timestamp . ,ti
0bc0: 6d 65 73 74 61 6d 70 29 0a 09 09 20 20 20 20 20  mestamp)...     
0bd0: 20 28 74 69 6d 65 73 74 61 6d 70 5f 73 65 63 20   (timestamp_sec 
0be0: 2e 20 2c 74 69 6d 65 73 74 61 6d 70 5f 73 65 63  . ,timestamp_sec
0bf0: 29 29 29 0a 20 20 20 20 20 20 20 28 73 65 74 21  ))).       (set!
0c00: 20 63 6f 75 6e 74 20 28 2b 20 63 6f 75 6e 74 20   count (+ count 
0c10: 31 29 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20  1))).     db.   
0c20: 20 20 22 53 45 4c 45 43 54 20 72 6f 77 6b 65 79    "SELECT rowkey
0c30: 2c 74 61 67 30 2c 63 6d 64 6e 75 6d 2c 63 68 65  ,tag0,cmdnum,che
0c40: 72 72 79 70 69 63 6b 2c 64 6f 5f 63 6f 6d 6d 69  rrypick,do_commi
0c50: 74 2c 62 61 63 6b 6f 75 74 2c 68 69 64 65 2c 75  t,backout,hide,u
0c60: 73 65 64 61 74 65 2c 72 65 63 6f 6d 6d 65 6e 74  sedate,recomment
0c70: 2c 75 73 65 72 2c 63 6f 6d 6d 65 6e 74 2c 74 69  ,user,comment,ti
0c80: 6d 65 73 74 61 6d 70 2c 74 69 6d 65 73 74 61 6d  mestamp,timestam
0c90: 70 5f 73 65 63 20 46 52 4f 4d 20 74 69 6d 65 6c  p_sec FROM timel
0ca0: 69 6e 65 20 57 48 45 52 45 20 72 6f 77 6b 65 79  ine WHERE rowkey
0cb0: 20 4c 49 4b 45 20 3f 3b 22 0a 20 20 20 20 20 6e   LIKE ?;".     n
0cc0: 6f 64 65 2d 69 64 29 0a 20 20 20 20 28 69 66 20  ode-id).    (if 
0cd0: 28 3e 20 63 6f 75 6e 74 20 31 29 0a 09 28 70 72  (> count 1)..(pr
0ce0: 69 6e 74 20 22 57 41 52 4e 49 4e 47 3a 20 6d 6f  int "WARNING: mo
0cf0: 72 65 20 74 68 61 6e 20 6f 6e 65 20 6e 6f 64 65  re than one node
0d00: 20 6d 61 74 63 68 65 73 20 22 20 6e 6f 64 65 2d   matches " node-
0d10: 69 64 20 22 2c 20 66 6f 75 6e 64 20 22 20 63 6f  id ", found " co
0d20: 75 6e 74 20 22 20 6e 6f 64 65 73 22 29 29 0a 20  unt " nodes")). 
0d30: 20 20 20 72 65 73 75 6c 74 29 29 0a 0a 3b 3b 20     result))..;; 
0d40: 67 65 74 20 62 72 61 6e 63 68 65 73 20 74 6f 20  get branches to 
0d50: 63 72 65 61 74 65 0a 3b 3b 0a 28 64 65 66 69 6e  create.;;.(defin
0d60: 65 20 28 67 65 74 2d 6e 65 77 2d 62 72 61 6e 63  e (get-new-branc
0d70: 68 65 73 20 64 62 29 0a 20 20 28 6c 65 74 2a 20  hes db).  (let* 
0d80: 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20  ((res '())).    
0d90: 28 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20  (for-each-row.  
0da0: 20 20 20 28 6c 61 6d 62 64 61 20 28 72 6f 77 6b     (lambda (rowk
0db0: 65 79 20 6e 6f 64 65 20 6d 6f 64 65 29 0a 20 20  ey node mode).  
0dc0: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28       (set! res (
0dd0: 63 6f 6e 73 20 60 28 28 62 72 61 6e 63 68 20 2e  cons `((branch .
0de0: 20 2c 72 6f 77 6b 65 79 29 0a 09 09 09 20 28 6e   ,rowkey).... (n
0df0: 6f 64 65 20 20 20 2e 20 2c 6e 6f 64 65 29 0a 09  ode   . ,node)..
0e00: 09 09 20 28 6d 6f 64 65 20 20 20 2e 20 2c 6d 6f  .. (mode   . ,mo
0e10: 64 65 29 29 0a 09 09 20 20 20 20 20 20 20 72 65  de))...       re
0e20: 73 29 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20  s))).     db.   
0e30: 20 20 22 53 45 4c 45 43 54 20 72 6f 77 6b 65 79    "SELECT rowkey
0e40: 2c 6e 6f 64 65 2c 6d 6f 64 65 20 46 52 4f 4d 20  ,node,mode FROM 
0e50: 62 72 61 6e 63 68 65 73 3b 22 29 0a 20 20 20 20  branches;").    
0e60: 72 65 73 29 29 0a 0a 3b 3b 20 67 65 74 20 63 68  res))..;; get ch
0e70: 65 72 72 79 70 69 63 6b 73 0a 3b 3b 0a 28 64 65  errypicks.;;.(de
0e80: 66 69 6e 65 20 28 67 65 74 2d 63 68 65 72 72 79  fine (get-cherry
0e90: 2d 70 69 63 6b 73 20 64 62 29 0a 20 20 28 6c 65  -picks db).  (le
0ea0: 74 2a 20 28 28 72 65 73 20 27 28 29 29 29 0a 20  t* ((res '())). 
0eb0: 20 20 20 28 66 6f 72 2d 65 61 63 68 2d 72 6f 77     (for-each-row
0ec0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72  .     (lambda (r
0ed0: 6f 77 6b 65 79 20 74 61 67 30 20 63 68 65 72 72  owkey tag0 cherr
0ee0: 79 70 69 63 6b 20 64 6f 2d 63 6f 6d 6d 69 74 20  ypick do-commit 
0ef0: 75 73 65 64 61 74 65 20 63 6f 6d 6d 65 6e 74 20  usedate comment 
0f00: 72 65 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 20  recomment).     
0f10: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e    (set! res (con
0f20: 73 20 60 28 28 75 75 69 64 20 20 20 20 20 20 20  s `((uuid       
0f30: 2e 20 2c 72 6f 77 6b 65 79 29 0a 09 09 09 20 28  . ,rowkey).... (
0f40: 74 61 67 30 20 20 20 20 20 20 20 2e 20 2c 74 61  tag0       . ,ta
0f50: 67 30 29 0a 09 09 09 20 28 63 68 65 72 72 79 70  g0).... (cherryp
0f60: 69 63 6b 20 2e 20 2c 63 68 65 72 72 79 70 69 63  ick . ,cherrypic
0f70: 6b 29 0a 09 09 09 20 28 64 6f 2d 63 6f 6d 6d 69  k).... (do-commi
0f80: 74 20 20 2e 20 2c 64 6f 2d 63 6f 6d 6d 69 74 29  t  . ,do-commit)
0f90: 0a 09 09 09 20 28 75 73 65 64 61 74 65 20 20 20  .... (usedate   
0fa0: 20 2e 20 2c 75 73 65 64 61 74 65 29 0a 09 09 09   . ,usedate)....
0fb0: 20 28 63 6f 6d 6d 65 6e 74 20 20 20 20 2e 20 2c   (comment    . ,
0fc0: 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 20 28 72 65  comment).... (re
0fd0: 63 6f 6d 6d 65 6e 74 20 20 2e 20 2c 72 65 63 6f  comment  . ,reco
0fe0: 6d 6d 65 6e 74 29 29 0a 09 09 20 20 20 20 20 20  mment))...      
0ff0: 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 20   res))).     db 
1000: 3b 3b 20 73 6f 72 74 20 64 65 73 63 20 61 6e 64  ;; sort desc and
1010: 20 74 68 65 20 63 6f 6e 73 20 70 75 74 73 20 69   the cons puts i
1020: 74 20 62 61 63 6b 20 69 6e 20 63 6f 72 72 65 63  t back in correc
1030: 74 20 6f 72 64 65 72 0a 20 20 20 20 20 22 53 45  t order.     "SE
1040: 4c 45 43 54 20 72 6f 77 6b 65 79 2c 74 61 67 30  LECT rowkey,tag0
1050: 2c 63 68 65 72 72 79 70 69 63 6b 2c 64 6f 5f 63  ,cherrypick,do_c
1060: 6f 6d 6d 69 74 2c 75 73 65 64 61 74 65 2c 63 6f  ommit,usedate,co
1070: 6d 6d 65 6e 74 2c 72 65 63 6f 6d 6d 65 6e 74 20  mment,recomment 
1080: 46 52 4f 4d 20 74 69 6d 65 6c 69 6e 65 20 57 48  FROM timeline WH
1090: 45 52 45 20 63 68 65 72 72 79 70 69 63 6b 20 21  ERE cherrypick !
10a0: 3d 20 27 27 20 41 4e 44 20 63 68 65 72 72 79 70  = '' AND cherryp
10b0: 69 63 6b 20 4e 4f 54 20 4e 55 4c 4c 20 4f 52 44  ick NOT NULL ORD
10c0: 45 52 20 42 59 20 74 69 6d 65 73 74 61 6d 70 5f  ER BY timestamp_
10d0: 73 65 63 20 44 45 53 43 3b 22 29 0a 20 20 20 20  sec DESC;").    
10e0: 72 65 73 29 29 0a 0a 3b 3b 20 61 6c 77 61 79 73  res))..;; always
10f0: 20 70 72 69 76 61 74 65 20 61 6e 64 20 73 61 6d   private and sam
1100: 65 20 74 69 6d 65 20 61 73 20 70 61 72 65 6e 74  e time as parent
1110: 20 6e 6f 64 65 20 2b 20 31 20 73 65 63 6f 6e 64   node + 1 second
1120: 0a 3b 3b 0a 3b 3b 20 66 6f 73 73 69 6c 20 62 72  .;;.;; fossil br
1130: 61 6e 63 68 20 6e 65 77 20 42 52 41 4e 43 48 2d  anch new BRANCH-
1140: 4e 41 4d 45 20 42 41 53 49 53 20 3f 4f 50 54 49  NAME BASIS ?OPTI
1150: 4f 4e 53 3f 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20  ONS?.;; .;;     
1160: 20 20 20 43 72 65 61 74 65 20 61 20 6e 65 77 20     Create a new 
1170: 62 72 61 6e 63 68 20 42 52 41 4e 43 48 2d 4e 41  branch BRANCH-NA
1180: 4d 45 20 6f 66 66 20 6f 66 20 63 68 65 63 6b 2d  ME off of check-
1190: 69 6e 20 42 41 53 49 53 2e 0a 3b 3b 20 20 20 20  in BASIS..;;    
11a0: 20 20 20 20 53 75 70 70 6f 72 74 65 64 20 6f 70      Supported op
11b0: 74 69 6f 6e 73 20 66 6f 72 20 74 68 69 73 20 73  tions for this s
11c0: 75 62 63 6f 6d 6d 61 6e 64 20 69 6e 63 6c 75 64  ubcommand includ
11d0: 65 3a 0a 3b 3b 20 20 20 20 20 20 20 20 2d 2d 70  e:.;;        --p
11e0: 72 69 76 61 74 65 20 20 20 20 20 20 20 20 20 20  rivate          
11f0: 20 20 20 62 72 61 6e 63 68 20 69 73 20 70 72 69     branch is pri
1200: 76 61 74 65 20 28 69 2e 65 2e 2c 20 72 65 6d 61  vate (i.e., rema
1210: 69 6e 73 20 6c 6f 63 61 6c 29 0a 3b 3b 20 20 20  ins local).;;   
1220: 20 20 20 20 20 2d 2d 62 67 63 6f 6c 6f 72 20 43       --bgcolor C
1230: 4f 4c 4f 52 20 20 20 20 20 20 20 75 73 65 20 43  OLOR       use C
1240: 4f 4c 4f 52 20 69 6e 73 74 65 61 64 20 6f 66 20  OLOR instead of 
1250: 61 75 74 6f 6d 61 74 69 63 20 62 61 63 6b 67 72  automatic backgr
1260: 6f 75 6e 64 0a 3b 3b 20 20 20 20 20 20 20 20 2d  ound.;;        -
1270: 2d 6e 6f 73 69 67 6e 20 20 20 20 20 20 20 20 20  -nosign         
1280: 20 20 20 20 20 64 6f 20 6e 6f 74 20 73 69 67 6e       do not sign
1290: 20 63 6f 6e 74 65 6e 74 73 20 6f 6e 20 74 68 69   contents on thi
12a0: 73 20 62 72 61 6e 63 68 0a 3b 3b 20 20 20 20 20  s branch.;;     
12b0: 20 20 20 2d 2d 64 61 74 65 2d 6f 76 65 72 72 69     --date-overri
12c0: 64 65 20 44 41 54 45 20 20 44 41 54 45 20 74 6f  de DATE  DATE to
12d0: 20 75 73 65 20 69 6e 73 74 65 61 64 20 6f 66 20   use instead of 
12e0: 27 6e 6f 77 27 0a 3b 3b 20 20 20 20 20 20 20 20  'now'.;;        
12f0: 2d 2d 75 73 65 72 2d 6f 76 65 72 72 69 64 65 20  --user-override 
1300: 55 53 45 52 20 20 55 53 45 52 20 74 6f 20 75 73  USER  USER to us
1310: 65 20 69 6e 73 74 65 61 64 20 6f 66 20 74 68 65  e instead of the
1320: 20 63 75 72 72 65 6e 74 20 64 65 66 61 75 6c 74   current default
1330: 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 20 20 20 44  .;; .;;        D
1340: 41 54 45 20 6d 61 79 20 62 65 20 22 6e 6f 77 22  ATE may be "now"
1350: 20 6f 72 20 22 59 59 59 59 2d 4d 4d 2d 44 44 54   or "YYYY-MM-DDT
1360: 48 48 3a 4d 4d 3a 53 53 2e 53 53 53 22 2e 20 49  HH:MM:SS.SSS". I
1370: 66 20 69 6e 0a 3b 3b 20 20 20 20 20 20 20 20 79  f in.;;        y
1380: 65 61 72 2d 6d 6f 6e 74 68 2d 64 61 79 20 66 6f  ear-month-day fo
1390: 72 6d 2c 20 69 74 20 6d 61 79 20 62 65 20 74 72  rm, it may be tr
13a0: 75 6e 63 61 74 65 64 2c 20 74 68 65 20 22 54 22  uncated, the "T"
13b0: 20 6d 61 79 20 62 65 0a 3b 3b 20 20 20 20 20 20   may be.;;      
13c0: 20 20 72 65 70 6c 61 63 65 64 20 62 79 20 61 20    replaced by a 
13d0: 73 70 61 63 65 2c 20 61 6e 64 20 69 74 20 6d 61  space, and it ma
13e0: 79 20 61 6c 73 6f 20 6e 61 6d 65 20 61 20 74 69  y also name a ti
13f0: 6d 65 7a 6f 6e 65 20 6f 66 66 73 65 74 0a 3b 3b  mezone offset.;;
1400: 20 20 20 20 20 20 20 20 66 72 6f 6d 20 55 54 43          from UTC
1410: 20 61 73 20 22 2d 48 48 3a 4d 4d 22 20 28 77 65   as "-HH:MM" (we
1420: 73 74 77 61 72 64 29 20 6f 72 20 22 2b 48 48 3a  stward) or "+HH:
1430: 4d 4d 22 20 28 65 61 73 74 77 61 72 64 29 2e 0a  MM" (eastward)..
1440: 3b 3b 20 20 20 20 20 20 20 20 45 69 74 68 65 72  ;;        Either
1450: 20 6e 6f 20 74 69 6d 65 7a 6f 6e 65 20 73 75 66   no timezone suf
1460: 66 69 78 20 6f 72 20 22 5a 22 20 6d 65 61 6e 73  fix or "Z" means
1470: 20 55 54 43 2e 0a 3b 3b 20 0a 28 64 65 66 69 6e   UTC..;; .(defin
1480: 65 20 28 63 72 65 61 74 65 2d 62 72 61 6e 63 68  e (create-branch
1490: 20 64 62 20 62 72 61 6e 63 68 2d 6e 61 6d 65 20   db branch-name 
14a0: 70 61 72 65 6e 74 2d 6e 6f 64 65 29 0a 20 20 28  parent-node).  (
14b0: 6c 65 74 2a 20 28 28 70 61 72 65 6e 74 2d 69 6e  let* ((parent-in
14c0: 66 6f 20 28 67 65 74 2d 6e 6f 64 65 2d 64 65 74  fo (get-node-det
14d0: 61 69 6c 73 20 64 62 20 28 63 6f 6e 63 20 70 61  ails db (conc pa
14e0: 72 65 6e 74 2d 6e 6f 64 65 20 22 25 22 29 29 29  rent-node "%")))
14f0: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 70  ).    (if (not p
1500: 61 72 65 6e 74 2d 69 6e 66 6f 29 0a 09 28 70 72  arent-info)..(pr
1510: 69 6e 74 20 22 45 52 52 4f 52 3a 20 6e 6f 20 69  int "ERROR: no i
1520: 6e 66 6f 20 66 6f 75 6e 64 20 66 6f 72 20 6e 6f  nfo found for no
1530: 64 65 20 22 20 70 61 72 65 6e 74 2d 6e 6f 64 65  de " parent-node
1540: 29 0a 09 28 6c 65 74 2a 20 28 28 70 61 72 65 6e  )..(let* ((paren
1550: 74 2d 64 61 74 65 20 28 61 6c 69 73 74 2d 72 65  t-date (alist-re
1560: 66 20 27 74 69 6d 65 73 74 61 6d 70 20 70 61 72  f 'timestamp par
1570: 65 6e 74 2d 69 6e 66 6f 29 29 0a 09 20 20 20 20  ent-info))..    
1580: 20 20 20 28 70 61 72 65 6e 74 2d 75 73 65 72 20     (parent-user 
1590: 28 61 6c 69 73 74 2d 72 65 66 20 27 75 73 65 72  (alist-ref 'user
15a0: 20 20 20 20 20 20 70 61 72 65 6e 74 2d 69 6e 66        parent-inf
15b0: 6f 29 29 29 0a 09 20 20 28 70 72 69 6e 74 20 22  o)))..  (print "
15c0: 66 6f 73 73 69 6c 20 62 72 61 6e 63 68 20 6e 65  fossil branch ne
15d0: 77 20 22 20 62 72 61 6e 63 68 2d 6e 61 6d 65 20  w " branch-name 
15e0: 22 20 22 20 70 61 72 65 6e 74 2d 6e 6f 64 65 20  " " parent-node 
15f0: 22 20 2d 2d 70 72 69 76 61 74 65 20 2d 2d 64 61  " --private --da
1600: 74 65 2d 6f 76 65 72 72 69 64 65 20 27 22 20 70  te-override '" p
1610: 61 72 65 6e 74 2d 64 61 74 65 20 22 27 22 29 0a  arent-date "'").
1620: 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 43 72  .  ;; (print "Cr
1630: 65 61 74 69 6e 67 20 70 72 69 76 61 74 65 20 62  eating private b
1640: 72 61 6e 63 68 20 22 20 62 72 61 6e 63 68 2d 6e  ranch " branch-n
1650: 61 6d 65 20 22 20 66 72 6f 6d 20 6e 6f 64 65 20  ame " from node 
1660: 22 20 70 61 72 65 6e 74 2d 6e 6f 64 65 29 0a 09  " parent-node)..
1670: 20 20 3b 3b 20 28 70 70 20 70 61 72 65 6e 74 2d    ;; (pp parent-
1680: 69 6e 66 6f 29 0a 09 20 20 3b 3b 20 28 70 72 69  info)..  ;; (pri
1690: 6e 74 20 22 22 29 0a 09 20 20 29 29 29 29 0a 0a  nt "")..  ))))..
16a0: 28 64 65 66 69 6e 65 20 28 64 6f 2d 63 68 65 72  (define (do-cher
16b0: 72 79 70 69 63 6b 20 64 62 20 63 68 65 72 72 79  rypick db cherry
16c0: 70 69 63 6b 20 64 62 66 6e 61 6d 65 29 0a 20 20  pick dbfname).  
16d0: 28 6c 65 74 2a 20 28 28 74 61 67 30 20 20 20 20  (let* ((tag0    
16e0: 28 61 6c 69 73 74 2d 72 65 66 20 27 74 61 67 30  (alist-ref 'tag0
16f0: 20 63 68 65 72 72 79 70 69 63 6b 29 29 0a 09 20   cherrypick)).. 
1700: 28 75 75 69 64 20 20 20 20 28 61 6c 69 73 74 2d  (uuid    (alist-
1710: 72 65 66 20 27 75 75 69 64 20 63 68 65 72 72 79  ref 'uuid cherry
1720: 70 69 63 6b 29 29 0a 09 20 28 6e 6f 64 65 69 6e  pick)).. (nodein
1730: 66 20 28 67 65 74 2d 6e 6f 64 65 2d 64 65 74 61  f (get-node-deta
1740: 69 6c 73 20 64 62 20 75 75 69 64 29 29 0a 09 20  ils db uuid)).. 
1750: 28 6e 6f 64 65 64 61 74 65 20 28 61 6c 69 73 74  (nodedate (alist
1760: 2d 72 65 66 20 27 74 69 6d 65 73 74 61 6d 70 20  -ref 'timestamp 
1770: 6e 6f 64 65 69 6e 66 29 29 0a 09 20 28 75 73 65  nodeinf)).. (use
1780: 72 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66  r     (alist-ref
1790: 20 27 75 73 65 72 20 20 20 20 20 20 6e 6f 64 65   'user      node
17a0: 69 6e 66 29 29 0a 09 20 28 74 61 72 67 20 20 20  inf)).. (targ   
17b0: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 63 68 65   (alist-ref 'che
17c0: 72 72 79 70 69 63 6b 20 63 68 65 72 72 79 70 69  rrypick cherrypi
17d0: 63 6b 29 29 20 3b 3b 20 64 6f 20 66 6f 73 73 69  ck)) ;; do fossi
17e0: 6c 20 75 70 20 74 6f 20 74 68 69 73 20 6e 6f 64  l up to this nod
17f0: 65 0a 09 20 28 64 6f 2d 63 6f 6d 6d 69 74 20 20  e.. (do-commit  
1800: 28 61 6c 69 73 74 2d 72 65 66 20 27 64 6f 2d 63  (alist-ref 'do-c
1810: 6f 6d 6d 69 74 20 20 20 20 20 63 68 65 72 72 79  ommit     cherry
1820: 70 69 63 6b 29 29 20 3b 3b 20 69 66 20 79 65 73  pick)) ;; if yes
1830: 20 64 6f 20 61 20 63 6f 6d 6d 69 74 0a 09 20 28   do a commit.. (
1840: 75 73 65 64 61 74 65 20 28 61 6c 69 73 74 2d 72  usedate (alist-r
1850: 65 66 20 27 75 73 65 64 61 74 65 20 20 20 20 63  ef 'usedate    c
1860: 68 65 72 72 79 70 69 63 6b 29 29 20 3b 3b 20 69  herrypick)) ;; i
1870: 66 20 6e 6f 20 75 73 65 20 63 75 72 72 65 6e 74  f no use current
1880: 20 74 69 6d 65 0a 09 20 28 63 6f 6d 6d 65 6e 74   time.. (comment
1890: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 63 6f 6d   (alist-ref 'com
18a0: 6d 65 6e 74 20 20 20 20 63 68 65 72 72 79 70 69  ment    cherrypi
18b0: 63 6b 29 29 0a 09 20 28 72 65 63 6f 6d 6d 65 6e  ck)).. (recommen
18c0: 74 20 28 61 6c 69 73 74 2d 72 65 66 20 27 72 65  t (alist-ref 're
18d0: 63 6f 6d 6d 65 6e 74 20 63 68 65 72 72 79 70 69  comment cherrypi
18e0: 63 6b 29 29 29 0a 20 20 20 20 28 70 72 69 6e 74  ck))).    (print
18f0: 20 22 23 3d 3d 3d 3d 3d 3d 3d 20 53 74 61 72 74   "#======= Start
1900: 20 6f 66 20 63 68 65 72 72 79 70 69 63 6b 20 66   of cherrypick f
1910: 6f 72 20 22 20 75 75 69 64 20 22 3d 3d 3d 3d 3d  or " uuid "=====
1920: 3d 3d 22 29 0a 20 20 20 20 28 70 72 69 6e 74 20  ==").    (print 
1930: 22 66 6f 73 73 69 6c 20 63 68 65 63 6b 6f 75 74  "fossil checkout
1940: 20 22 20 74 61 72 67 29 0a 20 20 20 20 28 70 72   " targ).    (pr
1950: 69 6e 74 20 22 66 6f 73 73 69 6c 20 6d 65 72 67  int "fossil merg
1960: 65 20 2d 2d 63 68 65 72 72 79 70 69 63 6b 20 22  e --cherrypick "
1970: 20 75 75 69 64 29 0a 20 20 20 20 28 69 66 20 23   uuid).    (if #
1980: 74 20 3b 3b 28 6d 65 6d 62 65 72 20 64 6f 2d 63  t ;;(member do-c
1990: 6f 6d 6d 69 74 20 27 28 22 78 22 20 22 79 65 73  ommit '("x" "yes
19a0: 22 29 29 0a 09 28 70 72 69 6e 74 20 22 66 6f 73  "))..(print "fos
19b0: 73 69 6c 20 63 6f 6d 6d 69 74 20 2d 6d 20 27 22  sil commit -m '"
19c0: 20 28 65 73 63 61 70 65 2d 73 74 72 69 6e 67 2d   (escape-string-
19d0: 66 6f 72 2d 62 61 73 68 20 63 6f 6d 6d 65 6e 74  for-bash comment
19e0: 29 20 22 27 20 22 0a 09 20 20 20 20 20 20 20 28  ) "' "..       (
19f0: 69 66 20 28 65 71 75 61 6c 3f 20 75 73 65 64 61  if (equal? useda
1a00: 74 65 20 22 6e 6f 22 29 0a 09 09 20 20 20 22 22  te "no")...   ""
1a10: 0a 09 09 20 20 20 28 63 6f 6e 63 20 22 20 2d 2d  ...   (conc " --
1a20: 64 61 74 65 2d 6f 76 65 72 72 69 64 65 20 27 22  date-override '"
1a30: 20 6e 6f 64 65 64 61 74 65 20 22 27 22 29 29 0a   nodedate "'")).
1a40: 09 20 20 20 20 20 20 20 22 20 2d 2d 75 73 65 72  .       " --user
1a50: 2d 6f 76 65 72 72 69 64 65 20 22 20 75 73 65 72  -override " user
1a60: 0a 09 20 20 20 20 20 20 20 29 29 0a 20 20 20 20  ..       )).    
1a70: 28 70 72 69 6e 74 20 22 69 66 20 5b 5b 20 24 28  (print "if [[ $(
1a80: 66 6f 73 73 69 6c 20 73 74 61 74 75 73 20 7c 20  fossil status | 
1a90: 67 72 65 70 20 43 4f 4e 46 4c 49 43 54 20 7c 20  grep CONFLICT | 
1aa0: 77 63 20 2d 6c 29 20 2d 67 74 20 30 20 5d 5d 3b  wc -l) -gt 0 ]];
1ab0: 74 68 65 6e 22 29 0a 20 20 20 20 28 70 72 69 6e  then").    (prin
1ac0: 74 20 22 20 20 65 63 68 6f 20 48 41 56 45 20 43  t "  echo HAVE C
1ad0: 4f 4e 46 4c 49 43 54 20 2d 20 53 54 4f 50 50 49  ONFLICT - STOPPI
1ae0: 4e 47 22 29 0a 20 20 20 20 28 70 72 69 6e 74 20  NG").    (print 
1af0: 22 20 20 65 78 69 74 20 31 22 29 0a 20 20 20 20  "  exit 1").    
1b00: 28 70 72 69 6e 74 20 22 65 6c 73 65 22 29 0a 20  (print "else"). 
1b10: 20 20 20 28 70 72 69 6e 74 20 22 20 20 65 63 68     (print "  ech
1b20: 6f 20 47 4f 4f 44 2c 20 6d 61 72 6b 69 6e 67 20  o GOOD, marking 
1b30: 6e 6f 64 65 20 22 20 75 75 69 64 20 22 20 61 73  node " uuid " as
1b40: 20 44 4f 4e 45 22 29 0a 20 20 20 20 28 70 72 69   DONE").    (pri
1b50: 6e 74 20 22 20 20 72 65 66 64 62 20 73 65 74 20  nt "  refdb set 
1b60: 22 20 64 62 66 6e 61 6d 65 20 22 20 74 69 6d 65  " dbfname " time
1b70: 6c 69 6e 65 20 22 20 75 75 69 64 20 22 20 73 74  line " uuid " st
1b80: 61 74 75 73 20 44 4f 4e 45 22 29 0a 20 20 20 20  atus DONE").    
1b90: 28 70 72 69 6e 74 20 22 66 69 22 29 0a 20 20 20  (print "fi").   
1ba0: 20 28 70 72 69 6e 74 20 22 23 3d 3d 3d 3d 3d 3d   (print "#======
1bb0: 3d 20 65 6e 64 20 6f 66 20 63 68 65 72 72 79 70  = end of cherryp
1bc0: 69 63 6b 20 66 6f 72 20 22 20 75 75 69 64 20 22  ick for " uuid "
1bd0: 3d 3d 3d 3d 3d 3d 3d 22 29 0a 20 20 20 20 28 70  =======").    (p
1be0: 72 69 6e 74 20 22 22 29 0a 20 20 20 20 29 29 0a  rint "").    )).
1bf0: 09 09 20 20 20 0a 3b 3b 20 0a 28 64 65 66 69 6e  ..   .;; .(defin
1c00: 65 20 28 67 65 6e 2d 72 65 62 61 73 65 2d 63 6f  e (gen-rebase-co
1c10: 6d 6d 61 6e 64 73 20 64 62 6e 61 6d 65 29 0a 20  mmands dbname). 
1c20: 20 28 6c 65 74 2a 20 28 28 73 71 6c 64 62 6e 61   (let* ((sqldbna
1c30: 6d 65 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22  me (conc "/tmp/"
1c40: 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e   (current-user-n
1c50: 61 6d 65 29 20 22 2d 22 20 64 62 6e 61 6d 65 20  ame) "-" dbname 
1c60: 22 2e 64 62 22 29 29 0a 09 20 28 64 62 66 6e 61  ".db")).. (dbfna
1c70: 6d 65 20 20 20 28 63 6f 6e 63 20 28 63 75 72 72  me   (conc (curr
1c80: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22  ent-directory) "
1c90: 2f 22 20 64 62 6e 61 6d 65 29 29 29 20 3b 3b 20  /" dbname))) ;; 
1ca0: 77 61 6e 74 20 74 68 65 20 66 75 6c 6c 79 20 71  want the fully q
1cb0: 75 61 6c 69 66 69 65 64 20 70 61 74 68 20 73 6f  ualified path so
1cc0: 20 77 65 20 63 61 6e 20 63 61 6c 6c 20 74 68 65   we can call the
1cd0: 20 67 65 6e 65 72 61 74 65 64 20 73 63 72 69 70   generated scrip
1ce0: 74 20 66 72 6f 6d 20 61 6e 79 77 68 65 72 65 0a  t from anywhere.
1cf0: 20 20 20 20 28 70 72 69 6e 74 20 22 23 20 43 72      (print "# Cr
1d00: 65 61 74 65 20 73 71 6c 69 74 65 20 64 62 20 22  eate sqlite db "
1d10: 20 73 71 6c 64 62 6e 61 6d 65 20 22 2e 2e 2e 22   sqldbname "..."
1d20: 29 0a 20 20 20 20 28 73 79 73 74 65 6d 20 28 63  ).    (system (c
1d30: 6f 6e 63 20 22 72 65 66 64 62 20 64 75 6d 70 32  onc "refdb dump2
1d40: 73 71 6c 69 74 65 33 20 22 20 64 62 6e 61 6d 65  sqlite3 " dbname
1d50: 20 22 20 22 20 73 71 6c 64 62 6e 61 6d 65 29 29   " " sqldbname))
1d60: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20  .    (let* ((db 
1d70: 28 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 73  (open-database s
1d80: 71 6c 64 62 6e 61 6d 65 29 29 0a 09 20 20 20 28  qldbname))..   (
1d90: 62 72 61 6e 63 68 65 73 20 28 67 65 74 2d 6e 65  branches (get-ne
1da0: 77 2d 62 72 61 6e 63 68 65 73 20 64 62 29 29 0a  w-branches db)).
1db0: 09 20 20 20 28 63 68 65 72 72 79 70 69 63 6b 73  .   (cherrypicks
1dc0: 20 28 67 65 74 2d 63 68 65 72 72 79 2d 70 69 63   (get-cherry-pic
1dd0: 6b 73 20 64 62 29 29 29 0a 20 20 20 20 20 20 3b  ks db))).      ;
1de0: 3b 20 63 72 65 61 74 65 20 74 68 65 20 73 65 74  ; create the set
1df0: 75 70 0a 20 20 20 20 20 20 28 64 75 6d 70 2d 73  up.      (dump-s
1e00: 65 74 75 70 20 64 62 29 0a 20 20 20 20 20 20 0a  etup db).      .
1e10: 20 20 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20        ;; create 
1e20: 74 68 65 20 62 72 61 6e 63 68 65 73 0a 20 20 20  the branches.   
1e30: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20     (for-each.   
1e40: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 62 72 61      (lambda (bra
1e50: 6e 63 68 64 61 74 29 0a 09 20 28 63 72 65 61 74  nchdat).. (creat
1e60: 65 2d 62 72 61 6e 63 68 20 64 62 0a 09 09 09 28  e-branch db....(
1e70: 61 6c 69 73 74 2d 72 65 66 20 27 62 72 61 6e 63  alist-ref 'branc
1e80: 68 20 62 72 61 6e 63 68 64 61 74 29 0a 09 09 09  h branchdat)....
1e90: 28 61 6c 69 73 74 2d 72 65 66 20 27 6e 6f 64 65  (alist-ref 'node
1ea0: 20 20 20 62 72 61 6e 63 68 64 61 74 29 29 29 0a     branchdat))).
1eb0: 20 20 20 20 20 20 20 62 72 61 6e 63 68 65 73 29         branches)
1ec0: 0a 0a 20 20 20 20 20 20 3b 3b 20 63 72 65 61 74  ..      ;; creat
1ed0: 65 20 74 68 65 20 63 68 65 72 72 79 70 69 63 6b  e the cherrypick
1ee0: 73 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63  s.      (for-eac
1ef0: 68 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61  h.       (lambda
1f00: 20 28 63 68 65 72 72 79 70 69 63 6b 29 0a 09 20   (cherrypick).. 
1f10: 28 64 6f 2d 63 68 65 72 72 79 70 69 63 6b 20 64  (do-cherrypick d
1f20: 62 20 63 68 65 72 72 79 70 69 63 6b 20 64 62 66  b cherrypick dbf
1f30: 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 63 68  name)).       ch
1f40: 65 72 72 79 70 69 63 6b 73 29 0a 20 20 20 20 20  errypicks).     
1f50: 20 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64   )))..(define (d
1f60: 75 6d 70 2d 73 65 74 75 70 20 64 62 29 0a 20 20  ump-setup db).  
1f70: 28 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20  (for-each-row.  
1f80: 20 28 6c 61 6d 62 64 61 20 28 63 6d 64 29 0a 20   (lambda (cmd). 
1f90: 20 20 20 20 28 70 72 69 6e 74 20 63 6d 64 29 29      (print cmd))
1fa0: 0a 20 20 20 64 62 0a 20 20 20 22 53 45 4c 45 43  .   db.   "SELEC
1fb0: 54 20 63 6f 6d 6d 61 6e 64 20 46 52 4f 4d 20 27  T command FROM '
1fc0: 73 65 74 75 70 27 20 4f 52 44 45 52 20 42 59 20  setup' ORDER BY 
1fd0: 72 6f 77 6b 65 79 20 41 53 43 3b 22 29 29 0a 0a  rowkey ASC;"))..
1fe0: 28 64 65 66 69 6e 65 20 68 65 6c 70 0a 22 66 6f  (define help."fo
1ff0: 73 73 69 6c 72 65 62 61 73 65 20 2d 20 72 65 67  ssilrebase - reg
2000: 69 73 74 65 72 20 63 6f 6d 6d 69 74 73 20 69 6e  ister commits in
2010: 20 61 20 72 65 66 64 62 2c 20 65 64 69 74 20 74   a refdb, edit t
2020: 68 65 6d 20 62 79 20 68 61 6e 64 20 74 68 65 6e  hem by hand then
2030: 20 65 78 65 63 75 74 65 20 74 68 65 6d 0a 0a 57   execute them..W
2040: 41 52 4e 49 4e 47 3a 20 49 74 20 69 73 20 68 69  ARNING: It is hi
2050: 67 68 6c 79 20 72 65 63 6f 6d 6d 65 6e 64 65 64  ghly recommended
2060: 20 79 6f 75 20 64 6f 20 74 68 69 73 20 6f 6e 20   you do this on 
2070: 61 20 64 69 73 63 6f 6e 6e 65 63 74 65 64 20 63  a disconnected c
2080: 6f 70 79 20 6f 66 20 79 6f 75 72 20 66 6f 73 73  opy of your foss
2090: 69 6c 20 64 61 74 61 62 61 73 65 21 21 0a 0a 55  il database!!..U
20a0: 73 61 67 65 3a 20 66 6f 73 73 69 6c 72 65 62 61  sage: fossilreba
20b0: 73 65 20 63 6d 64 20 5b 70 61 72 61 6d 73 20 2e  se cmd [params .
20c0: 2e 2e 5d 0a 20 20 77 68 65 72 65 20 63 6d 64 20  ..].  where cmd 
20d0: 69 73 20 6f 6e 65 20 6f 66 3a 0a 20 20 20 20 67  is one of:.    g
20e0: 65 6e 72 65 66 64 62 20 66 6e 61 6d 65 20 62 31  enrefdb fname b1
20f0: 2c 62 32 2e 2e 2e 20 3a 20 67 65 6e 65 72 61 74  ,b2... : generat
2100: 65 20 61 20 72 65 66 64 62 20 6f 66 20 61 6c 6c  e a refdb of all
2110: 20 74 68 65 20 63 6f 6d 6d 69 74 73 20 66 6f 72   the commits for
2120: 20 62 72 61 6e 63 68 65 73 20 6d 61 74 63 68 69   branches matchi
2130: 6e 67 20 70 61 74 74 65 72 6e 73 20 6c 69 73 74  ng patterns list
2140: 65 64 2c 20 65 64 69 74 20 77 69 74 68 20 5c 22  ed, edit with \"
2150: 72 65 66 64 62 20 65 64 69 74 20 66 6e 61 6d 65  refdb edit fname
2160: 5c 22 0a 20 20 20 20 64 75 6d 70 63 6d 64 73 20  \".    dumpcmds 
2170: 66 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 3a  fname          :
2180: 20 66 72 6f 6d 20 72 65 66 64 62 20 66 6e 61 6d   from refdb fnam
2190: 65 20 64 75 6d 70 20 66 6f 73 73 69 6c 20 63 6f  e dump fossil co
21a0: 6d 6d 61 6e 64 73 20 74 6f 20 69 6d 70 6c 65 6d  mmands to implem
21b0: 65 6e 74 20 74 68 65 20 72 65 62 61 73 65 20 79  ent the rebase y
21c0: 6f 75 20 77 61 6e 74 20 74 6f 20 64 6f 2e 0a 22  ou want to do.."
21d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 69 6e  )..(define (main
21e0: 29 0a 20 20 28 69 66 20 28 3c 20 28 6c 65 6e 67  ).  (if (< (leng
21f0: 74 68 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65  th (command-line
2200: 2d 61 72 67 75 6d 65 6e 74 73 29 29 20 31 29 0a  -arguments)) 1).
2210: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 70        (begin..(p
2220: 72 69 6e 74 20 68 65 6c 70 29 0a 09 28 65 78 69  rint help)..(exi
2230: 74 20 31 29 29 0a 20 20 20 20 20 20 28 6d 61 74  t 1)).      (mat
2240: 63 68 20 28 63 6f 6d 6d 61 6e 64 2d 6c 69 6e 65  ch (command-line
2250: 2d 61 72 67 75 6d 65 6e 74 73 29 0a 09 28 28 22  -arguments)..(("
2260: 67 65 6e 72 65 66 64 62 22 20 66 6e 61 6d 65 20  genrefdb" fname 
2270: 62 72 61 6e 63 68 65 73 29 20 28 67 65 6e 2d 72  branches) (gen-r
2280: 65 66 64 62 20 66 6e 61 6d 65 20 62 72 61 6e 63  efdb fname branc
2290: 68 65 73 29 29 0a 09 28 28 22 64 75 6d 70 63 6d  hes))..(("dumpcm
22a0: 64 73 22 20 66 6e 61 6d 65 29 20 20 20 20 20 20  ds" fname)      
22b0: 20 20 20 20 28 67 65 6e 2d 72 65 62 61 73 65 2d      (gen-rebase-
22c0: 63 6f 6d 6d 61 6e 64 73 20 66 6e 61 6d 65 29 29  commands fname))
22d0: 0a 09 28 65 6c 73 65 0a 09 20 28 70 72 69 6e 74  ..(else.. (print
22e0: 20 22 53 6f 72 72 79 2c 20 64 69 64 6e 27 74 20   "Sorry, didn't 
22f0: 6b 6e 6f 77 20 77 68 61 74 20 74 6f 20 64 6f 20  know what to do 
2300: 77 69 74 68 20 5c 22 22 20 28 73 74 72 69 6e 67  with \"" (string
2310: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 63 6f  -intersperse (co
2320: 6d 6d 61 6e 64 2d 6c 69 6e 65 2d 61 72 67 75 6d  mmand-line-argum
2330: 65 6e 74 73 29 20 22 20 22 29 20 22 5c 22 22 29  ents) " ") "\"")
2340: 0a 09 20 28 65 78 69 74 20 31 29 29 29 29 29 0a  .. (exit 1))))).
2350: 0a 0a 28 6d 61 69 6e 29 0a                       ..(main).