Changeset 7470


Ignore:
Timestamp:
Oct 18, 2007, 3:07:13 PM (14 years ago)
Author:
gz
Message:

Allow the possibility that headers can be stored somewhere other than "ccl:":
A new variable, *interfaces-root*, default "ccl:", can be set to change the
root headers directory.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/db-io.lisp

    r7065 r7470  
    375375  (with-lock-grabbed ((cdb-lock cdb))
    376376    (%cdb-get (cdb-fid cdb) key value)))
     377
     378(defun cdb-subdirectory-path (&optional (ftd *target-ftd*))
     379  (let* ((ftd-name (ftd-interface-db-directory ftd))
     380         (ftd-dir (pathname-directory ftd-name)))
     381    (assert (equalp (pathname-host ftd-name) "ccl"))
     382    (assert (eq (car ftd-dir) :absolute))
     383    (cdr ftd-dir)))
     384
     385(defvar *interfaces-root* "ccl:")
     386
     387(defun open-interface-db-pathname (name d)
     388  (let* ((db-path (make-pathname :host (pathname-host *interfaces-root*)
     389                                 :directory (append
     390                                             (or (pathname-directory *interfaces-root*)
     391                                                 '(:absolute))
     392                                             (cdb-subdirectory-path *target-ftd*))))
     393         (path (merge-pathnames name
     394                                (merge-pathnames (interface-dir-subdir d) db-path))))
     395    (cdb-open path)))
    377396
    378397(defun cdb-open (pathname)
     
    744763  (or (interface-dir-constants-interface-db-file dir)
    745764      (setf (interface-dir-constants-interface-db-file dir)
    746             (cdb-open (interface-db-pathname "constants.cdb" dir)))))
     765            (open-interface-db-pathname "constants.cdb" dir))))
    747766
    748767(defun db-objc-classes (dir)
    749768  (or (interface-dir-objc-classes-interface-db-file dir)
    750769      (setf (interface-dir-objc-classes-interface-db-file dir)
    751             (cdb-open (interface-db-pathname "objc-classes.cdb" dir)))))
     770            (open-interface-db-pathname "objc-classes.cdb" dir))))
    752771
    753772(defun db-objc-methods (dir)
    754773  (or (interface-dir-objc-methods-interface-db-file dir)
    755774      (setf (interface-dir-objc-methods-interface-db-file dir)
    756             (cdb-open (interface-db-pathname "objc-methods.cdb" dir)))))
     775            (open-interface-db-pathname "objc-methods.cdb" dir))))
    757776
    758777(defun db-vars (dir)
    759778  (or (interface-dir-vars-interface-db-file dir)
    760779      (setf (interface-dir-vars-interface-db-file dir)
    761             (cdb-open (interface-db-pathname "vars.cdb" dir)))))
     780            (open-interface-db-pathname "vars.cdb" dir))))
    762781
    763782(defun db-types (dir)
    764783  (or (interface-dir-types-interface-db-file dir)
    765784      (setf (interface-dir-types-interface-db-file dir)
    766             (cdb-open (interface-db-pathname "types.cdb" dir)))))
     785            (open-interface-db-pathname "types.cdb" dir))))
    767786
    768787(defun db-records (dir)
    769788  (or (interface-dir-records-interface-db-file dir)
    770789      (setf (interface-dir-records-interface-db-file dir)
    771             (cdb-open (interface-db-pathname "records.cdb" dir)))))
     790            (open-interface-db-pathname "records.cdb" dir))))
    772791
    773792(defun db-functions (dir)
    774793  (or (interface-dir-functions-interface-db-file dir)
    775794      (setf (interface-dir-functions-interface-db-file dir)
    776             (cdb-open (interface-db-pathname "functions.cdb" dir)))))
     795            (open-interface-db-pathname "functions.cdb" dir))))
    777796
    778797(defun load-os-constant (sym &optional query)
Note: See TracChangeset for help on using the changeset viewer.