home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / db-rdb.el < prev    next >
Encoding:
Text File  |  1993-06-13  |  20.2 KB  |  562 lines
  1. ;;; db-rdb.el --- part of EDB, the Emacs database
  2.  
  3. ;; See database.el for copyright notice, distribution conditions, etc.
  4.  
  5. ;; Author: Alan K. Stebbens <aks@hub.ucsb.edu>
  6. ;; Keywords: EDB
  7. ;; Adapted-By: Michael Ernst <mernst@theory.lcs.mit.edu>
  8.  
  9. ;;; Commentary:
  10.  
  11. ;; Provide support for RDB files, which can be a special case of a tagged
  12. ;; file, or, a tabular-format file.
  13. ;; 
  14. ;; The RDB header for both kinds of files contains the field names and
  15. ;; the field descriptors, which are its length, type, and a "help" string.
  16. ;;
  17. ;; There are Perl scripts (by Walter Hobbs) implementing RDB files, and this
  18. ;; file is an attempt to provide EDB access to these kinds of files.
  19.  
  20. ;; This file began as a copy of db-tagged.el, but has since been almost
  21. ;; completely rewritten.
  22.  
  23. ;; The basic way to use this is to call "db-rdb-setup" with a list
  24. ;; describing the fields.  The purpose of the fields is to provide the
  25. ;; Elisp programmer a handle on the external fields.  The usage is
  26. ;; documented in the function.
  27.  
  28. ;;; Code:
  29.  
  30. (require 'database)
  31. (require 'db-util)            ; for db-add-to-hook
  32. (provide 'db-rdb)
  33.  
  34.  
  35. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  36. ;;; Variables
  37. ;;;
  38.  
  39. ;;; Variables used dynamically; avoid compiler messages about free variables.
  40. (defvar database)
  41.  
  42. ;;; These are the variables used for customization, these are actually
  43. ;;; database-local variables and not real variables.  The defvars are
  44. ;;; mainly to get documentation somewhere...the values are used as
  45. ;;; defaults when initializing the database.
  46.  
  47. (defvar db-rdb-field-name-charset "a-zA-Z0-9_"
  48.   "The characters allowed in an RDB field name \(using regexp format
  49. sans \"[]\"\).")
  50.  
  51. (defvar db-rdb-list-separator-string " | "
  52.   "The string that separates field names from values.")
  53.  
  54. (defvar db-rdb-list-entry-regexp 
  55.   (concat "[ \t]*\\(["
  56.       db-rdb-field-name-charset
  57.       "]*\\)"
  58.       (regexp-quote db-rdb-list-separator-string)
  59.       "[ \t]*")
  60.   "A regexp which matches the beginning of a List-format field
  61. entry, grouping the field name as \\1.")
  62.  
  63. (defvar db-rdb-list-continuation-regexp "^[ \t]*|[ \t]+"
  64.   "A regexp which matches the beginning of a List-format entry 
  65. continuation.")
  66.  
  67. (defvar db-rdb-list-continuation-output nil
  68.   "A computed string used to identify and align continuation data.")
  69.  
  70. (defvar db-rdb-rrfr-hooks ()
  71.   "Hooks run on each database record before RDB parse.")
  72.  
  73. (defvar db-rdb-wrfr-before-hooks ()
  74.   "Hooks run before each RDB write of a database record.
  75. The record is bound to the dynamic variable  record, and point is where the
  76. record will be inserted in the buffer.")
  77.  
  78. (defvar db-rdb-wrfr-after-hooks ()
  79.   "Hooks run after each RDB write of a database record.
  80. The record is bound to the dynamic variable  record, and point is immediately
  81. after the file representation of the record.")
  82.  
  83. (defvar db-rdb-converted-p ()
  84.   "Non-nil if `database-stored->actual' has already been run.")
  85.  
  86. (defvar db-rdb-file-type nil
  87.   "Set to 'list or 'table by rdb-read-fields according to the type
  88. of the file.  This is a database-local variable.")
  89.  
  90. (defvar db-rdb-header-fields nil
  91.   "Set to the list of header fields parsed by db-rdb-read-list-field-defs
  92. or db-rdb-read-table-field-defs.")
  93.  
  94. (defvar db-rdb-field-defs nil
  95.   "Set to the field definitions computed from the programmer-supplied field
  96. definitions and the RDB header field definitions.")
  97.  
  98. (defvar db-rdb-header-string nil
  99.   "Set to the header string, for either List or Table RDB files.
  100. This is used to rewrite the header when the database is updated.")
  101.  
  102. ;;; There are also a few settings in EDB that you might wish to play with:
  103. ; sepinfo-set-sep-string        Default "\n\n"
  104. ; sepinfo-set-post-last-string        Default "\n"
  105. ;; It might be that I should have defvars for these defaults...
  106.  
  107. ;; some defvars to keep byte-compile happy..
  108.  
  109. (defvar db-buffer)            ;the buffer of the current database
  110.  
  111.  
  112. ;;; Functions
  113.  
  114. ;;; Abstraction of the RDB field specification:  (HANDLE TAG HELP)
  115. ;;; HANDLE --> (NAME . TAG) or NAME
  116.  
  117. (defun rdb-field-spec-handle (fspec) (car fspec))
  118. (defun rdb-field-spec-name (fspec) (if (consp (car fspec)) 
  119.                        (car (car fspec))
  120.                      (car fspec)))
  121. (defun rdb-field-spec-type (fspec) (if (consp (car fspec)) 
  122.                        (cdr (car fspec))))
  123. (defun rdb-field-spec-tag (fspec) (car (cdr fspec)))
  124. (defun rdb-field-spec-help (fspec) (car (cdr (cdr fspec))))
  125.  
  126. (proclaim-inline rdb-field-spec-handle rdb-field-spec-name rdb-field-spec-type
  127.          rdb-field-spec-tag rdb-field-spec-help)
  128.  
  129. ;; db-rdb-p
  130.  
  131. (defun db-rdb-p (database)
  132.   "Non-nil if DATABASE is in RDB file layout."
  133.   (database-get-local 'db-rdb-field-defs database t))
  134. (proclaim-inline db-rdb-p)
  135.  
  136. ;; db-rdb-setup
  137.  
  138. ;;;###autoload
  139. (defun db-rdb-setup (rdb-field-specs &optional lock-flag)
  140.  
  141.   "Ready the database to read files in RDB format.
  142. Creates database local variables and sets database slots.  Argument
  143. RDB-FIELD-SPECS is a list of rdb-field specifications, one for each
  144. field in a database record.  Optional, second argument LOCK-FLAG should
  145. be non-nil to lock the file for synchronized updates.  The locking and
  146. unlocking is done with \"rdblock\" and \"rdbunlock\", which must be
  147. available in the current PATH environment variable.
  148.  
  149. Each field specification is a three-element list of the field name \(a
  150. symbol\), the tag used to identify it in the file \(a string\), and a
  151. brief help string.  Instead of a symbol, the rdb-field name may be a
  152. two-element list of the field name its type.  To indicate that a field
  153. is never found in the input file \(typically because it is computed on
  154. the fly\), use nil for its tag."
  155.  
  156.   ;; Try to detect whether this database was once in RDB file layout, but is
  157.   ;; now in internal file layout.
  158.   (if (db-rdb-p database)
  159.       (if (not (database-get-local 'db-rdb-converted-p database t))
  160.       (database-set-local 'db-rdb-converted-p database t))
  161.     (db-rdb-setup-internal rdb-field-specs)))
  162.  
  163. ;; db-rdb-setup-internal
  164.  
  165. (defun db-rdb-setup-internal (field-specs)
  166.  
  167.   "Internal function to do the real work of `db-rdb-setup', without
  168. certain safety checks.  This function should only be called once per 
  169. database.  Argument is the FIELD-SPECS \(see db-rdb-setup\)."
  170.  
  171.   (let* ((db database)
  172.      (rsi (database-record-sepinfo db))
  173.      (efields (db-rdb-read-fields db))
  174.      (fspecs (db-rdb-correlate-field-defs field-specs efields))
  175.      (max-len 0))
  176.     (database-set-local 'db-rdb-field-defs db fspecs t)
  177.     (cond
  178.      ;; table format
  179.      ((eq db-rdb-file-type 'table)
  180.       ;; table style is the same a regular file layout
  181.       (error "db-rdb-setup: table format not implemented yet!"))
  182.      
  183.      ;; list format
  184.      ((eq db-rdb-file-type 'list)
  185.       ;; discover the maximum of the length of all the field tags
  186.       (mapcar (function (lambda (fld)
  187.               (let ((tag (rdb-field-spec-tag fld)))
  188.                 (if (> (length tag) max-len)
  189.                 (setq max-len (length tag))))))
  190.           fspecs)
  191.  
  192.       (database-set-local 'db-rdb-max-field-name-length db max-len t)
  193.       (database-set-local 'db-rdb-continuation-output db 
  194.               (concat (make-string max-len ? ) 
  195.                   db-rdb-list-separator-string)
  196.               t)
  197.       (database-set-read-record-from-region db 'db-rdb-list-rrfr)
  198.       (database-set-write-region-from-record db 'db-rdb-list-wrfr)
  199.       ;; set pre-first-regexp to remove the header, up to the
  200.       ;; first pair of newlines
  201.       (sepinfo-set-pre-first-regexp rsi "\\`\\(\\([^\n]\\|\n[^\n]\\)*\n\n\\)")
  202.       (sepinfo-set-pre-first-regexp-submatch rsi 1)
  203.       (sepinfo-set-sep-string rsi "\n\n")
  204.       (sepinfo-set-post-last-string rsi "\n")
  205.       ;; save the header as the pre-first-string so it will get written
  206.       ;; back on output 
  207.       ;; at some point, maybe we should allow for dynamic changes to the field
  208.       ;; definitions.
  209.       (sepinfo-set-pre-first-string 
  210.        rsi (database-get-local 'db-rdb-header-string db))))
  211.  
  212.     ;; externalize (as database local) some variables
  213.     (mapcar (function (lambda (fld)
  214.             (database-make-local fld db (symbol-value fld))))
  215.         '(db-rdb-rrfr-hooks
  216.           db-rdb-wrfr-before-hooks
  217.           db-rdb-wrfr-after-hooks
  218.           db-rdb-converted-p))
  219.  
  220.     ;; Most fields are strings (or missing, here represented as nil)
  221.     ;; Need to declare this before defining fields
  222.     (setq db-default-field-type 'nil-or-string) ; this var is buffer-local
  223.  
  224.     ;; tell EDB about the fields now
  225.     (database-set-fieldnames-to-list db (mapcar 
  226.                      (function rdb-field-spec-handle) 
  227.                      fspecs))
  228.  
  229.     ;; Insert the help strings into *copies* of the recordfieldspecs 
  230.     ;; in order to not redefine the prototype fieldtypes.
  231.     (mapcar (function (lambda (fspec)
  232.             (let* ((fn (rdb-field-spec-name fspec))
  233.                    (help (rdb-field-spec-help fspec))
  234.                    (fnum (fieldname->fieldnumber fn db))
  235.                    (rs (copy-recordfieldspec
  236.                     (database-recordfieldspec db fnum)))
  237.                    (ohelp (recordfieldspec-help-info rs)))
  238.               (recordfieldspec-set-help-info 
  239.                rs (if ohelp (concat help "\n" ohelp) help))
  240.               (database-set-recordfieldspec db fnum rs))))
  241.         fspecs)
  242.     (db-add-to-hook 'db-after-read-hooks 'db-rdb-database-stored->actual)))
  243.  
  244. ;; db-rdb-database-stored->actual 
  245.  
  246. (defun db-rdb-database-stored->actual (&optional db)
  247.   "Like `database-stored->actual', but only in RDB file layout."
  248.   (if (and (db-rdb-p (or db database))
  249.        (not (database-get-local 'db-rdb-converted-p database t)))
  250.       (progn
  251.     (database-stored->actual db)
  252.     (database-set-local 'db-rdb-converted-p database t))))
  253.  
  254. ;; db-rdb-list-rrfr -- Read RDB List format region record
  255.  
  256. (defun db-rdb-list-rrfr ()
  257.  
  258.   "With the current buffer narrowed to a single RDB List record, parse
  259. it into field values."
  260.  
  261.   (let* ((db database)
  262.      (new-rec (make-record db))
  263.      (start-re "^[ \t]*\\([a-zA-Z0-9_]*\\)[ \t]*|[ \t]*")
  264.      (cont-re "^[ \t]*|[ \t]*")
  265.      fld-tag fld old-val fld-val)
  266.     ;; run-hooks takes a SYMBOL as its argument
  267.     (let ((hooks (database-get-local 'db-rdb-rrfr-hooks db)))
  268.       (run-hooks 'hooks))
  269.     (goto-char (point-min))
  270.     (while (not (eobp))
  271.       (if (looking-at start-re)
  272.       (progn
  273.         (setq fld-tag (match-string 1)
  274.           fld (db-rdb-lookup-field fld-tag)
  275.           old-val (record-field new-rec fld db))
  276.         (end-of-line)
  277.         (setq fld-val (buffer-substring (match-end 0) (point)))
  278.         ;; Why isn't this (forward-char 1)?
  279.         (forward-line 1)
  280.         (while (looking-at cont-re)
  281.           (end-of-line)
  282.           (setq fld-val (concat fld-val "\n" 
  283.                     (buffer-substring (match-end 0) (point))))
  284.           (forward-line 1))
  285.         (record-set-field new-rec fld
  286.                   (if old-val (concat old-val "\n" fld-val)
  287.                 fld-val)
  288.                   db))
  289.     ;; else looking-at failed
  290.     (error "This didn't look right to me (point = %s)" 
  291.            (int-to-string (point)))))
  292.     new-rec))
  293.  
  294. ;; RDB write RDB List file record from database record
  295.  
  296. (defun db-rdb-list-wrfr (record)
  297.  
  298.   "Given an EDB RECORD, write convert to the RDB List format
  299. representation and write to the file."
  300.  
  301.   ;; run-hooks takes a SYMBOL as its argument
  302.   (let* ((db database)
  303.      (max-len (database-get-local 'db-rdb-max-field-name-length db))
  304.      (contin (database-get-local 'db-rdb-continuation-output db)))
  305.     ;; run any before-hooks
  306.     (let ((before-hooks (database-get-local 'db-rdb-wrfr-before-hooks db)))
  307.       (run-hooks 'before-hooks))
  308.     (mapcar 
  309.      '(lambda (fld-def)
  310.     (let ((fld-nam (rdb-field-spec-name fld-def))
  311.           (fld-tag (rdb-field-spec-tag fld-def)))
  312.       (if (not (null fld-tag))
  313.           ;;Fields without tags are computed, so don't get stored
  314.           (let* ((fld-nbr (fieldname->fieldnumber fld-nam db))
  315.              (a->s (recordfieldspec-actual->stored
  316.                 (database-recordfieldspec db fld-nbr)))
  317.              (fld-val (funcall-maybe a->s (aref record fld-nbr))))
  318.         ;; null or empty values don't get written
  319.         (if (not (or (null fld-val)
  320.                  (equal "" fld-val)))
  321.             (let ((fld-pad (- max-len (length fld-tag)))
  322.               (i 0) j)
  323.               ;; right-align the RDB field names
  324.               (if (> fld-pad 0)
  325.               (insert (make-string fld-pad ? )))
  326.               (insert fld-tag " | ")
  327.               (while (setq j (string-match "\n" fld-val i))
  328.             (insert (substring fld-val i j) "\n" contin)
  329.             (setq i (+ j 1)))
  330.               (insert (substring fld-val i) "\n")
  331.               ))))))
  332.      (database-get-local 'db-rdb-field-defs db))
  333.     ;;HACK: punt last newline, it'll be added back later
  334.     (delete-char -1)
  335.     ;; run any after-hooks
  336.     (let ((after-hooks (database-get-local 'db-rdb-wrfr-after-hooks db)))
  337.       (run-hooks 'after-hooks))))
  338.  
  339. ;; db-rdb-lookup-key
  340.  
  341. (defun db-rdb-lookup-field (tag)
  342.   "Lookup FIELD-TAG in the RDB database field list, returning its
  343. associated NAME \(a symbol\)."
  344.   (let ((field-list (database-get-local 'db-rdb-field-defs database))
  345.     (sym nil))
  346.     (while field-list
  347.       (if (equal tag (car (cdr (car field-list))))
  348.       (setq sym (car (car field-list))))
  349.       (setq field-list (cdr field-list)))
  350.     (if sym                ;found it?
  351.     (if (consp sym)            ;is it a node?
  352.         (setq sym (car sym)))    ;return just the symbol
  353.       ;; Field not defined -- report it, then add it
  354.       (message "Field name % encountered, but not defined." tag)
  355.       (setq field-list (database-get-local 'db-rdb-field-defs database))
  356.       (nconc field-list (list (list (cons (setq sym (intern tag)) 
  357.                       'string-or-nil)
  358.                     tag "Undefined field"))))
  359.     sym))
  360.  
  361. ;; db-rdb-read-fields
  362.     
  363. (defun db-rdb-read-fields (db)
  364.   "In DATABASE, read the RDB-style headers, creating a list of field
  365. definitions, which is returned as the result."
  366.   "Setup the field names from the current EDB database file, which is
  367. assumed to be formatted as an RDB database.  The RDB database may be
  368. either in List format or Table form.  Any updates will continue to
  369. maintain the RDB file in its current form.  Any EDB format files for the
  370. database will be used automatically.
  371.  
  372. The argument, FIELDDEFS, is a list of elements: \(\(SYMBOL FIELD-NAME
  373. FIELD-HELP\)...\).  SYMBOL may itself be either an atom, a symbol, or a
  374. cons cell of \(SYMBOL . TYPE\).  SYMBOL is used to identify the field by
  375. name in elisp code.  TYPE, if given, must be a valid EDB fieldtype,
  376. either preconfigured, or user-defined.  If TYPE is null or omitted, it
  377. will be deduced from the corresponding RDB header, utimately defaulting
  378. to \"string\".
  379.  
  380. The FIELD-NAME is a string which must match one of the corresponding
  381. field names in the database.  FIELD-NAMES which do not exist in the RDB
  382. file are shown in an error message, as are any unmentioned field names
  383. read from the RDB header.
  384.  
  385. The FIELD-HELP is a string used for information when queried with \"?\"
  386. interactively.  If FIELD-HELP is null, any comment in the field
  387. definition from the RDB file is used instead.
  388.  
  389. Lastly, if FIELDDEFS is null, then all of the information will be
  390. obtained entirely from the RDB file, with the SYMBOL defaulting to the
  391. symbol with the same print-string as FIELD-NAME."
  392.   (save-excursion
  393.     (set-buffer db-buffer)
  394.     (goto-char (point-min))
  395.     (while (looking-at "^#")
  396.       (forward-line 1))
  397.     ;; if the first non-comment line is empty, we're in List mode
  398.     (if (looking-at "^[ \t]*\n")
  399.     (db-rdb-read-list-field-defs)
  400.       (db-rdb-read-table-field-defs))))
  401.  
  402. ;; rdb-read-list-field-defs
  403.  
  404. (defun db-rdb-read-list-field-defs ()
  405.  
  406.   "Positioned at the blank line preceeding the field definitions in an
  407. RDB List file, read the field definitions and return them as an
  408. association list: \(\(FIELD-NAME FIELD-DEF FIELD-HELP\)...\)."
  409.  
  410.   (let (fields name defn width help end)
  411.     (forward-line 1)            ;go to the first real line
  412.     (while (not (looking-at "^[ \t]*$"))
  413.       (cond ((looking-at "^\#"))    ;ignore comments
  414.         ((looking-at "^[ \t]*\\(\\w+\\)[ \t]+|[ \t]+\\(.*\\)$")
  415.          (setq name (match-string 1))    ;FIELD-NAME
  416.          (setq defn (string-split-first-word (match-string 2)))
  417.          (setq help (car-safe (cdr-safe defn))) ; FIELD-HELP
  418.          (setq defn (car defn))        ;FIELD-DEF
  419.          (setq width (and (string-match "\\([0-9]+\\)" defn)
  420.                   (string-to-int (match-string 1 defn))))
  421.          (setq defn (and (string-match "\\([SNDM<>]\\)" defn)
  422.                  (match-string 1 defn)))
  423.          (setq fields (append fields (list (list name width defn help))))
  424.          ))
  425.       (forward-line 1))
  426.     ;; we're just past the header -- copy the entire thing and save it in
  427.     ;; a local variable, so our caller can stuff into a record sepinfo.
  428.     (forward-line 1)            ;skip the header/record separator
  429.     (database-set-local 'db-rdb-header-string database 
  430.             (buffer-substring (point-min) (point)) 
  431.             t)
  432.     (database-set-local 'db-rdb-file-type database db-rdb-file-type t)
  433.     (database-set-local 'db-rdb-header-fields database fields t)
  434.     ;; leave some clues as to the kind of RDB file we've parsed
  435.     (setq db-rdb-file-type 'list)
  436.     ;; return with the fields
  437.     fields))
  438.  
  439. ;; db-rdb-correlate-field-defs
  440.  
  441. (defun db-rdb-correlate-field-defs (ifields efields)
  442.  
  443.   "Given INTERNAL-FIELDS and EXTERNAL-FIELDS, correlate the fields with
  444. each other and produce a field list suitable for M-x db-rdb-setup.
  445.  
  446. INTERNAL-FIELDS is a list: \(\(HANDLE NAME HELP\)...\), where HANDLE is
  447. either \(SYMBOL . TYPE\) or just SYMBOL.
  448.  
  449. EXTERNAL-FIELDS is a list: \(\(NAME WIDTH FORMAT HELP\)...\), produced
  450. by the function rdb-read-field-defs.
  451.  
  452. If TYPE is omitted, it is deduced from the corresponding FORMAT.
  453. Similarly, if the internal HELP is omitted, any external HELP is used.
  454. The internal definition always overrides the external, since it is more
  455. specific to the EDB implementation.
  456.  
  457. The resulting list format is: \(\(\(SYMBOL . TYPE\) NAME HELP\)...\)."
  458.  
  459.   (let (fieldspec inames (errs 0))
  460.     (if (null ifields)            ;null internal field spec?
  461.     (setq ifields (mapcar        ;make default be same names
  462.                (function (lambda (edef)
  463.                    (let ((name (car edef)))
  464.                      (list (intern name)))))
  465.                efields)))
  466.     ;; now correlate internal fields with the external fields
  467.     ;; while we're mapping over the idefs, build an alist of names
  468.     ;; to use later for the reverse correlation check.
  469.     (setq fieldspec
  470.      (mapcar 
  471.       (function 
  472.        (lambda (idef)
  473.          (let* ((handle (nth 0 idef))
  474.             (name (nth 1 idef))    ; field name (tag)
  475.             (ihelp (nth 2 idef))
  476.             (symbol (or (and (atom handle) handle)
  477.                 (car handle)))
  478.             (type (and (consp handle)
  479.                    (cdr handle)))
  480.             (edef (and name 
  481.                    (assoc name efields)))
  482.             width format ehelp)
  483.            (setq inames (append inames (list (list name))))
  484.            (if (and name (not edef))
  485.            (progn
  486.              (message "Internal field %s is not externally defined"
  487.                   name)
  488.              (beep t)
  489.              (sit-for 3)
  490.              (setq errs (1+ errs)))
  491.          ;; else name could be null because it's dynamic
  492.          (if edef
  493.              (setq width (nth 1 edef)
  494.                format (nth 2 edef)
  495.                ehelp (nth 3 edef))))
  496.            ;; do merge of field info and return:
  497.            ;; ( (SYMBOL . TYPE) NAME HELP )
  498.            (list (cons symbol (or type 
  499.                       (db-rdb-format-to-type format)))
  500.              name
  501.              (or ihelp ehelp)))))
  502.       ifields))            ;end setq
  503.     ;; Now make sure we got all the external fields named
  504.     ;; using the inames alist we built in the mapcar above
  505.     (mapcar (function
  506.          (lambda (edef)
  507.            (let* ((name (nth 0 edef))
  508.               (idef (assoc name inames)))
  509.          (if (not idef)
  510.              (progn
  511.                (message "External field %s is not defined internally."
  512.                 name)
  513.                (sit-for 3)
  514.                (setq errs (1+ errs)))))))
  515.         efields)            ;mapcar over this
  516.     (if (not (zerop errs))
  517.     (if (not (y-or-n-p (format "%d errors occurred; continue? " errs)))
  518.         (error "db-rdb-setup: %d errors" errs)))
  519.     ;; return the field spec
  520.     fieldspec))
  521.  
  522. ;; db-rdb-format-to-type
  523.  
  524. (defun db-rdb-format-to-type (format)
  525.  
  526.   "Given FORMAT from an RDB field definition, return an EDB record field
  527. TYPE."
  528.  
  529.   (cond                    ;convert RDB format to EDB fieldtype
  530.    ;; Left-aligned string
  531.    ((or (null format) 
  532.     (equal format "S")
  533.     (equal format "<"))    'one-line-string)
  534.    ;; someday we'll do something fancier -- like make sure the 
  535.    ;; associated field displayspec has right-alignment turned on
  536.    ;; but, for now...
  537.    ((equal format ">")        'one-line-string)
  538.    ((equal format "N")        'integer-or-nil)
  539.    ;; dates
  540.    ((or (equal format "D") 
  541.     (equal format "M"))    'date-mmddyy)
  542.  
  543.    ;; There are no other alternatives -- cause an error report
  544.    (t
  545.     (message "Unknown field format: %s, string assumed" format)
  546.     (beep t)
  547.     (sit-for 3)
  548.     'one-line-string)))
  549.  
  550. ;; db-rdb-read-table-field-defs
  551.  
  552. (defun db-rdb-read-table-field-defs ()
  553.   "Positioned at the field name line in an RDB Table file, read the
  554. field definitions and setup EDB for regular-file format.  Leave the
  555. buffer positioned before the first record, if any."
  556.   (let ((db database))
  557.     (error "Not implemented yet.")
  558.     (database-set-local 'db-rdb-file-type db 'table t))
  559.   )                    ;end defun db-rdb-read-table-field-defs
  560.  
  561. ;;; db-rdb.el ends here
  562.