(provide (quote db-two-dbs)) (defun db-process-two-databases (db1 db2 process-lone-record-db1 process-lone-record-db2 process-corresponding-records &optional orderer) (byte-code " ?K \" \"?, H\" \" \"?@ H\" \"! H  H   ! !  q ?H H   #  U \"H =ω  U \"H=ω  U  #HH =ω = ω  \"j ?>H\"H =:ω  ?fH\"H=bω ?. )" [nil ordering-fields-converted orderer db1 db2 db1-first-link db1-link db2-first-link db2-link record1 record2 record-order done1 done2 process-lone-record-db1 t process-lone-record-db2 process-corresponding-records db-order-records db-convert-ordering-fields database-ordered-p db-message "db-process-two-databases: sorting %s." 1 database-sort "Databases are properly ordered." 2 database-empty-p 6 funcall -1 0 error "Bad result %s from orderer."] 22)) (defun db-merge-internal (db1 db2 db3 buffer1 buffer2 buffer3) (byte-code " ! \"!! ! ! !q %" [buffer1 buffer2 buffer3 db1 db2 delete-other-windows switch-to-buffer split-window-vertically / window-height 2 other-window 1 db-process-two-databases (lambda (record) (byte-code " \"" [record db3 database-add-record] 3)) (lambda (record) (byte-code " \"" [record db3 database-add-record] 3)) (lambda (record1 record2) (byte-code " & \"" [record1 record2 db3 buffer1 buffer2 buffer3 database-add-record db-merge-records] 8))] 16)) (defun db-merge nil "\ Merge two databases chosen with completion among read-in databases." (interactive) (byte-code "Ɉ \"GW\"!ZGU4 @ A@Z%\" \" A%\"A !@ !@Ɉ ! !@ H H%IɈ !p    =  q ! =?!`= p = != =?`\"*)*!p    = ? q ! =?!`= 4p =4 !=4 =?<`\"*)* & !p    =g ! q ! =?!`= !p = != =?`\"*)*!p    =! q ! =?!`=!p = != =?`\"*)*!p    =*!q q ! =?E!`=!fp =f !=f =?n`\"*)**.!" [databases-alist db-databases db1 db2 db3 db1-buffer db2-buffer db3-buffer t nil db1-index target-buffer this-buffer dbc-index target-window track-window-point-p db2-index mapcar (lambda (database) (byte-code "HB" [database 1] 2)) 2 error "db-merge requires there to be at least two read-in databases." assoc completing-read "First database to merge? [? for options] " delq "Second database to merge? [? for options] " database-clean-data-display-buffers make-similar-database 1 concat "Merge of `" "' and `" "'" get-buffer-create ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) db-merge-internal db-jump-to-record ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) message "Done merging."] 57)) (defun db-merge-records (record1 record2 database buffer1 buffer2 buffer3) (byte-code " \" | q \" q \"q! !p  ==܎ q ! =?X!`=xp =x !=x =?`\"*)* !p  = q ! =?!`=p = != =?`\"*)*     HWw  H H \"H  H\" H  H\"   \"D  $l \" #    \"%$) T . " [nil record1 record2 buffer1 t buffer2 buffer3 record3 database fieldno contents1 contents2 db1-displayspecs target-buffer this-buffer dbf-displayspecs target-window track-window-point-p db1-displayspec db2-displayspecs db2-displayspec recordfieldspec fieldname equal display-record make-record 0 get-buffer-create ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) 10 database-recordfieldspec db-funcall-maybe 3 record-set-field-from-index fieldnumber->fieldname choose-value] 36)) (defun choose-value (contents1 contents2 fieldname displayspec1 displayspec2) (byte-code " H   ӏ*  ;' (+#!2 }H  P   ׏*Q  ;[ \\+#!g } HH\"z \"}!" [fieldname adc-a->d displayspec1 adc-fieldtext contents1 adc-result vararg-common-1 vararg-common-2 displayspec2 contents2 vararg-common-1 vararg-common-2 t y-or-n-p format "Use first value for %s field? [%s] " 11 err (byte-code " \"" [vararg-common-1 vararg-common-2 funcall] 3) ((wrong-number-of-arguments (byte-code " $" [vararg-common-1 vararg-common-2 nil funcall] 5)) (error (byte-code " @ A\"" [t err signal] 4))) "" "Use second value for %s field? [%s] " (byte-code " \"" [vararg-common-1 vararg-common-2 funcall] 3) ((wrong-number-of-arguments (byte-code " $" [vararg-common-1 vararg-common-2 nil funcall] 5)) (error (byte-code " @ A\"" [t err signal] 4))) equal 12 read-fieldvalue-from-minibuffer error "displayspecs have different display->actual"] 9)) (defun read-fieldvalue-from-minibuffer (fieldname displayspec) (byte-code " H \"! ̏* *" [dac-d->a displayspec dac-fieldtext fieldname vararg-common-1 vararg-common-2 12 read-from-minibuffer format "Enter value for %s field: " err (byte-code " \"" [vararg-common-1 vararg-common-2 funcall] 3) ((wrong-number-of-arguments (byte-code " %" [vararg-common-1 vararg-common-2 nil funcall] 6)) (error (byte-code " @ A\"" [t err signal] 4)))] 5)) (defun databases-compatible (db1 db2) "\ Return t if the database records have the same field names and type, nil otherwise." (byte-code " \"" [db1 db2 recordfieldspecs-compatible] 3)) (defun database-compare-hack (db1 db2) (byte-code " \"? !H H P! P! R! !p=F ֎q!  =?a !`=  p= != =? `\"*)* !p= ێq!  =? !`=  p= != =? `\"*)*!p= G܎q!  =? !`=  <p=< !=< =?D `\"*)* %-" [db1 db2 name1 name2 loners1 loners2 discrep target-buffer this-buffer target-window track-window-point-p databases-compatible error "Incompatible databases." 1 "First Database" "Second Database" get-buffer-create "Loners for " "Discrepancies between " "and " erase-buffer ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) db-process-two-databases (lambda (record) (byte-code " !p = \"QɎq! =?) !`= \"Gp=G !=G =?N `\"*)*" [target-buffer loners1 this-buffer record db1 target-window track-window-point-p get-buffer-create print-record ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point] 12)) (lambda (record) (byte-code " !p = \"QɎq! =?) !`= \"Gp=G !=G =?N `\"*)*" [target-buffer loners2 this-buffer record db2 target-window track-window-point-p get-buffer-create print-record ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point] 12)) (lambda (record1 record2) (byte-code " \"?b !p = #aˎ q ! =?5!`= #Vp =V !=V =?^`\"*)*" [record1 record2 target-buffer discrep this-buffer db1 target-window track-window-point-p equal get-buffer-create print-compare-records ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point] 13))] 38))