;ELC ;;; compiled by ckclark@major.MIT.EDU on Tue Aug 3 03:09:26 1993 ;;; from file /afs/sipb.mit.edu/contrib/emacs/elisp19/edb/db-file-io.el ;;; emacs version 19.16.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "This file was compiled for Emacs 19")) (defvar db-default-field-type (quote string) "\ The type to use for record fields whose type is not explicitly specified.") (make-variable-buffer-local (quote db-default-field-type)) (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.") (byte-code "!‡" [boundp db-io-error-p nil] 2) (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.") (byte-code "\"\"" [defalias read-database-file #[(db-file &optional format-file confirm) "!q!\"\"! I !I=F # # HBI !p=l!ێq! =?!`= ! p=!= =`\"+* \" !p=!q! =?!`= ! p=!= =`\"+* +" [nil db-io-error-p generate-new-buffer "read-database-file" database data-display-buffer db-buffer file-exists-p db-file insert-file-contents message "New database file." read-database-internal-file-layout-maybe 4 31 file-writable-p format-file confirm choose-format-file db-setup-data-display-buffer t 7 get-buffer-create this-buffer target-buffer run-hooks db-before-read-hooks ((byte-code " ! ! q" [bufferp this-buffer buffer-name] 2)) get-buffer-window target-window selected-window window-point track-window-point-p set-window-point read-database-file-helper db-after-read-hooks ((byte-code " ! ! q" [bufferp this-buffer buffer-name] 2))] 6 nil "fDatabase file: \nP"] read-database-internal-file-layout-maybe #[nil "š  ` G\\#ŕb)` š0Â> ` G\\#>ŕb)W!c !cbšcÂq ` G\\#qŕb)!c !!!cbšÂ ` G\\#ŕb)!c!!c!cbšÂ ` G\\#ŕb)!p!) " [";; Database file written by EDB" s "" t search-forward 0 here 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] 4]] 3) (defalias 'db-file->format-file #[(db-file) " !\n!  #!!+" [file-name-directory db-file subdir expand-file-name default-directory db-locate-file-with-extensions-on-path db-format-file-suffixes db-format-file-path default-file] 5 "\ Return a format file or nil."]) (byte-code "\"\"\"\"\"##\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"" [defalias locate-format-file #[(filename) " \n\" ! \")" [db-locate-file-on-path filename db-format-file-path checked-filename expand-file-name error "I can't find a format file named %s."] 4] choose-format-file #[(database format-file-default confirm) "H H\n!88\n! , !.  !*dL\n!!#R\n!\"\n!a\n!\"$!*" [database 4 db-file format-file-default 8 db-file->format-file default confirm file-name-directory dir expand-file-name default-directory locate-format-file read-file-name format "Display format for %s: [default %s] " file-name-nondirectory "Display format for %s: " t] 9] read-database-file-helper #[(db-buffer database) "!\nq H#p!! \"\")= \" ! H9 != !p! B H\" " [db-message "Reading database..." db-buffer database 16 read record-list "Linking records..." database-set-links-from-list mapcar make-link-from-record database-io-setup t database-delete-pre-and-post 20 read-database-file-custom read-database-file-delimited kill-buffer db-databases "Done reading database. %s records total." 3] 5] database-set-links-from-list #[(database list-of-links) "\nGI\n@ I\nA(\n@ \" \nA H\"*" [database 3 list-of-links nil this-link prev-link 2 link-two] 5] read-database-file-noninternalformat-macro (macro . #[(condition &rest body) " C %C#" [append (let* (this-record this-link last-link first-link) (setq dbc-index 0)) (while) condition ((setq dbc-index (1+ dbc-index)) (if (and db-inform-interval (zerop (% dbc-index db-inform-interval))) (db-message "Reading database...%d" dbc-index))) body ((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 lisp-indent-hook 1 edebug-form-spec (&rest form) read-database-file-custom #[(database) "HH H H H\" H H 4 ̚8! H N̚]IIHx\"II!II, HA Hщeb  !!%!T!#!#U!\"!!@}eb d~AA@Z\\ѓ!  \" 1 \" I!I. H He)*+,eb !*dW!T!#!#U!\"*b,!++Z)*+} d)\\*~!  \"c  \" I!I.*" [database 20 17 record-sepinfo region->record 5 6 error "Need a submatch to go with sep-regexp `%s' of record sepinfo." 7 4 sep-string "" "You haven't specified a string, regexp, or function in record sepinfo." si db str nil 24 when-not-preceded-by-quotation-char 2 regexp-quote 0 (nil) end-start-pair prev-end-pos next-start-marker delimit-record point-marker this-record this-link last-link first-link dbc-index marker-position db-inform-interval db-message "Reading database...%d" make-link-from-record link-two 3 sep-length next-start-pos record-sep-regexp-submatch record-sep-regexp re-search-forward] 6] read-database-file-delimited #[(database) "ebHHHH\"!!!\n H H Heb^!UӕbUe`|\"ךqł`G\\#ӕb)e`|\"dbHHHHךł`GZ#)dbHHcc+B\nB!\nH$ @ A@9P! @ P\" A@P\n\"!. AA@\"Bp!!B AA@\"!!+" [database 18 5 17 database-perform-substitutions t read-database-file-delimited-regexp database-full-fieldsep-string fieldsep-string database-full-recordsep-string recordsep-string nil confirmation-list field-sepinfo 1 pre-first-field-string 2 pre-first-field-regexp looking-at 0 error "Didn't find match for regexp `%s' leading the first field." s "" 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] 6] read-database-file-delimited-string #[(database) "!eb\nH\nH GG\nH\n\nHS ` mMT]U]\"\n\"#y``ZP#dd b W # `Z{$` TP $ {$ T X\n\"H$T U% #P\"#  {$b` !?\"?Y\"\nI\nI,\n!\n.\n" [db-message "Reading database..." database 22 field-sep 23 record-sep field-sep-length record-sep-length 10 no-of-fields max-field-no here nil field-no end-of-record-sep end-of-record this-record this-link last-link first-link 0 dbc-index db-inform-interval "Reading database...%d" make-vector search-forward t "Warning: " "Didn't find `%s' at end of last field of record %d, and I put it there myself!" record-set-field-from-index "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." db-io-error-p make-link-from-record link-two 3 database-stored->actual] 7] read-database-file-delimited-regexp #[(database) "!eb\nH\nH H\nHH!\n H& H5H!H? H HUU! H^ H Htt! H}\nH\nHS` !\"#$%&'m'T'('(U'\"\"#!̕bb! W.\n##  {$  T P '\n$ #D!\"TP'#d!d\"b\n\"#mP'\"5#\"{$!b`#!$&$&$%%$\"$%&%&\"\n&I\n'I,\n!\n." [db-message "Reading database..." database 18 field-sepinfo 17 record-sepinfo 5 regexp-quote 4 field-regexp 6 0 field-regexp-submatch record-regexp record-regexp-submatch 1 pre-first-field-string 2 pre-first-field-regexp 3 pre-first-field-regexp-submatch 8 post-last-field-string 9 post-last-field-regexp 10 post-last-field-regexp-submatch no-of-fields max-field-no here nil field-no end-of-record-regexp end-of-record this-record this-link last-link first-link dbc-index db-inform-interval "Reading database...%d" make-vector looking-at error "Didn't find pre-first stuff I expected." re-search-forward t record-set-field-from-index "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." db-io-error-p make-link-from-record link-two database-stored->actual] 6] database-stored->actual #[(&optional db) " \n!" [database-stored->actual-internal db database] 2] database-stored->actual-internal #[(db) "\nH W6\n\"H-BBT! \nHH @@ H@AA  ; ! $d)HT=UZ-!-" [nil 0 db 10 no-of-fields field-val field-no s->a fno-s->a-alist database-recordfieldspec db-message "Converting from stored record format..." maprecords-record 2 first-link maplinks-link 1 maplinks-index t maplinks-not-done 6 s->a-pairs record-set-field-from-index "Converting record format...done."] 7] read-db-aux-file #[(database) "H H #!)" [database 6 db-locate-file-with-extensions-on-path 4 db-aux-file-suffixes db-aux-file-path aux-file load-file] 5] database-delete-pre-and-post #[(database) "Heb\nH\nH 6 !-ȕb-\nHbe`|j\"jj ͚I΂Y ` G\\#Yȕb)de`|j\"*db\nH\nH!\nHb`d|\"!`d|\"*\nH ͚΂ ` GZ#)?c*" [database 17 record-sepinfo 1 2 pre-first-record-regexp pre-first-record-string looking-at 0 3 error "Didn't find match for regexp `%s' leading the data." s "" t search-forward "Didn't find string `%s' leading the data." 8 9 post-last-record-regexp post-last-record-string re-search-backward 10 "Didn't find match for post-last-record-regexp `%s'." search-backward "Didn't find post-last-record-string `%s'." 4 sep-string] 5] write-database-file #[(database &optional db-file) "\n$\n!\n!! \nI(\n\"( H!!p   =p!! H H H Hpcڎ I I I !)c \"c, !#$ ! H()(H(Hc H(H H,-! $!* !(H(Hc H Hc* q !: =? :!`==p!! H^ H H Hpc I I I !)c \"c@, !#$ ! H()(H(Hc H(H H,-!݁A $!* !(H(Hc H HcǁBC*=p =: !=: =D:`\"+*E F G " [nil db-io-error-p db-file file-name-directory file-exists-p database 4 error "Can't write %s: directory does not exist." get-buffer-create generate-new-buffer "write-database-file" this-buffer target-buffer buffer-disable-undo auto-save-mode 0 16 2 7 30 standard-output modified-p ddbs fl ";; Database file written by EDB; format 0.4\n" ((byte-code "\nI II" [database 2 fl 7 ddbs 30 modified-p] 3)) print "(\n" maprecords "\n)\n" (byte-code " ! Ip!*" [nil auto-save-default require-final-newline write-file db-file database 30 kill-buffer] 3) ((error (byte-code "P p!$!p!ʇ" [t db-io-error-p db-message "Warning: " "Error `%s' while writing buffer %s to file %s." error buffer-name db-file db-debug-p set-buffer-modified-p nil kill-buffer] 5))) db-copy-buffer-local-variables write-database-mode major-mode buffer-read-only database-io-setup t 17 record-sepinfo first-record 1 21 write-region-fn record-sep-string db-message "Writing database..." #[(record) "  \nc !" [first-record nil record-sep-string write-region-fn record] 2] "Writing database...%d" "Writing database to disk..." write-database-file-internal-delimited 8 5 (byte-code " ! Ip!*" [nil auto-save-default require-final-newline write-file db-file database 30 kill-buffer] 3) ((error (byte-code "P p!$!\n!p!̇" [t db-io-error-p db-message "Warning: " "Error `%s' while writing buffer %s to file %s." error buffer-name db-file auto-save-mode 0 db-debug-p set-buffer-modified-p nil kill-buffer] 5))) ((byte-code " ! ! q" [bufferp this-buffer buffer-name] 2)) get-buffer-window target-window selected-window window-point track-window-point-p ((byte-code "\nI II" [database 2 fl 7 ddbs 30 modified-p] 3)) (byte-code " ! Ip!*" [nil auto-save-default require-final-newline write-file db-file database 30 kill-buffer] 3) ((error (byte-code "P p!$!p!ʇ" [t db-io-error-p db-message "Warning: " "Error `%s' while writing buffer %s to file %s." error buffer-name db-file db-debug-p set-buffer-modified-p nil kill-buffer] 5))) #[(record) "  \nc !" [first-record nil record-sep-string write-region-fn record] 2] (byte-code " ! Ip!*" [nil auto-save-default require-final-newline write-file db-file database 30 kill-buffer] 3) ((error (byte-code "P p!$!\n!p!̇" [t db-io-error-p db-message "Warning: " "Error `%s' while writing buffer %s to file %s." error buffer-name db-file auto-save-mode 0 db-debug-p set-buffer-modified-p nil kill-buffer] 5))) set-window-point database-buffer-p dbc-update-database-modified-p force-mode-line-update] 6] write-database-file-internal-delimited #[(database) "` H H ! ! H\"  H, !=!!I!! $!d} H H$@vA@@P\" \"IA@P\" \"I`| !+   %eb HH%%c)db HH'暃Â'`'GZ#) HH'暃Â'`'GZ#)`d|+ HH HH#~.\n" [previous-point 0 fno t first-record database 10 no-of-fields 21 write-record-function database-full-fieldsep-string fieldsep-string database-full-recordsep-string recordsep-string 22 sub-fieldsep 23 sub-recordsep nil confirmation-list database-acceptable-delimiter-p database-generate-delimiter db-message "Writing database..." maprecords #[(record) "\nW' V c \"H H\"c T c" [0 fno no-of-fields sub-fieldsep db-funcall-maybe database-recordfieldspec database 9 record sub-recordsep] 5] "Writing database...%d" "Writing database...confirming" 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." write-database-file-internal-delimited database-substitute-for-write 18 1 pre-first "" s search-backward 17 4 error "Didn't find expected trailing junk `%s' or `%s'."] 7] database-io-setup #[(database &optional dont-set-regexps) " \n\" ! H\"\" ʇ" [database-check-all-sepinfos database dont-set-regexps db-set-field-quotation-vars apply concat mapcar #[(string-cons) "@AP" [string-cons] 2] 29 db-substitution-no-no-string nil] 6] db-set-field-variables #[(database) "H?H\")BI" [database 14 -1 fno mapcar #[(fieldname) "TC" [fno] 2] 12 nil] 6] database-check-all-sepinfos #[(database &optional dont-set-regexps) " H % H % H %" [database-check-sepinfo database 17 "record" "\n" dont-set-regexps 18 "field" " " 19 "alternative" t] 6] database-check-sepinfo #[(sepinfo database sepinfo-name &optional sep-string-default dont-set-regexps) "HHšIH+HH#H H\n   M š\\ I I Hw   \"I I  !I I+HHšH=\"IHH*H#*H* *H\n    š I I) H   \"I I)  !I I+H=Hš=IHSH?H#H ?H\n   v š I I H   \"I I  !I I+" [sepinfo 1 "" nil 2 3 error "Need a submatch to go with pre-first-regexp `%s' of %s." sepinfo-name dont-set-regexps database si db str 24 when-not-preceded-by-quotation-char regexp-quote 0 4 5 sep-string-default t "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."] 6] when-not-preceded-by-quotation-char #[(string database) " H H\"! !ʰ " ["[^" database 24 "]" "\\(" regexp-quote make-string 2 "\\)*" string "\\)"] 9] sepinfo-set-regexp-and-submatch-from-string (macro . #[(regexp-setter submatch-setter sepinfo string database) "\nD DDE E EE E EE E EEFE" [let str string db database si sepinfo cond (or (null str) (equal "" str)) regexp-setter nil submatch-setter (database-quotation-char db) (when-not-preceded-by-quotation-char str db) 2 t (regexp-quote str) 0] 10]) db-set-fieldname-vars #[(database &optional fieldnames-list) " HG \" \"\n \"I I \nI  I-" [fieldnames-list database 11 no-of-fields -1 fno nil type make-vector recordfieldspecs fieldnames-vector 12 mapcar #[(fname) "T : A @\n !  I% \" I B" [fno fname db-default-field-type type recordfieldtype-p recordfieldspecs error "db-set-fieldname-vars: bad type %s" fieldnames-vector] 3] 10 13] 5]] 4) (defalias 'recordfieldtype->recordfieldspec #[(recordfieldtype) " \n\"A !  9 !)" [assoc recordfieldtype db-recordfieldtypes result recordfieldspec-p recordfieldtype->recordfieldspec] 3 "\ Return the recordfieldspec associated with symbol RECORDFIELDTYPE."]) (byte-code "\"\"\"\"\"\"\"\"!1\"\"\"\"\"\"\"\"" [defalias recordfieldtype-p #[(recordfieldtype) " \n\"" [assoc recordfieldtype db-recordfieldtypes] 3] database-substitute-for-read #[(database) " ! ! H\n H  HH* HHR HH; H; I HHN HN\nI Z! !h I! !Ieb H\" H \n#!\n! H\n\"\n! H# \nI\n!! !I H\n#eb\n H\"! H\" \"," [database-full-fieldsep-string database fieldsep-orig database-full-recordsep-string recordsep-orig 22 fieldsep-sub 23 recordsep-sub 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 t] 5] database-perform-substitutions #[(database backward) "H!!H #\")!" [database 29 db-message "Substituting..." buffer-substitute backward t ambiguities error "Ambiguities: %s" "Substituting...done"] 5] database-substitute-for-write #[(database new-fieldsep sub-fieldsep new-recordsep sub-recordsep) " \" eb \"?%eb\"" [database-perform-substitutions database nil sub-fieldsep new-fieldsep replace-string sub-recordsep new-recordsep] 3] conflist-fieldsep-bad-p (macro . #[(conflist) " D" [car conflist] 2]) conflist-recordsep-bad-p (macro . #[(conflist) "\nDD" [car cdr conflist] 3]) conflist-no-of-records (macro . #[(conflist) "\nDDD" [car cdr conflist] 4]) database-confirm-fieldsep-and-recordsep #[(fieldsep recordsep no-of-fields no-of-records) "eb !eb !  S_  v > \\U7ɉ EʉE UQɉ E TUldb cɉ TEʉ E \" \"  V_\\ V _\\\nU? U? E\\\nSUЂ \n_T_\nS_U? W WE)*," [db-how-many-string-overlapping fieldsep fieldsep-matches recordsep recordsep-matches no-of-records no-of-fields goal-fieldsep-matches goal-recordsep-matches nil t 0 db-how-many-substring-overlapping r-in-f f-in-r apparent-records 1] 5] boundp db-substitution-no-no-string nil database-acceptable-delimiter-p #[(delimiter) "-G + W+ \"%ȉ T +" [delimiter t 0 delimiter-length string-index result db-find-char db-substitution-no-no-string nil] 4] database-generate-delimiter #[(database &optional check-buffer) "\" Wa a I!Z 2eb#Z  H? !\"Z  HP !\"Z\n T h!+" [make-string 1 0 nil result candidate-char string 256 database-acceptable-delimiter-p check-buffer search-forward t db-find-char database 22 database-full-fieldsep-string 23 database-full-recordsep-string error "I can't find an acceptable delimiter!"] 5] database-set-temp-delimiters (lambda (database db-buffer)) db-set-field-quotation-vars #[(database) "H;/\nGU) U$\nƜ)\n\"\nI)\nWH!!IHVHR!\"#I)" [database 24 quotation-char quot-char-len 0 nil 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 "\\|"] 8] field-quote #[(fieldvalue database) "H'H \"' ʼnOH ŔŕO ŕO\"R " [database 24 string-match 26 fieldvalue 0 field-quote nil] 7] field-unquote #[(fieldvalue database) "HIH \"F TH T#U5 O TǕO ǕO\"QG TO TO\"PG ) " [database 24 string-match 25 fieldvalue i 28 0 field-unquote nil] 7] quoted-strings-default #[(database) "H=HHHHHHHHHHHHHHHHHHH!\n\"" [database 24 delq nil 17 1 4 8 18 19 char-to-string] 14] record-sep-lines-function #[(n) " DF" [lambda (post-last-item-pos) next-line n (let ((here (point))) (cons (1- here) (if (< here post-last-item-pos) here)))] 4]] 3)