(require (quote database)) (require (quote db-util)) (provide (quote db-tagged)) (defvar database) (defvar db-tagged-tag-chars "-_A-Za-z" "\ The characters that are allowed in field tags, in a form suitable for placing inside [] in a regular expression.") (defvar db-tagged-pre-tag "" "\ The string that precedes each tag. Used only if db-tagged-pre-tag-regexp or db-tagged-pre-tag-output nil (depending on whether the record is being read or written).") (defvar db-tagged-pre-tag-regexp nil "\ A regexp for what precedes each tag on its line when parsing. It must NOT contain any grouping constructs.") (defvar db-tagged-pre-tag-output nil "\ The fixed string to place before each tag on output.") (defvar db-tagged-separator ":" "\ The string that separates field names from values. Used only if db-tagged-separator-regexp or db-tagged-separator-output is nil (depending on whether the record is being read or written).") (defvar db-tagged-separator-regexp nil "\ A regexp for the separator between field names and values when parsing.") (defvar db-tagged-separator-output nil "\ The separator between field names and values on output.") (defvar db-tagged-continuation " " "\ The string that marks (the beginning of) a continuation line. Used only if db-tagged-continuation-regexp or db-tagged-continuation-output is nil (depending on whether the record is being read or written).") (defvar db-tagged-continuation-regexp "[ ]+" "\ A regexp for a continuation line in a value when parsing.") (defvar db-tagged-continuation-output nil "\ The fixed string to use (before) continuing values on output.") (defvar db-tagged-rrfr-hooks nil "\ Hooks run on each database record before tagged parse.") (defvar db-tagged-wrfr-before-hooks nil "\ Hooks run before each tagged write of a database record. The record is bound to the dynamic variable record, and point is where the record will be inserted in the buffer.") (defvar db-tagged-wrfr-after-hooks nil "\ Hooks run after each tagged write of a database record. The record is bound to the dynamic variable record, and point is immediately after the file representation of the record.") (defvar db-tagged-converted-p nil "\ Non-nil if `database-stored->actual' has already been run.") (defvar db-tagged-default-field nil "\ A fieldname (symbol) for the field indicated by an illegal or empty tag. (For instance, you might set it to 'comments.) Nil if those values should be discarded.") (defun tagged-field-spec-name (tfs) (byte-code "@‡" [tfs] 1)) (defun tagged-field-spec-tag (tfs) (byte-code "A@‡" [tfs] 1)) (defun tagged-field-spec-help (tfs) (byte-code "AA@‡" [tfs] 1)) (proclaim-inline tagged-field-spec-name tagged-field-spec-tag tagged-field-spec-help) (defun db-tagged-setup (tagged-field-specs) "\ Ready the database to read files in tagged format. Creates database local variables and sets database slots. Argument TAGGED-FIELD-SPECS is a list of tagged-field specifications, one for each field in a database record. Each tagged-field specification is a three-element list of the field name (a symbol), the tag used to identify it in the file (a string), and a brief help string. Instead of a symbol, the tagged-field name may be a cons of the field name and its type. To indicate that a field is never found in the input file (typically because it is computed on the fly), use nil for its tag. This function should be called first in an auxiliary or format file, so that the defaults it chooses can be overridden. `database-set-fieldnames-to-list' should not be called if this function is." (byte-code "Ã!ƒÄÅÁ#?…ÆÅÁ#‚Ç !‡" [database t tagged-field-specs db-tagged-p database-get-local db-tagged-converted-p database-set-local db-tagged-setup-internal] 6)) (defun db-tagged-setup-internal (tagged-field-specs) "\ Do the real work of `db-tagged-setup'. This function should only be called once per database." (byte-code "ÃÄ #ˆÅÆÇ\"ˆÈ‰ˆÉÅÊK \"\"ˆÅË \"ˆÌÍIˆÎÏIˆÐHÑÒIˆÐHÓÔIˆÕÖ×\"ˆÕØÙ\"‡" [database tagged-field-specs db-default-field-type database-make-local db-tagged-field-spec mapcar (lambda (fld) (byte-code " J#‡" [fld database database-make-local] 4)) (db-tagged-rrfr-hooks db-tagged-wrfr-before-hooks db-tagged-wrfr-after-hooks db-tagged-tag-chars db-tagged-pre-tag db-tagged-pre-tag-regexp db-tagged-pre-tag-output db-tagged-separator db-tagged-separator-regexp db-tagged-separator-output db-tagged-continuation db-tagged-continuation-regexp db-tagged-continuation-output db-tagged-converted-p) nil-or-string database-set-fieldnames-to-list tagged-field-spec-name (lambda (fspec) (byte-code "Ç !È !ÉÉÉ:…@‰ˆÊ\"ËÌ \"! ÍH‰ˆ Í ƒ9 Î Q‚: IˆÏ #-‡" [fn fspec help fnum rs ohelp database tagged-field-spec-name tagged-field-spec-help nil fieldname->fieldnumber copy-sequence database-recordfieldspec 8 " " database-set-recordfieldspec] 10)) 20 db-tagged-rrfr 21 db-tagged-wrfr 17 4 " " 8 " " db-add-to-hook db-before-read-hooks db-tagged-before-read db-after-read-hooks db-tagged-database-stored->actual] 10)) (defun db-tagged-p (database) "\ Non-nil if DATABASE is in tagged file layout." (byte-code "ÂÃÁ#‡" [database t database-get-local db-tagged-field-spec] 4)) (proclaim-inline db-tagged-p) (defun db-tagged-database-stored->actual (&optional db) "\ Like `database-stored->actual', but only in tagged file layout." (byte-code "Æ !…ÄÅ Â#?…Æ!ˆÇÅ Â#‡" [db database t db-tagged-p database-get-local db-tagged-converted-p database-stored->actual database-set-local] 7)) (defun db-tagged-before-read nil (byte-code "Á!…vÂÃ\"?…ÄÃÅÂÆ\"!#ˆÂÇ\"?…)ÄÇÂÆ\"#ˆÂÈ\"?…?ÄÈÉÅÂÊ\"!ÉQ#ˆÂË\"?…RÄËÂÊ\"ÌP#ˆÂÍ\"?…eÄÍÅÂÎ\"!#ˆÂÏ\"?…vÄÏÂÎ\"#‡" [database db-tagged-p database-get-local db-tagged-pre-tag-regexp database-set-local regexp-quote db-tagged-pre-tag db-tagged-pre-tag-output db-tagged-separator-regexp "[ ]*" db-tagged-separator db-tagged-separator-output " " db-tagged-continuation-regexp db-tagged-continuation db-tagged-continuation-output] 26)) (defun db-tagged-rrfr nil (byte-code "Ë !ÌÍ \"ÎÏÌÐ \"ÑÌÒ \"ÓÌÔ \"&ÕÕÕÌÖ \"×Ç!)ˆebˆm?…·Ø !ƒ¯ÙÚ!Û !‰ˆÜ ˆÝÞß!`\"àÚ!ˆØ !…sÜ ˆáÝÞß!`\"Q‰ˆàÚ!ˆ‚Uˆ ?…‚âã \"ˆ ‰ˆä #‰ˆ …«?ƒ å  $‚«å áQ $)‚³æç`\"ˆ‚1ˆ.‡" [result-record database cnt-re tag-re fld-nam fld prev-value hooks fld-val db-tagged-default-field t make-record database-get-local db-tagged-continuation-regexp concat "^" db-tagged-pre-tag-regexp "\\([" db-tagged-tag-chars "]*\\)" db-tagged-separator-regexp nil db-tagged-rrfr-hooks run-hooks looking-at db-match-string 1 lookup-field end-of-line buffer-substring match-end 0 forward-line " " db-message "Invalid field name %s." record-field record-set-field error "At char %d, didn't find either a tag or the end of the record."] 30)) (defun db-tagged-wrfr (record) (byte-code "ÄÅ \"ÆÀ!)ˆÄÇ \"ÄÈ \"ÉÊÄË \"\"*ˆÌÍ!ˆÄÎ \"ÆÀ!)‡" [hooks database sep contin database-get-local db-tagged-wrfr-before-hooks run-hooks db-tagged-separator-output db-tagged-continuation-output mapcar (lambda (fld-def) (byte-code "Í !Î !:…@‰ˆ ??…‰Ï \"Ð \"ÑHÒ  H\"?†8ÓÔ\"?…ˆÕÖÓÔ \"ƒJ ‚L   ×  \"ˆØÙ#‰ …}× OÙ #ˆ Ú\\‰ˆ‚Xˆ×ÖOÙ\"++*‡" [fld-nam fld-def fld-tag fld-nbr database a->s fld-val record i j cnt sep contin tagged-field-spec-name tagged-field-spec-tag fieldname->fieldnumber database-recordfieldspec 9 db-funcall-maybe equal "" 0 nil insert string-match " " 1] 14)) db-tagged-field-spec delete-char -1 db-tagged-wrfr-after-hooks] 10)) (defun lookup-field (key) (byte-code "ÅÆ \"Ã…#Ç @A@\"…@@‰ˆA‰ˆ‚ˆ :ƒ. @‚/ *‡" [l database r nil key database-get-local db-tagged-field-spec equal] 5))