(require 'pces)
(require 'mime)
(require 'static)
+(require 'rdfdb)
;;;_* USER CUSTOMIZATION VARIABLES:
(defgroup lsdb nil
:type 'boolean
:group 'lsdb)
+(defcustom lsdb-rdfdb-file (expand-file-name "~/.lsdb.nt")
+ "The name of the Lovely Sister Database file (RDFDB)."
+ :group 'lsdb
+ :type 'file)
+
+(defcustom lsdb-use-rdfdb nil
+ "If non-nil, use RDFDB to store records."
+ :type 'boolean
+ :group 'lsdb)
+
;;;_. Faces
(defface lsdb-header-face
'((t (:underline t)))
The function is called with one argument, the buffer to be displayed.
Overrides `temp-buffer-show-function'.")
+(defvar lsdb-rdfdb-database nil)
+
+(defconst lsdb-rdfdb-namespace-uri
+ "http://lsdb.sourceforge.jp/xmlns/1.0"
+ "Base URI of the LSDB entry resources.")
+
;;;_. Hash Table Emulation
(if (and (fboundp 'make-hash-table)
(subrp (symbol-function 'make-hash-table)))
(setq lsdb-hash-table (lsdb-make-hash-table :test 'equal)))
(lsdb-rebuild-secondary-hash-tables)))
+(defun lsdb-rdfdb-maybe-load-database ()
+ (unless lsdb-rdfdb-database
+ (setq lsdb-rdfdb-database (rdfdb-make-database))
+ (if (file-exists-p lsdb-rdfdb-file)
+ (rdfdb-load-database lsdb-rdfdb-database lsdb-rdfdb-file))))
+
+(defun lsdb-rdfdb-convert-triples-to-alist (triples)
+ (let (alist
+ entry-name
+ literal
+ entry)
+ (while triples
+ (when (string-match
+ (concat "^" (regexp-quote lsdb-rdfdb-namespace-uri) "/entry#")
+ (rdfdb-triple-property (car triples)))
+ (setq entry-name
+ (intern (downcase (substring
+ (rdfdb-triple-property (car triples))
+ (match-end 0))))
+ literal (rdfdb-find-literal lsdb-rdfdb-database
+ (rdfdb-triple-object (car triples))))
+ (if (eq ?. (nth 2 (assq entry-name lsdb-entry-type-alist)))
+ (setq alist (cons (cons entry-name literal) alist))
+ (if (setq entry (assq entry-name alist))
+ (setcdr entry (cons literal (cdr entry)))
+ (setq alist (cons (cons entry-name (list literal)) alist)))))
+ (setq triples (cdr triples)))
+ alist))
+
;;;_ : Fallback Lookup Functions
;;;_ , #1 Address Cache
(defun lsdb-lookup-full-name-from-address-cache (sender)
lsdb-hash-table)
records))
+(defun lsdb-rdfdb-lookup-records (regexp &optional entry-name)
+ "Return the all records in the LSDB matching the REGEXP.
+If the optional 2nd argument ENTRY-NAME is given, matching only
+performed against the entry field."
+ (let ((subjects
+ (mapcar
+ #'rdfdb-triple-subject
+ (rdfdb-match-triples
+ lsdb-rdfdb-database
+ (rdfdb-make-triple
+ nil
+ (concat lsdb-rdfdb-namespace-uri
+ (if (and entry-name (not (equal entry-name "")))
+ (concat "/entry#" (capitalize entry-name))
+ "/entry#Name"))
+ (rdfdb-get-literal-resource lsdb-rdfdb-database regexp))))))
+ (mapcar
+ (lambda (subject)
+ (cons regexp
+ (lsdb-rdfdb-convert-triples-to-alist
+ (rdfdb-match-triples lsdb-rdfdb-database
+ (rdfdb-make-triple subject nil nil)))))
+ subjects)))
+
(defvar lsdb-mode-lookup-history nil)
(defun lsdb-mode-lookup (regexp &optional entry-name)
nil nil nil 'lsdb-mode-lookup-history)
(if (and entry-name (not (equal entry-name "")))
(intern (downcase entry-name))))))
- (lsdb-maybe-load-hash-tables)
- (let ((records (lsdb-lookup-records regexp entry-name)))
+ (if lsdb-use-rdfdb
+ (lsdb-rdfdb-maybe-load-database)
+ (lsdb-maybe-load-hash-tables))
+ (let ((records (if lsdb-use-rdfdb
+ (lsdb-rdfdb-lookup-records regexp entry-name)
+ (lsdb-lookup-records regexp entry-name))))
(if records
(lsdb-display-records records))))
"URI prefix of internal resources.")
(defconst rdfdb-literal-resource-uri-prefix
- (concat rdfdb-namespace-uri "/literal#range_")
+ (concat rdfdb-namespace-uri "/literal#id_")
"URI prefix of literal resources.")
(if (and (fboundp 'make-hash-table)
"Set the OBJECT resource of TRIPLE."
(aset triple 2 object))
-(defconst rdfdb-prime-list
- '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761
- 919 1103 1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103
- 12143 14591 17519 21023 25229 30293 36353 43627 52361 62851 75431
- 90523 108631 130363 156437 187751 225307 270371 324449 389357 467237
- 560689 672827 807403 968897 1162687 1395263 1674319 2009191 2411033
- 2893249))
-
;;;###autoload
-(defun rdfdb-make-database (&optional size)
+(defun rdfdb-make-database ()
"Create a database."
- (unless size
- (setq size 29))
- (let ((prime-list rdfdb-prime-list)
- (key-obarray-size (* size 6)))
- (while (and prime-list
- (> key-obarray-size (car prime-list)))
- (setq prime-list (cdr prime-list)))
- (if prime-list
- (setq key-obarray-size (car prime-list)))
- (vector nil
- (make-vector key-obarray-size 0)
- (rdfdb-make-hash-table :size size)
- (rdfdb-make-hash-table :size size)
- (rdfdb-make-hash-table :size size)
- (with-current-buffer (generate-new-buffer " *rdfdb literals*")
- (buffer-disable-undo)
- (current-buffer))
- 0)))
+ (vector nil
+ (rdfdb-make-hash-table :test 'equal)
+ (rdfdb-make-hash-table)
+ (rdfdb-make-hash-table)
+ (rdfdb-make-hash-table)
+ (rdfdb-make-hash-table)
+ (rdfdb-make-hash-table :test 'equal)
+ 0))
(defun rdfdb-database-triple-list (database)
"Return all the triples which DATABASE holds."
(aref database 0))
-(defsubst rdfdb-database-key-obarray (database)
+(defsubst rdfdb-database-key-index (database)
"Return the hash-table which contains all the keys which
DATABASE allocated.
This function is for internal use only."
This function is for internal use only."
(aref database 4))
-(defsubst rdfdb-database-literal-buffer (database)
- "Return the buffer which holds literal contents.
+(defsubst rdfdb-database-literal-index (database)
+ "Return the hash-table which is used to index literals in DATABASE.
This function is for internal use only."
(aref database 5))
+(defsubst rdfdb-database-literal-reverse-index (database)
+ "Return the hash-table which is used to index literals in DATABASE.
+This function is for internal use only."
+ (aref database 6))
+
(defsubst rdfdb-database-internal-resource-counter (database)
"Return the next index number of internal resources.
This function is for internal use only."
- (aref database 6))
+ (aref database 7))
(defun rdfdb-database-set-triple-list (database triple-list)
"Set TRIPLE-LIST in DATABASE."
(aset database 0 triple-list))
-(defsubst rdfdb-database-set-key-obarray (database key-obarray)
- "Set KEY-OBARRAY in DATABASE.
+(defsubst rdfdb-database-set-key-index (database key-index)
+ "Set KEY-INDEX in DATABASE.
This function is for internal use only."
- (aset database 1 key-obarray))
+ (aset database 1 key-index))
(defsubst rdfdb-database-set-subject-index (database subject-index)
"Set SUBJECT-INDEX in DATABASE.
This function is for internal use only."
(aset database 4 object-index))
-(defsubst rdfdb-database-set-literal-buffer (database literal-buffer)
- "Set LITERAL-BUFFER in DATABASE.
+(defsubst rdfdb-database-set-literal-index (database literal-index)
+ "Set LITERAL-INDEX in DATABASE.
+This function is for internal use only."
+ (aset database 5 literal-index))
+
+(defsubst rdfdb-database-set-literal-reverse-index (database literal-index)
+ "Set LITERAL-INDEX in DATABASE.
This function is for internal use only."
- (aset database 5 literal-buffer))
+ (aset database 6 literal-index))
(defsubst rdfdb-database-set-internal-resource-counter (database
resource-index)
"Set RESOURCE-INDEX in DATABASE.
This function is for internal use only."
- (aset database 6 resource-index))
+ (aset database 7 resource-index))
(defun rdfdb-clear-database (database)
"Clear all entries in DATABASE."
(rdfdb-database-set-triple-list database nil)
- (fillarray (rdfdb-database-key-obarray database) 0)
+ (rdfdb-clrhash (rdfdb-database-key-index database))
(rdfdb-clrhash (rdfdb-database-subject-index database))
(rdfdb-clrhash (rdfdb-database-property-index database))
(rdfdb-clrhash (rdfdb-database-object-index database))
- (kill-buffer (rdfdb-database-literal-buffer database))
+ (rdfdb-clrhash (rdfdb-database-literal-index database))
+ (rdfdb-clrhash (rdfdb-database-literal-reverse-index database))
(rdfdb-database-set-internal-resource-counter database 0))
(defun rdfdb-find-key (database first &optional second)
"Return the canonical key object whose name is constructed by
concatenating FIRST and SECOND resources, or nil if none exists."
- (intern-soft (if second
- (concat first "\0" second)
- first)
- (rdfdb-database-key-obarray database)))
+ (rdfdb-gethash (if second
+ (concat first "\0" second)
+ first)
+ (rdfdb-database-key-index database)))
(defun rdfdb-get-key (database first &optional second)
"Return the canonical key object whose name is constructed by
concatenating FIRST and SECOND resources.
If there is none, one is created in DATABASE and returned."
- (intern (if second
- (concat first "\0" second)
- first)
- (rdfdb-database-key-obarray database)))
+ (let ((key-string (if second
+ (concat first "\0" second)
+ first)))
+ (or (rdfdb-gethash key-string
+ (rdfdb-database-key-index database))
+ (rdfdb-puthash key-string key-string
+ (rdfdb-database-key-index database)))))
(defun rdfdb-get-internal-resource (database)
"Create a resource for internal use."
(defun rdfdb-get-literal-resource (database string)
"Return the canonical resource object which represents STRING.
If there is none, one is created in DATABASE and returned."
- (save-excursion
- (set-buffer (rdfdb-database-literal-buffer database))
- (goto-char (point-min))
- (concat rdfdb-literal-resource-uri-prefix
- (if (search-forward string nil t)
- (format "%d_%d" (match-beginning 0) (match-end 0))
- (format "%d_%d"
- (goto-char (point-max))
- (progn (insert string) (point)))))))
+ (or (rdfdb-gethash string
+ (rdfdb-database-literal-index database))
+ (let* ((resource (rdfdb-get-internal-resource database))
+ (key (rdfdb-get-key database resource)))
+ (rdfdb-puthash key string
+ (rdfdb-database-literal-index database))
+ (rdfdb-puthash string key
+ (rdfdb-database-literal-reverse-index database)))))
(defun rdfdb-find-literal (database resource)
"Return the literal value of RESOURCE, or nil if none exists."
- (with-current-buffer (rdfdb-database-literal-buffer database)
- (if (string-match
- (concat "^" (regexp-quote rdfdb-literal-resource-uri-prefix)
- "\\([0-9A-F]+\\)_\\([0-9A-F]+\\)")
- resource)
- (buffer-substring (string-to-number
- (match-string 1 resource))
- (string-to-number
- (match-string 2 resource))))))
+ (let ((key (rdfdb-find-key database resource)))
+ (if key
+ (rdfdb-gethash key (rdfdb-database-literal-reverse-index database)))))
(defun rdfdb-triple-lessp (first second)
"Return t if FIRST is less than SECOND."
projects / elisp / lsdb.git / commitdiff