(defvar database) (deflocalvar db-default-field-type (quote string) "The type to use for record fields whose type is not explicitly specified.") (defvar db-format-file-path nil "\ List of directories (strings) to search, in order, for format files not found in the directory with their associated databases.") (defvar db-aux-file-path nil "\ List of directories (strings) to search, in order, for auxiliary files not found in the directory with their associated databases.") (defvar db-io-error-p nil) (defvar db-before-read-hooks nil "\ Function or list of functions run immediately before a database is first read but after all local variables are set. The hooks are run in the data display buffer with variable database bound. Variable db-buffer is bound to a buffer containing the database file. This is a global variable. If you set it to be specific to a particular database (for instance, in the format or auxiliary file), then consider having its last action be to reset the variable to nil.") (defvar db-after-read-hooks nil "\ Function or list of functions run after a database is completely read. The hooks are run in the data display buffer with variable database bound. For databases with nonregular formats, you might put a call to `database-stored->actual' here, for instance. This is a global variable. If you set it to be specific to a particular database (for instance, in the format or auxiliary file), then consider having its last action be to reset the variable to nil.") (defvar db-format-file-suffixes (quote (".dbf" ".fmt" "f")) "\ List of format file suffixes; the basename is that of the database file. The suffixes are tried in order; the default is (\".dbf\" \".fmt\" \"f\"). The . that may precede the extension must be specified explicitly.") (defvar db-aux-file-suffixes (quote (".dba" ".aux" "a")) "\ List of auxiliary file suffixes; the basename is that of the database file. The suffixes are tried in order; the default is (\".dba\" \".aux\" \"a\"). The . that may precede the extension must be specified explicitly.") (defun read-database-file (db-file &optional format-file confirm) (interactive "fDatabase file: P") (byte-code "! q ! \"!!  I !I?=J # # HBI !p    =s!ݎ q !  =? !`= ! p =  != =? `\"*)* \" !p    =! q !  =? !`= ! p =  != =? `\"*)* +" [db-io-error-p nil db-buffer data-display-buffer database db-file format-file confirm t target-buffer this-buffer target-window track-window-point-p generate-new-buffer "read-database-file" file-exists-p insert-file-contents message "New database file." read-database-internal-file-layout-maybe 4 31 file-writable-p choose-format-file db-setup-data-display-buffer 7 get-buffer-create run-hooks db-before-read-hooks ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point set-window-point read-database-file-helper db-after-read-hooks ((byte-code "! !q" [this-buffer bufferp buffer-name] 3))] 30)) (defun read-database-internal-file-layout-maybe nil (byte-code "\" `G\\#!b)` \"2A`G\\#A!b)X!c !c b\"fu`G\\#u!b)!c !!!c b\"`G\\#!b)!c!!c!c b\"`G\\#!b)?!p!) " [s t here ";; Database file written by EDB" equal "" search-forward match-end 0 emacs-lisp-mode "; format 0.1" delete-backward-char 1 "2" forward-sexp backward-char " nil" "; format 0.2" "3" backward-sexp "; format 0.3" "4" down-list 16 " t" 14 "; format 0.4" db-message "I don't know if I can read the database, but I'll try." read make-database] 32)) (defun db-file->format-file (db-file) "\ Return a format file or nil." (byte-code " !!  #  !+" [subdir db-file default-directory default-file db-format-file-suffixes db-format-file-path file-name-directory expand-file-name db-locate-file-with-extensions-on-path] 6)) (defun locate-format-file (filename) (byte-code " \"! \")" [checked-filename filename db-format-file-path db-locate-file-on-path expand-file-name error "I can't find a format file named %s."] 5)) (defun choose-format-file (database format-file-default confirm) (byte-code " H  H!Ĉ  ?9!.!0 !*a K! !#Q!\"! ^ !\"$!*" [db-file database default format-file-default nil confirm dir default-directory t 4 8 db-file->format-file file-name-directory expand-file-name locate-format-file read-file-name format "Display format for %s: [default %s] " file-name-nondirectory "Display format for %s: "] 18)) (defun read-database-file-helper (db-buffer database) (byte-code "!q H!p!! K \"\")9 \" ! H6 !9 !Ĉp! B H\" " [db-buffer database record-list t nil db-databases db-message "Reading database..." 16 read "Linking records..." database-set-links-from-list mapcar make-link-from-record database-io-setup database-delete-pre-and-post 20 read-database-file-custom read-database-file-delimited kill-buffer "Done reading database. %s records total." 3] 15)) (defun database-set-links-from-list (database list-of-links) (byte-code " GIˆ @ I A 1 @ \"  A H\"*" [database list-of-links nil prev-link this-link 3 2 link-two] 5)) (defmacro read-database-file-noninternalformat-macro (condition &rest body) (byte-code "C %C#" [condition body append (let* (this-record this-link last-link first-link) (setq dbc-index 0)) (while) ((setq dbc-index (1+ dbc-index)) (if (and db-inform-interval (zerop (% dbc-index db-inform-interval))) (db-message "Reading database...%d" dbc-index))) ((setq this-link (make-link-from-record this-record)) (if (not first-link) (setq first-link this-link last-link this-link)) (link-two last-link this-link) (setq last-link this-link)) ((db-debug-message "read-database-file-noninternalformat-macro: condition satisfied") (if first-link (link-two last-link first-link)) (database-set-first-link database first-link) (database-set-no-of-records database dbc-index))] 8)) (put (quote read-database-file-noninternalformat-macro) (quote lisp-indent-hook) 1) (put (quote read-database-file-noninternalformat-macro) (quote edebug-form-spec) (quote (&rest form))) (defun read-database-file-custom (database) (byte-code " H H H H? H\" H? H ?2 \"8! H  ?K \"\\II Hs \"II !II+)Lj H_ H    eb    !@T\"!\"  \" Lj ! @\"ebLj! d   A A @Z \\\"Lj !?/\"LjN\" I I,, H Heeb dWT\"!\"b!!!Z!\"! d\\  !?\"Lj\" I I,,*" [region->record database record-sepinfo sep-string str db si nil t delimit-record next-start-marker prev-end-pos end-start-pair this-record this-link last-link first-link dbc-index db-inform-interval record-sep-regexp record-sep-regexp-submatch next-start-pos sep-length 20 17 5 6 error "Need a submatch to go with sep-regexp `%s' of record sepinfo." 7 4 equal "" "You haven't specified a string, regexp, or function in record sepinfo." 24 when-not-preceded-by-quotation-char 2 regexp-quote 0 (nil) point-marker marker-position zerop % db-message "Reading database...%d" funcall narrow-to-region widen set-marker make-link-from-record link-two 3 re-search-forward match-end match-beginning] 36)) (defun read-database-file-delimited (database) (byte-code "eb HH HH \" !H ! ! HHHebd!RP!b\\e`\"a\"  \"y‚ ` G\\#!b)e`\"\"db HH HH  \"‚ ` GZ#)db HHcc+ ?! H$ @ A@8P! @P \" A@P \"!. AA@\"5p!!? AA@\" ! !+" [nil database t fieldsep-string recordsep-string confirmation-list field-sepinfo pre-first-field-string pre-first-field-regexp s 18 5 17 database-perform-substitutions read-database-file-delimited-regexp database-full-fieldsep-string database-full-recordsep-string 1 2 looking-at match-end 0 delete-region error "Didn't find match for regexp `%s' leading the first field." equal "" search-forward "Didn't find string `%s' leading the first field." 4 search-backward db-message "Confirming database format..." database-confirm-fieldsep-and-recordsep 10 "Warning: " "The database file is malformed!" "Extra field separator `%s' found in data." "Extra record separator `%s' found in data." yes-or-no-p "Database file is improperly formatted; try to read it anyway? " "Damaged database being read; expecting approximately %s records." kill-buffer "Aborted attempt to read database." "Database looks OK from here; expecting %d records." database-substitute-for-read read-database-file-delimited-string] 28)) (defun read-database-file-delimited-string (database) (byte-code "!eb H HG G H HS`     ىm?kTU\"!]\" \" #z` ` Z P #d d bىW  # ` Z\"$`T P$  \"$ TX   \"H$TU9 #+P\"҉  \"$ b` ! ?Z     \"  <шy \" I I, ! . " [field-sep database record-sep field-sep-length record-sep-length no-of-fields max-field-no here field-no end-of-record-sep end-of-record this-record this-link last-link first-link dbc-index db-inform-interval nil t db-io-error-p db-message "Reading database..." 22 23 10 0 zerop % "Reading database...%d" make-vector search-forward "Warning: " "Didn't find `%s' at end of last field of record %d, and I put it there myself!" record-set-field-from-index buffer-substring "Hit the end of the record after %d fields of record %d (didn't find field-sep `%s')" database-recordfieldspec 2 "Extra fields in record %d packed into the last field; beware when writing." make-link-from-record link-two 3 database-stored->actual] 25)) (defun read-database-file-delimited-regexp (database) (byte-code "!eb H HH HH!H$ H0 H! H8HHNN!HW H Hm m ! Hv H HS`m?T\"!\" \"!ن!b !b!W< #( !\"$ !T8P $ #U!!eP #ddb #P\"ډ\"$b`!?\"و\" I I, ! ." [field-sepinfo database record-sepinfo field-regexp field-regexp-submatch record-regexp record-regexp-submatch pre-first-field-string pre-first-field-regexp pre-first-field-regexp-submatch post-last-field-string post-last-field-regexp post-last-field-regexp-submatch no-of-fields max-field-no here field-no end-of-record-regexp end-of-record this-record this-link last-link first-link dbc-index db-inform-interval nil t db-io-error-p db-message "Reading database..." 18 17 5 regexp-quote 4 6 0 1 2 3 8 9 10 zerop % "Reading database...%d" make-vector looking-at match-end error "Didn't find pre-first stuff I expected." re-search-forward record-set-field-from-index buffer-substring match-beginning "Warning: " "Hit the end of the database after %d fields of record %d (didn't find field-regexp `%s')" "Didn't find `%s' at end of last field of record %d." "Too many fields in record %d; packing them all into the last field; beware when writing." make-link-from-record link-two database-stored->actual] 33)) (defun database-stored->actual (&optional db) (byte-code " !" [db database database-stored->actual-internal] 2)) (defun database-stored->actual-internal (db) (byte-code " H W/ \"H & BB T ƈ! H     H   @@ H @A A  ; \" $a) H  T  =Ɖ Q,)!-" [fno-s->a-alist s->a field-no field-val no-of-fields db nil maprecords-record first-link maplinks-link maplinks-index maplinks-not-done t s->a-pairs 0 10 database-recordfieldspec db-message "Converting from stored record format..." 2 1 6 record-set-field-from-index funcall "Converting record format...done."] 10)) (defun read-db-aux-file (database) (byte-code " H H #!)" [aux-file database db-aux-file-suffixes db-aux-file-path 6 db-locate-file-with-extensions-on-path 4 load-file] 4)) (defun database-delete-pre-and-post (database) (byte-code " HebHH 9 !!Ć!b2H!be`\"6 \"h h  \"JƂY ` G\\#Y!b)de`\"h \"*dbHHĈ!ĈH!b`d\"\"!`d\"\"*H Ĉ  \"Ƃ ` GZ#)? c))" [record-sepinfo database pre-first-record-string pre-first-record-regexp nil s t post-last-record-string post-last-record-regexp sep-string 17 1 2 looking-at match-end 0 3 delete-region error "Didn't find match for regexp `%s' leading the data." equal "" search-forward "Didn't find string `%s' leading the data." 8 9 re-search-backward match-beginning 10 "Didn't find match for post-last-record-regexp `%s'." search-backward "Didn't find post-last-record-string `%s'." 4] 22)) (defun write-database-file (database &optional db-file) (byte-code " % !? !! I\" \"* H!!p =p!! H H H Hp c I I I !)cK \"c, !  ! H HHc HH H! $!* !HHc H Hc* q ! =?!`=p!! Hb H H Hp c I I I !)cK \"c@, !  ! H HHc HH H!A $!* !HHc H HcցBC*p = != =?D`\"*)*E F G " [db-io-error-p nil db-file database target-buffer this-buffer fl ddbs modified-p standard-output major-mode buffer-read-only first-record t record-sepinfo record-sep-string write-region-fn target-window track-window-point-p file-name-directory file-exists-p 4 error "Can't write %s: directory does not exist." get-buffer-create generate-new-buffer "write-database-file" buffer-disable-undo auto-save-mode 0 16 2 7 30 ";; Database file written by EDB; format 0.4 " ((byte-code " I I I" [database fl ddbs modified-p 2 7 30] 3)) print "( " maprecords " ) " (byte-code " ! Ip!*" [require-final-newline nil auto-save-default db-file database write-file 30 kill-buffer] 4) ((error (byte-code "P p! $ ?!p!" [db-io-error-p t error db-file db-debug-p nil db-message "Warning: " "Error `%s' while writing buffer %s to file %s." buffer-name set-buffer-modified-p kill-buffer] 6))) db-copy-buffer-local-variables write-database-mode database-io-setup 17 1 21 db-message "Writing database..." (lambda (record) (byte-code "  c \"" [first-record nil record-sep-string write-region-fn record funcall] 3)) "Writing database...%d" "Writing database to disk..." write-database-file-internal-delimited 8 5 (byte-code " ! Ip!*" [require-final-newline nil auto-save-default db-file database write-file 30 kill-buffer] 4) ((error (byte-code "P p! $! ?!p!" [db-io-error-p t error db-file db-debug-p nil db-message "Warning: " "Error `%s' while writing buffer %s to file %s." buffer-name auto-save-mode 0 set-buffer-modified-p kill-buffer] 6))) ((byte-code "! !q" [this-buffer bufferp buffer-name] 3)) get-buffer-window selected-window window-point ((byte-code " I I I" [database fl ddbs modified-p 2 7 30] 3)) (byte-code " ! Ip!*" [require-final-newline nil auto-save-default db-file database write-file 30 kill-buffer] 4) ((error (byte-code "P p! $ ?!p!" [db-io-error-p t error db-file db-debug-p nil db-message "Warning: " "Error `%s' while writing buffer %s to file %s." buffer-name set-buffer-modified-p kill-buffer] 6))) (lambda (record) (byte-code "  c \"" [first-record nil record-sep-string write-region-fn record funcall] 3)) (byte-code " ! Ip!*" [require-final-newline nil auto-save-default db-file database write-file 30 kill-buffer] 4) ((error (byte-code "P p! $! ?!p!" [db-io-error-p t error db-file db-debug-p nil db-message "Warning: " "Error `%s' while writing buffer %s to file %s." buffer-name auto-save-mode 0 set-buffer-modified-p kill-buffer] 6))) set-window-point database-buffer-p dbc-update-database-modified-p force-mode-line-update] 38)) (defun write-database-file-internal-delimited (database) (byte-code "` H H ! ! H! H+   !?>!  !?M! ! $!d\"  H H$ ̈ @~ A@̈ @P \" \"I A@P \" \"I`\" !B̈   %eb HH   c)db̈ HH\"Â`GZ#)) HH\"Â(`GZ#)3`d\"@ HH HH#̈ . " [previous-point fno first-record t no-of-fields database write-record-function fieldsep-string recordsep-string sub-fieldsep sub-recordsep confirmation-list nil pre-first s 0 10 21 database-full-fieldsep-string database-full-recordsep-string 22 23 database-acceptable-delimiter-p database-generate-delimiter db-message "Writing database..." maprecords (lambda (record) (byte-code "Ɖ W(V c \"H H\"cT c" [fno no-of-fields sub-fieldsep database record sub-recordsep 0 db-funcall-maybe database-recordfieldspec 9] 6)) "Writing database...%d" "Writing database...confirming" narrow-to-region database-confirm-fieldsep-and-recordsep 3 "Warning: " "Tripped over an unexpected field separator `%s' in data; trying again." "Tripped over an unexpected record separator `%s' in data; trying again." delete-region write-database-file-internal-delimited database-substitute-for-write 18 1 "" equal search-backward 17 4 error "Didn't find expected trailing junk `%s' or `%s'." widen] 28)) (defun database-io-setup (database &optional dont-set-regexps) (byte-code " \" !K H\"\"" [nil database dont-set-regexps db-substitution-no-no-string database-check-all-sepinfos db-set-field-quotation-vars apply concat mapcar (lambda (string-cons) (byte-code "@AP" [string-cons] 2)) 29] 9)) (defun db-set-field-variables (database) (byte-code "H?H\"B)I" [database fno nil 14 -1 mapcar (lambda (fieldname) (byte-code "TC" [fno] 2)) 12] 6)) (defun database-check-all-sepinfos (database &optional dont-set-regexps) (byte-code "H %H %H %" [database dont-set-regexps t database-check-sepinfo 17 "record" " " 18 "field" " " 19 "alternative"] 8)) (defun database-check-sepinfo (sepinfo database sepinfo-name &optional sep-string-default dont-set-regexps) (byte-code "H H\"IH+H?(H #H3 ?H ?I \"ZII~ Hq \"II~ !II+H?H\"H? = ? \" IHH?H #H? ?H ? \"II H \"II !II+H*H\"1IHIH?FH #HQ ?H ?g \"xII H \"II !II+" [sepinfo nil sepinfo-name dont-set-regexps str db database si t sep-string-default 1 equal "" 2 3 error "Need a submatch to go with pre-first-regexp `%s' of %s." 24 when-not-preceded-by-quotation-char regexp-quote 0 4 5 "Sep-string must be non-empty in %s." 6 "Need a submatch to go with sep-regexp `%s' of %s." 7 8 9 10 "Need a submatch to go with post-last-regexp `%s' of %s."] 19)) (defun when-not-preceded-by-quotation-char (string database) (byte-code "HH\"! !& " [database string concat "[^" 24 "]" "\\(" regexp-quote make-string 2 "\\)*" "\\)"] 13)) (defmacro sepinfo-set-regexp-and-submatch-from-string (regexp-setter submatch-setter sepinfo string database) (byte-code "D D DE E EE E EE E EEFE" [string database sepinfo regexp-setter submatch-setter let str db si cond (or (null str) (equal "" str)) nil (database-quotation-char db) (when-not-preceded-by-quotation-char str db) 2 t (regexp-quote str) 0] 10)) (defun db-set-fieldname-vars (database &optional fieldnames-list) (byte-code "? HˆG \" \" \"I I I I-" [fieldnames-list database nil no-of-fields fno type recordfieldspecs fieldnames-vector 11 -1 make-vector 12 mapcar (lambda (fname) (byte-code "T : A @ Ĉ !%  I) \" I B" [fno type fname db-default-field-type nil recordfieldspecs fieldnames-vector recordfieldtype-p error "db-set-fieldname-vars: bad type %s"] 5)) 10 13] 7)) (defun recordfieldtype->recordfieldspec (recordfieldtype) "\ Return the recordfieldspec associated with symbol RECORDFIELDTYPE." (byte-code " \"A!9!)" [result recordfieldtype db-recordfieldtypes assoc recordfieldspec-p recordfieldtype->recordfieldspec] 4)) (defun recordfieldtype-p (recordfieldtype) (byte-code " \"" [recordfieldtype db-recordfieldtypes assoc] 3)) (defun database-substitute-for-read (database) (byte-code " ! ! H H ň HH' HHR HH; H; I HHN HNIň ?\\! !j I! !Iňeb H\" H #!ň! H\"! H# I?!! !I H#eb H\"! H\"ň \"," [fieldsep-orig database recordsep-orig fieldsep-sub recordsep-sub nil t database-full-fieldsep-string database-full-recordsep-string 22 23 17 5 18 error "No record separator specified." database-acceptable-delimiter-p db-message "Substituting record delimiter for read..." database-generate-delimiter replace-string db-string-substitute-substring-general-case "Substituting record delimiter for read...done" 20 "fieldsep-orig `%s' is acceptable." "because (or %s %s)" "No field separator specified." "Substituting field delimiter for read..." "Substituting field delimiter for read... (`%s' for `%s')" "Substituting field delimiter for read...done" "sub-fieldsep = %s" database-perform-substitutions] 23)) (defun database-perform-substitutions (database backward) (byte-code "H!!H #  \")!" [database nil ambiguities backward t 29 db-message "Substituting..." buffer-substitute error "Ambiguities: %s" "Substituting...done"] 5)) (defun database-substitute-for-write (database new-fieldsep sub-fieldsep new-recordsep sub-recordsep) (byte-code " \" \"?eb \" \"?.eb \"" [nil database sub-fieldsep new-fieldsep sub-recordsep new-recordsep database-perform-substitutions equal replace-string] 7)) (defmacro conflist-fieldsep-bad-p (conflist) (byte-code "D" [conflist car] 2)) (defmacro conflist-recordsep-bad-p (conflist) (byte-code "DD" [conflist car cdr] 3)) (defmacro conflist-no-of-records (conflist) (byte-code "DDD" [conflist car cdr] 4)) (defun database-confirm-fieldsep-and-recordsep (fieldsep recordsep no-of-fields no-of-records) (byte-code "eb !eb !  S\"  \"ȈȈ B  \\U; E?E| \"!W \"E| T\"!tdb c T\"E| \"E  \" \"  Ȉ  V  \"\\ V  \"\\ U? U? E  \\S\"  !Ղ  \"T\"Ȉ S\"U? W W E)*," [fieldsep-matches fieldsep recordsep-matches recordsep goal-fieldsep-matches no-of-records no-of-fields goal-recordsep-matches nil t f-in-r r-in-f apparent-records db-how-many-string-overlapping * equal zerop % / db-how-many-substring-overlapping 0 1] 23)) (defvar db-substitution-no-no-string nil) (defun database-acceptable-delimiter-p (delimiter) (byte-code "0G  W- \" \"%Ɖ) T +" [delimiter result t string-index delimiter-length db-substitution-no-no-string nil 0 db-find-char elt] 5)) (defun database-generate-delimiter (database &optional check-buffer) (byte-code "\" W ?a I!P +eb#?P H<!\"?P HN!\"?Y] T i!+" [string candidate-char result check-buffer nil t database make-string 1 0 256 database-acceptable-delimiter-p search-forward db-find-char 22 database-full-fieldsep-string 23 database-full-recordsep-string error "I can't find an acceptable delimiter!"] 10)) (defun database-set-temp-delimiters (database db-buffer) (byte-code "" [nil] 1)) (defun db-set-field-quotation-vars (database) (byte-code " H;1G UÉ+ U'\"+\" I)\\ H!!I H[K HV !K\"#I)" [quotation-char database quot-char-len nil t 24 0 elt 1 error "Quotation character should be just that, not some rambling string like `%s'." 25 regexp-quote char-to-string 28 26 mapconcat sort 27 quoted-strings-default string-longer-p-function "\\|"] 14)) (defun field-quote (fieldvalue database) (byte-code "H H \"- !OH !!O !O\"R. " [database fieldvalue 24 string-match 26 0 match-beginning match-end field-quote nil] 12)) (defun field-unquote (fieldvalue database) (byte-code "HMH \" H TH T#U7 O T!O !O\"QE TO TO\"PI )N " [database i fieldvalue 24 string-match 25 28 0 match-end field-unquote nil] 10)) (defun quoted-strings-default (database) (byte-code "H>HHHHHHHHHHHHHHHHHHH!& \"" [database nil 24 delq list 17 1 4 8 18 19 char-to-string] 15)) (defun record-sep-lines-function (n) (byte-code "DF" [n lambda (post-last-item-pos) next-line (let ((here (point))) (cons (1- here) (if (< here post-last-item-pos) here)))] 4))