branch: externals/dict-tree
commit 87bb7e83a958f4f735d657401b25c048d764c4bd
Author: Toby Cubitt <toby-predict...@dr-qubit.org>
Commit: tsc25 <toby-predict...@dr-qubit.org>
Allow custom write and load functions when saving and dumping dictionaries;
Changed meta-data to property lists;
Minor enhancements and bug-fixes.
---
dict-tree.el | 1033 ++++++++++++++++++++++++++++++++++++----------------------
1 file changed, 641 insertions(+), 392 deletions(-)
diff --git a/dict-tree.el b/dict-tree.el
index c8c5c0b..f747fd0 100644
--- a/dict-tree.el
+++ b/dict-tree.el
@@ -257,6 +257,9 @@ If START or END is negative, it counts from the end."
lookup-cache-threshold
complete-cache-threshold
complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
trie-type
&aux
(modified nil)
@@ -295,9 +298,12 @@ If START or END is negative, it counts from the end."
lookup-cache-threshold
complete-cache-threshold
complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
&key
createfun insertfun deletefun lookupfun mapfun emptyfun
- stackfun popfun stackemptyfun
+ stack-createfun stack-popfun stack-emptyfun
&aux
(modified nil)
(trie (trie-create-custom comparison-function
@@ -307,9 +313,9 @@ If START or END is negative, it counts from the end."
:lookupfun lookupfun
:mapfun mapfun
:emptyfun emptyfun
- :stackfun stackfun
- :popfun popfun
- :stackemptyfun stackemptyfun))
+ :stack-createfun stack-createfun
+ :stack-popfun stack-popfun
+ :stack-emptyfun stack-emptyfun))
(insfun (eval (macroexpand
`(dictree--wrap-insfun ,insert-function))))
(rankfun (eval (macroexpand
@@ -335,6 +341,9 @@ If START or END is negative, it counts from the end."
lookup-cache lookup-cache-threshold
complete-cache complete-cache-threshold
complete-ranked-cache complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
trie meta-dict-list)
@@ -396,47 +405,43 @@ If START or END is negative, it counts from the end."
-(defmacro dictree--wrap-data (data &optional meta-data)
+(defmacro dictree--cell-create (data &optional meta-data)
;; INTERNAL USE ONLY
;; wrap the data in a cons cell
`(cons ,data ,meta-data))
;; get data component from data cons cell
-(defalias 'dictree--unwrap-data 'car) ; INTERNAL USE ONLY
-
-;; set data component of data cons cell
-(defalias 'dictree--set-data 'setcar) ; INTERNAL USE ONLY
+(defmacro dictree--cell-data (cell) ; INTERNAL USE ONLY
+ `(car ,cell))
;; get meta-data component of data cons cell
-(defalias 'dictree--unwrap-metadata 'cdr) ; INTERNAL USE ONLY
-
-;; set meta-data component of data cons cell
-(defalias 'dictree--set-metadata 'setcdr) ; INTERNAL USE ONLY
-
+(defmacro dictree--cell-plist (cell) ; INTERNAL USE ONLY
+ `(cdr ,cell))
(defmacro dictree--wrap-insfun (insfun) ; INTERNAL USE ONLY
;; return wrapped insfun to deal with data wrapping
`(lambda (new old)
- (dictree--set-data old (,insfun (dictree--unwrap-data new)
- (dictree--unwrap-data old)))
+ (setf (dictree--cell-data old)
+ (,insfun (dictree--cell-data new)
+ (dictree--cell-data old)))
old))
(defmacro dictree--wrap-rankfun (rankfun) ; INTERNAL USE ONLY
;; return wrapped rankfun to deal with data wrapping
`(lambda (a b)
- (,rankfun (cons (car a) (dictree--unwrap-data (cdr a)))
- (cons (car b) (dictree--unwrap-data (cdr b))))))
+ (,rankfun (cons (car a) (dictree--cell-data (cdr a)))
+ (cons (car b) (dictree--cell-data (cdr b))))))
(defmacro dictree--wrap-filter (filter) ; INTERNAL USE ONLY
;; return wrapped filter function to deal with data wrapping
- `(lambda (key data) (,filter key (dictree--unwrap-data data))))
+ `(lambda (key data) (,filter key (dictree--cell-data data))))
(defmacro dictree--wrap-combfun (combfun) ; INTERNAL USE ONLY
`(lambda (cell1 cell2)
- (cons (,combfun (dictree--unwrap-data cell1)
- (dictree--unwrap-data cell2))
- (append (list (dictree--unwrap-metadata cell1))
- (list (dictree--unwrap-metadata cell2))))))
+ (cons (,combfun (dictree--cell-data cell1)
+ (dictree--cell-data cell2))
+ (append (list (dictree--cell-metadata cell1))
+ (list (dictree--cell-metadata cell2))))))
;; Construct and return a completion cache entry
(defalias 'dictree--cache-create 'cons) ; INTERNAL USE ONLY
@@ -524,6 +529,9 @@ If START or END is negative, it counts from the end."
lookup-cache-threshold
complete-cache-threshold
complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
trie-type)
"Create an empty dictionary and return it.
@@ -533,37 +541,35 @@ extension. (Regardless of the value of NAME, the
dictionary will
be stored in the default variable name when it is reloaded from
file.)
-Optional argument FILENAME supplies a directory and file name to
-use when saving the dictionary. If the AUTOSAVE flag is non-nil,
-then the dictionary will automatically be saved to this file when
-it is unloaded or when exiting Emacs.
-
-If optional argument UNLISTED is non-nil, the dictionary will not
-be added to the list of loaded dictionaries. Note that this
-disables autosaving.
-
-Optional argument COMPARE-FUNCTION sets the function used to
-compare elements of the keys. It should take two arguments, A and
-B, both of the type contained by the sequences used as keys
-\(e.g. if the keys will be strings, the function will be passed
-two characters\). It should return t if the first is \"less
-than\" the second. Defaults to `<'.
-
-Optional argument INSERT-FUNCTION sets the function used to
-insert data into the dictionary. It should take two arguments:
-the new data, and the data already in the dictionary, and should
-return the data to insert. Defaults to replacing any existing
-data with the new data.
-
-Optional argument RANK-FUNCTION sets the function used to rank
-the results of `dictree-complete'. It should take two arguments,
-each a cons whose car is a dictree key (a sequence) and whose cdr
-is the data associated with that key. It should return non-nil if
-the first argument is \"better\" than the second, nil
-otherwise. It defaults to \"lexical\" comparison of the keys,
-ignoring the data \(which is not very useful, since the
-`dictree-complete' function already does this much more
-efficiently\).
+FILENAME supplies a directory and file name to use when saving
+the dictionary. If the AUTOSAVE flag is non-nil, then the
+dictionary will automatically be saved to this file when it is
+unloaded or when exiting Emacs.
+
+If UNLISTED is non-nil, the dictionary will not be added to the
+list of loaded dictionaries. Note that this disables autosaving.
+
+COMPARE-FUNCTION sets the function used to compare elements of
+the keys. It should take two arguments, A and B, both of the type
+contained by the sequences used as keys \(e.g. if the keys will
+be strings, the function will be passed two characters\). It
+should return t if the first is \"less than\" the
+second. Defaults to `<'.
+
+INSERT-FUNCTION sets the function used to insert data into the
+dictionary. It should take two arguments: the new data, and the
+data already in the dictionary, and should return the data to
+insert. Defaults to replacing any existing data with the new
+data.
+
+RANK-FUNCTION sets the function used to rank the results of
+`dictree-complete'. It should take two arguments, each a cons
+whose car is a dictree key (a sequence) and whose cdr is the data
+associated with that key. It should return non-nil if the first
+argument is \"better\" than the second, nil otherwise. It
+defaults to \"lexical\" comparison of the keys, ignoring the data
+\(which is not very useful, since an unranked `dictree-complete'
+query already does this much more efficiently\).
CACHE-POLICY should be a symbol (time or length), which
determines which query operations are cached. The former caches
@@ -589,6 +595,29 @@ for that type of query. If it is t, everything is cached
for that
type of query \(similar behaviour can be obtained by setting the
CACHE-THRESHOLD to 0, but it is better to use t\).
+KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN are functions used to
+convert keys, data and property lists into lisp objects that have
+a valid read syntax, for writing to file. DATA-SAVEFUN and
+PLIST-SAVEFUN are used when saving the dictionary (see
+`dictree-save' and `dictree-write'), and all three functions are
+used when dumping the contents of the dictionary \(see
+`dictree-dump-to-buffer' and `dictree-dump-to-file'\).
+KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN should each accept
+one argument: a key, data or property list from DICT,
+respectively. They should return a lisp object which has a valid
+read syntax. When defining these functions, be careful not to
+accidentally modify the lisp object in the dictionary; usually,
+you will need to make a copy before converting it.
+
+KEY-LOADFUN, DATA-LOADFUN and PLIST-LOADFUN are used to convert
+keys, data and property lists back again when loading a
+dictionary (only DATA-LOADFUN and PLIST-LOADFUN, see
+`dictree-save' and `dictree-write') or populating it from a
+file (all three, see `dictree-populate-from-file'). They should
+accept one argument: a lisp object of the type produced by the
+corresponding SAVEFUN, and return a lisp object to use in the
+loaded dictionary.
+
TRIE-TYPE sets the type of trie to use as the underlying data
structure. See `trie-create' for details."
@@ -610,6 +639,9 @@ structure. See `trie-create' for details."
lookup-cache-threshold
complete-cache-threshold
complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
trie-type)))
;; store dictionary in variable NAME
(when name (set name dict))
@@ -629,8 +661,11 @@ structure. See `trie-create' for details."
lookup-cache-threshold
complete-cache-threshold
complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
createfun insertfun deletefun lookupfun mapfun emptyfun
- stackfun popfun stackemptyfun)
+ stack-createfun stack-popfun stack-emptyfun)
"Create an empty dictionary and return it.
If NAME is supplied, the dictionary is stored in the variable
@@ -639,37 +674,35 @@ extension. (Regardless of the value of NAME, the
dictionary will
be stored in the default variable name when it is reloaded from
file.)
-Optional argument FILENAME supplies a directory and file name to
-use when saving the dictionary. If the AUTOSAVE flag is non-nil,
-then the dictionary will automatically be saved to this file when
-it is unloaded or when exiting Emacs.
-
-If optional argument UNLISTED is non-nil, the dictionary will not
-be added to the list of loaded dictionaries. Note that this
-disables autosaving.
-
-Optional argument COMPARE-FUNCTION sets the function used to
-compare elements of the keys. It should take two arguments, A and
-B, both of the type contained by the sequences used as keys
-\(e.g. if the keys will be strings, the function will be passed
-two characters\). It should return t if the first is \"less
-than\" the second. Defaults to `<'.
-
-Optional argument INSERT-FUNCTION sets the function used to
-insert data into the dictionary. It should take two arguments:
-the new data, and the data already in the dictionary, and should
-return the data to insert. Defaults to replacing any existing
-data with the new data.
-
-Optional argument RANK-FUNCTION sets the function used to rank
-the results of `dictree-complete'. It should take two arguments,
-each a cons whose car is a dictree key (a sequence) and whose cdr
-is the data associated with that key. It should return non-nil if
-the first argument is \"better\" than the second, nil
-otherwise. It defaults to \"lexical\" comparison of the keys,
-ignoring the data \(which is not very useful, since the
-`dictree-complete' function already does this much more
-efficiently\).
+FILENAME supplies a directory and file name to use when saving
+the dictionary. If the AUTOSAVE flag is non-nil, then the
+dictionary will automatically be saved to this file when it is
+unloaded or when exiting Emacs.
+
+If UNLISTED is non-nil, the dictionary will not be added to the
+list of loaded dictionaries. Note that this disables autosaving.
+
+COMPARE-FUNCTION sets the function used to compare elements of
+the keys. It should take two arguments, A and B, both of the type
+contained by the sequences used as keys \(e.g. if the keys will
+be strings, the function will be passed two characters\). It
+should return t if the first is \"less than\" the
+second. Defaults to `<'.
+
+INSERT-FUNCTION sets the function used to insert data into the
+dictionary. It should take two arguments: the new data, and the
+data already in the dictionary, and should return the data to
+insert. Defaults to replacing any existing data with the new
+data.
+
+RANK-FUNCTION sets the function used to rank the results of
+`dictree-complete'. It should take two arguments, each a cons
+whose car is a dictree key (a sequence) and whose cdr is the data
+associated with that key. It should return non-nil if the first
+argument is \"better\" than the second, nil otherwise. It
+defaults to \"lexical\" comparison of the keys, ignoring the data
+\(which is not very useful, since the `dictree-complete' function
+already does this much more efficiently\).
CACHE-POLICY should be a symbol (time or length), which
determines which query operations are cached. The former caches
@@ -695,6 +728,29 @@ that type of query. If it is t, everything is cached for
that
type of query \(similar behaviour can be obtained by setting the
CACHE-THRESHOLD to 0, but it is better to use t\).
+KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN are functions used to
+convert keys, data and property lists into lisp objects that have
+a valid read syntax, for writing to file. DATA-SAVEFUN and
+PLIST-SAVEFUN are used when saving the dictionary (see
+`dictree-save' and `dictree-write'), and all three functions are
+used when dumping the contents of the dictionary \(see
+`dictree-dump-to-buffer' and `dictree-dump-to-file'\).
+KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN should each accept
+one argument: a key, data or property list from DICT,
+respectively. They should return a lisp object which has a valid
+read syntax. When defining these functions, be careful not to
+accidentally modify the lisp object in the dictionary; usually,
+you will need to make a copy before converting it.
+
+KEY-LOADFUN, DATA-LOADFUN and PLIST-LOADFUN are used to convert
+keys, data and property lists back again when loading a
+dictionary (only DATA-LOADFUN and PLIST-LOADFUN, see
+`dictree-save' and `dictree-write') or populating it from a
+file (all three, see `dictree-populate-from-file'). They should
+accept one argument: a lisp object of the type produced by the
+corresponding SAVEFUN, and return a lisp object to use in the
+loaded dictionary.
+
The remaining arguments determine the type of trie to use as the
underlying data structure. See `trie-create' for details."
@@ -716,15 +772,18 @@ underlying data structure. See `trie-create' for details."
lookup-cache-threshold
complete-cache-threshold
complete-ranked-cache-threshold
+ key-savefun key-loadfun
+ data-savefun data-loadfun
+ plist-savefun plist-loadfun
:createfun createfun
:insertfun insertfun
:deletefun deletefun
:lookupfun lookupfun
:mapfun mapfun
:emptyfun emptyfun
- :stackfun stackfun
- :popfun popfun
- :stackemptyfun stackemptyfun)))
+ :stack-createfun stack-createfun
+ :stack-popfun stack-popfun
+ :stack-emptyfun stack-emptyfun)))
;; store dictionary in variable NAME
(when name (set name dict))
;; add it to loaded dictionary list, unless it's unlisted
@@ -835,7 +894,7 @@ The other arguments are as for `dictree-create'."
(setf (dictree--meta-dict-name ,dict) ,name)
(setf (dictree--name ,dict) ,name)))
-(defsubst dictree-filename (dict)
+(defun dictree-filename (dict)
"Return dictionary DICT's associated file name."
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-filename dict)
@@ -876,7 +935,7 @@ The other arguments are as for `dictree-create'."
'dictree--meta-dict-dictlist
"Return the list of constituent dictionaries for meta-dictionary DICT.")
-(defsubst dictree-lookup-cache-threshold (dict)
+(defun dictree-lookup-cache-threshold (dict)
"Return the lookup cache threshold for dictionary DICT."
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-lookup-cache-threshold dict)
@@ -888,13 +947,13 @@ The other arguments are as for `dictree-create'."
(setf (dictree--meta-dict-lookup-cache-threshold ,dict) ,param)
(setf (dictree--lookup-cache-threshold ,dict) ,param)))
-(defsubst dictree-lookup-cache (dict)
+(defun dictree-lookup-cache (dict)
;; Return the lookup cache for dictionary DICT.
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-lookup-cache dict)
(dictree--lookup-cache dict)))
-(defsubst dictree-complete-cache-threshold (dict)
+(defun dictree-complete-cache-threshold (dict)
"Return the completion cache threshold for dictionary DICT."
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-complete-cache-threshold dict)
@@ -906,13 +965,13 @@ The other arguments are as for `dictree-create'."
(setf (dictree--meta-dict-complete-cache-threshold ,dict) ,param)
(setf (dictree--complete-cache-threshold ,dict) ,param)))
-(defsubst dictree-complete-cache (dict)
+(defun dictree-complete-cache (dict)
;; Return the completion cache for dictionary DICT.
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-complete-cache dict)
(dictree--complete-cache dict)))
-(defsubst dictree-complete-ranked-cache-threshold (dict)
+(defun dictree-complete-ranked-cache-threshold (dict)
"Return the ranked completion cache threshold for dictionary DICT."
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-complete-ranked-cache-threshold dict)
@@ -924,7 +983,7 @@ The other arguments are as for `dictree-create'."
(setf (dictree--meta-dict-complete-ranked-cache-threshold ,dict) ,param)
(setf (dictree--complete-ranked-cache-threshold ,dict) ,param)))
-(defsubst dictree-complete-ranked-cache (dict)
+(defun dictree-complete-ranked-cache (dict)
;; Return the ranked completion cache for dictionary DICT.
(if (dictree--meta-dict-p dict)
(dictree--meta-dict-complete-ranked-cache dict)
@@ -973,15 +1032,10 @@ inserted depends on the dictionary's insertion function
\(see
`dictree-create'\).
The optional INSERT-FUNCTION over-rides the dictionary's own
-insertion function. It should take two arguments: the data DATA,
-and the data associated with KEY in the dictionary (nil if none
-already exists). It should return the data to insert."
- ;; make sure SEQUENCE is a sequence
- (when (not (sequencep key))
- (error "Wrong argument type stringp, %s"
- (prin1-to-string key)))
- (when (not (dictree-p dict))
- (error "Wrong argument type dictree-p"))
+insertion function. If KEY already exists in DICT,
+INSERT-FUNCTION is called with two arguments: the data DATA, and
+the data associated with KEY in the dictionary. Its return value
+becomes the new association for KEY."
;; if dictionary is a meta-dictionary, insert key into all the
;; dictionaries it's based on
@@ -997,7 +1051,7 @@ already exists). It should return the data to insert."
;; insert key in dictionary's ternary search tree
(setq newdata
(trie-insert
- (dictree--trie dict) key (dictree--wrap-data data)
+ (dictree--trie dict) key (dictree--cell-create data)
(or (and insert-function
(eval (macroexpand
`(dictree--wrap-insfun ,insert-function))))
@@ -1009,26 +1063,40 @@ already exists). It should return the data to insert."
(dictree--meta-dict-list dict))
;; return the new data
- (dictree--unwrap-data newdata))))
+ (dictree--cell-data newdata))))
-(defun dictree-delete (dict key)
+(defun dictree-delete (dict key &optional test)
"Delete KEY from DICT.
-Returns non-nil if KEY was deleted, nil if KEY was not in DICT."
+Returns non-nil if KEY was deleted, nil if KEY was not in DICT.
+
+If TEST is supplied, it should be a function that accepts three
+arguments: the key being deleted, its associated data, and its
+associated property list. The key will then only be deleted if
+TEST returns non-nil."
- (let (deleted)
+ (let ((dictree--delete-test test)
+ deleted del)
(cond
;; if DICT is a meta-dictionary, delete KEY from all dictionaries
;; it's based on
((dictree--meta-dict-p dict)
(dolist (dic (dictree--meta-dict-dictlist dict))
- (setq deleted (or deleted (dictree-delete dic key))))
- (setf (dictree-modified dict) (and deleted t)))
+ (when (setq del (dictree-delete dic key))
+ (setq deleted (cons del deleted))))
+ (setf (dictree-modified dict) (and deleted t))
+ (setq deleted (nreverse deleted)))
;; otherwise...
(t
- (setq deleted (trie-delete (dictree--trie dict) key))
+ (setq deleted
+ (trie-delete (dictree--trie dict) key
+ (when dictree--delete-test
+ (lambda (k cell)
+ (funcall dictree--delete-test
+ k (dictree--cell-data cell)
+ (dictree--cell-plist cell))))))
;; if key was deleted, have to update the caches
(when deleted
(dictree-update-cache dict key nil t)
@@ -1040,7 +1108,7 @@ Returns non-nil if KEY was deleted, nil if KEY was not in
DICT."
;; return deleted key/data pair
(when deleted
- (cons (car deleted) (dictree--unwrap-data (cdr deleted))))))
+ (cons (car deleted) (dictree--cell-data (cdr deleted))))))
@@ -1168,7 +1236,7 @@ to be distinguished from an element with a null
association. (See
also `dictree-member-p' for testing existence alone.)"
(let ((data (dictree--lookup dict key nilflag)))
(unless (eq data nilflag)
- (dictree--unwrap-data data))))
+ (dictree--cell-data data))))
(defalias 'dictree-member 'dictree-lookup)
@@ -1236,45 +1304,97 @@ also `dictree-member-p' for testing existence alone.)"
;; ----------------------------------------------------------------
;; Getting and setting meta-data
-(defun dictree-set-meta-data (dict key meta-data)
- "Set meta-data for KEY in dictionary DICT.
-Returns META-DATA if successful, nil if KEY was not found in
-DICT.
+(defun dictree-put-property (dict key property value)
+ "Set PROPERTY for KEY in dictionary DICT.
+PROPERTY should be a symbol. Returns VALUE if successful, nil if
+KEY was not found in DICT.
-Note that if DICT is a meta-dictionary, then this will set the
-meta-data for KEY in *all* its constituent dictionaries.
+Note that if DICT is a meta-dictionary, then this will set KEY's
+PROPERTY to VALUE in *all* its constituent dictionaries.
Unlike the data associated with a key (cf. `dictree-insert'),
-meta-data is not included in the results of queries on the
+properties are not included in the results of queries on the
dictionary \(`dictree-lookup', `dictree-complete',
-`dictree-complete-ordered'\), nor does it affect the outcome of
-any of the queries. It merely serves to tag a key with some
+`dictree-complete-ordered'\), nor do they affect the outcome of
+any of the queries. They merely serves to tag a key with some
additional information, and can only be retrieved using
-`dictree-lookup-meta-data'."
+`dictree-get-property'."
+
+ ;; sort out arguments
+ (when (symbolp dict) (setq dict (eval dict)))
(cond
+ ;; set PROPERTY for KEY in all constituent dicts of a meta-dict
((dictree--meta-dict-p dict)
- (warn "Setting meta-data in all constituent dictionaries of a meta-dict")
- (setf (dictree-modified dict) t)
- (mapc 'dictree-set-meta-data (dictree--meta-dict-dictlist dict)))
- (t
+ (warn "Setting %s property for key %s in all constituent dictionaries\
+ of meta-dicttionary %s" property key (dictree-name dict))
(setf (dictree-modified dict) t)
+ (let (dictree--put-property-ret)
+ (mapc (lambda (dic k p v)
+ (setq dictree--put-property-ret
+ (or dictree--put-property-ret
+ (dictree-put-property dic k p v))))
+ (dictree--meta-dict-dictlist dict))
+ ;; return VALUE if KEY was found in at least one constituent dict
+ dictree--put-property-ret))
+ (t ;; set PROPERTY for KEY in normal dict
(let ((cell (trie-member (dictree--trie dict) key)))
- (when cell (dictree--set-metadata cell meta-data))))))
+ (when cell
+ (setf (dictree-modified dict) t)
+ (setf (dictree--cell-plist cell)
+ (plist-put (dictree--cell-plist cell) property value))
+ value))) ; return VALUE
+ ))
-(defun dictree-get-meta-data (dict key &optional nilflag)
- "Return the meta-data associated with KEY in dictionary DICT,
-or nil if KEY is not in the dictionary.
+(defun dictree-delete-property (dict key property)
+ "Delete PROPERTY from KEY in dictionary DICT.
+Returns the new property list for KEY, with PROPERTY deleted.
+
+Setting PROPERTY to nil using `dictree-put-property' is not quite
+the same thing as deleting it, since null property values can
+still be detected by supplying the optional argument to
+`dictree-get-propery' (which see).
+
+Note that if DICT is a meta-dictionary, then this will delete
+KEY's PROPERTY in *all* its constituent dictionaries."
+ ;; sort out arguments
+ (when (symbolp dict) (setq dict (eval dict)))
+ (cond
+ ;; delete PROPERTY from KEY in all constituent dicts of a meta-dict
+ ((dictree--meta-dict-p dict)
+ (warn "Deleting %s property from key %s in all constituent dictionaries\
+ of meta-dicttionary %s" property key (dictree-name dict))
+ (setf (dictree-modified dict) t)
+ (mapcar (lambda (dic k p) (dictree-delete-property dic k p))
+ (dictree--meta-dict-dictlist dict)))
+ (t ;; delete PROPERTY from KEY in normal dict
+ (let* ((cell (trie-member (dictree--trie dict) key))
+ plist tail tail)
+ (when (and cell
+ (setq tail
+ (plist-member (setq plist (dictree--cell-plist cell))
+ property)))
+ (setf (dictree-modified dict) t)
+ ;; delete property and value from plist
+ (setcdr tail (cddr tail))
+ (setq plist (delq property plist))
+ (setf (dictree--cell-plist cell) plist))))
+ ))
+
+
+
+(defun dictree-get-property (dict key property &optional nilflag)
+ "Get the value of PROPERTY for KEY in dictionary DICT,
+or return nil if KEY is not in the dictionary.
Optional argument NILFLAG specifies a value to return instead of
nil if KEY does not exist in TREE. This allows a non-existent KEY
-to be distinguished from a key that does not have any
-meta-data. (See also `dictree-member-p' for testing existence
-alone.)"
- (let ((data (dictree--lookup dict key nilflag)))
- (unless (eq data nilflag)
- (dictree--unwrap-metadata data))))
+to be distinguished from a key for which PROPERTY is not
+set. (See also `dictree-member-p' for testing existence alone.)"
+ (let ((cell (dictree--lookup dict key nilflag)))
+ (unless (eq cell nilflag)
+ (plist-get (dictree--cell-plist cell) property))))
@@ -1303,15 +1423,14 @@ REVERSE is non-nil."
;; dynamical scoping bugs
(let ((dictree-mapc--function function))
(dictree--mapc
- (lambda (key data metadata)
+ (lambda (key data plist)
(funcall dictree-mapc--function key data))
dict type reverse)))
(defun dictree--mapc (function dict &optional type reverse)
- ;; Like `dictree-mapc', but FUNCTION is passed a cons cell containing the
- ;; data (car) and meta-data (cdr) as its second argument, instead of just
- ;; the data.
+ ;; Like `dictree-mapc', but FUNCTION is passed three arguments: the key, the
+ ;; data, and the property list, instead of just key and data.
;; "rename" FUNCTION to something hopefully unique, to help avoid nasty
;; dynamical scoping bugs
@@ -1319,11 +1438,11 @@ REVERSE is non-nil."
;; for a normal dictionary, map the function over its trie
(if (not (dictree--meta-dict-p dict))
(trie-mapc
- (lambda (key data)
+ (lambda (key cell)
(funcall dictree--mapc--function
key
- (dictree--unwrap-data data)
- (dictree--unwrap-metadata data)))
+ (dictree--cell-data cell)
+ (dictree--cell-plist cell)))
(dictree--trie dict)
type reverse)
;; for a meta-dict, use a dictree-stack
@@ -1332,8 +1451,8 @@ REVERSE is non-nil."
(while (setq entry (dictree--stack-pop stack))
(funcall dictree--mapc--function
(car entry)
- (dictree--unwrap-data (cdr entry))
- (dictree--unwrap-metadata (cdr entry)))))
+ (dictree--cell-data (cdr entry))
+ (dictree--cell-plist (cdr entry)))))
)))
@@ -1364,7 +1483,7 @@ descending order if REVERSE is non-nil."
(if (not (dictree--meta-dict-p dict))
(trie-mapf
`(lambda (key data)
- (,dictree-mapf--function key (dictree--unwrap-data data)))
+ (,dictree-mapf--function key (dictree--cell-data data)))
dictree-mapf--combinator (dictree--trie dict) type reverse)
;; for a meta-dict, use a dictree-stack
@@ -1397,8 +1516,8 @@ function `string' to the individual elements of key
sequences
stored in DICT.
The FUNCTION will be applied and the results combined in
-asscending \"lexical\" order (i.e. the order defined by the
-dictionary's comparison function; cf. `dictree-create'), or
+asscending \"lexical\" order \(i.e. the order defined by the
+dictionary's comparison function; cf. `dictree-create'\), or
descending order if REVERSE is non-nil.
Note that if you don't care about the order in which FUNCTION is
@@ -1547,7 +1666,7 @@ sufficient, it is better to use one of those instead."
"Pop the first element from the DICTREE-STACK.
Returns nil if the stack is empty."
(let ((popped (dictree--stack-pop dictree-stack)))
- (when popped (cons (car popped) (dictree--unwrap-data (cdr popped))))))
+ (when popped (cons (car popped) (dictree--cell-data (cdr popped))))))
(defun dictree--stack-pop (dictree-stack)
@@ -1581,12 +1700,12 @@ Returns nil if the stack is empty."
(setq next (dictree--stack-pop stack))
(setq curr
(cons (car curr)
- (dictree--wrap-data
+ (dictree--cell-create
(funcall (dictree--meta-stack-combfun dictree-stack)
- (dictree--unwrap-data (cdr curr))
- (dictree--unwrap-data (cdr next)))
- (list (dictree--unwrap-metadata (cdr curr))
- (dictree--unwrap-metadata (cdr next))))))
+ (dictree--cell-data (cdr curr))
+ (dictree--cell-data (cdr next)))
+ (append (dictree--cell-plist (cdr curr))
+ (dictree--cell-plist (cdr next))))))
(heap-add heap stack)
(setq next (dictree--stack-first (heap-root heap))))))
;; return the combined dictionary element
@@ -1608,7 +1727,7 @@ Returns nil if the stack is empty."
"Return the first element from DICTREE-STACK, without removing it.
Returns nil if the stack is empty."
(let ((first (dictree--stack-first dictree-stack)))
- (cons (car first) (dictree--unwrap-data (cdr first)))))
+ (cons (car first) (dictree--cell-data (cdr first)))))
(defun dictree-stack-empty-p (dictree-stack)
@@ -1624,7 +1743,8 @@ Returns nil if the stack is empty."
;; Advanced queries
(defun dictree--query (query-type dict arg
- &optional rank-function maxnum reverse no-cache filter)
+ &optional
+ rank-function maxnum reverse no-cache filter)
;; Return results of QUERY-TYPE (currently, only 'complete is implemented)
;; on DICT. If RANK-FUNCTION is non-nil, return results ordered accordingly.
@@ -1704,7 +1824,8 @@ Returns nil if the stack is empty."
(defun dictree--do-query (query-type dict arg
- &optional rank-function maxnum reverse filter)
+ &optional
+ rank-function maxnum reverse filter)
;; Return first MAXNUM results of running QUERY-TYPE on DICT that satisfy
;; FILTER, ordered according to RANK-FUNCTION (defaulting to "lexical"
;; order).
@@ -1757,7 +1878,8 @@ Returns nil if the stack is empty."
(defun dictree-complete (dict prefix
&optional
- rank-function maxnum reverse no-cache filter)
+ rank-function maxnum reverse no-cache filter
+ strip-data)
"Return an alist containing all completions of sequence PREFIX
from dictionary DICT, along with their associated data, sorted
according to RANK-FUNCTION (defaulting to \"lexical\" order, i.e. the
@@ -1776,6 +1898,16 @@ with the data from a different dictionary. If you want
to combine
identical keys, use a meta-dictionary; see
`dictree-meta-dict-create'.)
+If optional argument RANK-FUNCTION is any non-nil value that is
+not a function, the completions are sorted according to the
+dictionary's rank-function (see `dictree-create'). Any non-nil
+value that *is* a function over-rides this. In that case,
+RANK-FUNCTION should accept two arguments, both cons cells. The
+car of each contains a sequence from the trie (of the same type
+as PREFIX), the cdr contains its associated data. The
+RANK-FUNCTION should return non-nil if first argument is ranked
+strictly higher than the second, nil otherwise.
+
The optional integer argument MAXNUM limits the results to the
first MAXNUM completions.
@@ -1789,23 +1921,38 @@ arguments: the completion, and its associated data. If
the filter
function returns nil, the completion is not included in the
results, and doesn't count towards MAXNUM.
-If optional argument RANK-FUNCTION is any non-nil value that is
-not a function, the completions are sorted according to the
-dictionary's rank-function (see `dictree-create'). Any non-nil
-value that *is* a function over-rides this. In that case,
-RANK-FUNCTION should accept two arguments, both cons cells. The
-car of each contains a sequence from the trie (of the same type
-as PREFIX), the cdr contains its associated data. The
-RANK-FUNCTION should return non-nil if first argument is ranked
-strictly higher than the second, nil otherwise."
+If STRIP-DATA is non-nil, a list of completions is
+returned (rather than an alist), without the data."
;; run completion query
- (dictree--query
- 'complete dict prefix
- (when rank-function
- (if (functionp rank-function)
- rank-function
- (dictree-rank-function (if (listp dict) (car dict) dict))))
- maxnum reverse no-cache filter))
+ (let ((completions
+ (dictree--query
+ 'complete dict prefix
+ (when rank-function
+ (if (functionp rank-function)
+ rank-function
+ (dictree-rank-function (if (listp dict) (car dict) dict))))
+ maxnum reverse no-cache filter)))
+ (if strip-data
+ (mapcar 'car completions)
+ completions)))
+
+
+
+(defun dictree-collection-function (dict string predicate all)
+ "Function for use in `try-completion', `all-completions',
+and `completing-read'. To complete from dictionary DICT, use the
+following as the COLLECTION argument of any of those functions:
+
+ (lambda (string predicate all)
+ (dictree-collection-function dict string predicate all))
+
+Note that PREDICATE will be called with two arguments: the
+completion, and its associated data."
+ (let ((completions
+ (dictree-complete dict string nil nil nil nil predicate t)))
+ (if all
+ completions
+ (try-completion "" completions))))
@@ -1855,11 +2002,8 @@ faster. However, only the uncompiled version is portable
between
different Emacs versions.
If optional argument COMPILATION is the symbol 'compiled, only
-the uncompiled version will be created, whereas if it is the
-symbol 'uncompiled, only the uncompiled version will be created.
-
-Interactivley, DICT and FILENAME are read from the minibuffer,
-and OVERWRITE is the prefix argument."
+the compiled version will be created, whereas if it is the symbol
+'uncompiled, only the uncompiled version will be created."
(let (dictname buff tmpfile)
;; add .el(c) extension to the filename if not already there
@@ -1880,8 +2024,8 @@ and OVERWRITE is the prefix argument."
(set-buffer buff)
;; call the appropriate write function to write the dictionary code
(if (dictree--meta-dict-p dict)
- (dictree-write-meta-dict-code dict dictname)
- (dictree-write-dict-code dict dictname))
+ (dictree--write-meta-dict-code dict dictname)
+ (dictree--write-dict-code dict dictname))
(save-buffer)
(kill-buffer buff))
@@ -2037,201 +2181,83 @@ NOT be saved even if its autosave flag is set."
-;; ----------------------------------------------------------------
-;; Dumping and restoring contents
-
-(defun dictree-populate-from-file (dict file)
- "Populate dictionary DICT from the key list in file FILE.
-
-Each line of the file should contain a key, either a string
-\(delimeted by \"\), a vector or a list. (Use the escape sequence
-\\\" to include a \" in a string.) If a line does not contain a
-key, it is silently ignored. The keys should ideally be sorted
-\"lexically\", as defined by the dictionary's comparison-function
-\(see `dictree-create'\).
-
-Each line can optionally include data and meta-data to be
-associated with the key, in that order, and separated from each
-other and the key by whitespace.
-
-
-Technicalities:
-
-The key, data and meta-data are read as lisp expressions using
-`read', and are read from the middle outwards, i.e. first the
-middle key is read, then the key directly after it, then the key
-directly before it, then the one two lines after the middle, and
-so on. Assuming the keys in the file are sorted \"lexically\",
-this helps produce a reasonably efficient dictionary structure."
-
- (save-excursion
- (let ((buff (generate-new-buffer " *dictree-populate*")))
- ;; insert the key list into a temporary buffer
- (set-buffer buff)
- (insert-file-contents file)
-
- ;; insert the keys starting from the median to ensure a reasonably
- ;; well-balanced tree
- (let* ((lines (count-lines (point-min) (point-max)))
- (midpt (+ (/ lines 2) (mod lines 2)))
- entry)
- ;; insert the median key and set the dictionary's modified flag
- (dictree-goto-line midpt)
- (when (setq entry (dictree-read-line))
- (dictree-insert dict (car entry) (nth 1 entry))
- (dictree-set-meta-data dict (car entry) (nth 2 entry)))
- (message "Inserting keys in %s...(1 of %d)"
- (dictree-name dict) lines)
- ;; insert keys successively further away from the median in both
- ;; directions
- (dotimes (i (1- midpt))
- (dictree-goto-line (+ midpt i 1))
- (when (setq entry (dictree-read-line))
- (dictree-insert dict (car entry) (nth 1 entry))
- (dictree-set-meta-data dict (car entry) (nth 2 entry)))
- (when (= 49 (mod i 50))
- (message "Inserting keys in %s...(%d of %d)"
- (dictree-name dict) (+ (* 2 i) 2) lines))
- (dictree-goto-line (- midpt i 1))
- (when (setq entry (dictree-read-line))
- (dictree-insert dict (car entry) (nth 1 entry))
- (dictree-set-meta-data dict (car entry) (nth 2 entry))))
-
- ;; if file contains an even number of keys, we still have to add
- ;; the last one
- (when (= 0 (mod lines 2))
- (dictree-goto-line lines)
- (when (setq entry (dictree-read-line))
- (dictree-insert dict (car entry) (nth 1 entry))
- (dictree-set-meta-data dict (car entry) (nth 2 entry))))
- (message "Inserting keys in %s...done" (dictree-name dict)))
-
- (kill-buffer buff))))
-
-
-
-;;; FIXME: doesn't fail gracefully if file has invalid format
-(defun dictree-read-line ()
- "Return a cons containing the key and data \(if any, otherwise
-nil\) at the current line of the current buffer. Returns nil if
-line is in wrong format."
- (save-excursion
- (let (key data meta-data)
- ;; search for text between quotes "", ignoring escaped quotes \"
- (beginning-of-line)
- (setq key (read (current-buffer)))
- ;; if there is anything after the quoted text, use it as data
- (if (eq (line-end-position) (point))
- (list key)
- (setq data (read (current-buffer)))
- (if (eq (line-end-position) (point))
- (list key data)
- (setq meta-data (read (current-buffer)))
- ;; return the key and data
- (list key data meta-data))))))
-
-
-
-(defun dictree-dump-to-buffer (dict &optional buffer type)
- "Dump keys and their associated data
-from dictionary DICT to BUFFER, in the same format as that used
-by `dictree-populate-from-file'. If BUFFER exists, data will be
-appended to the end of it. Otherwise, a new buffer will be
-created. If BUFFER is omitted, the current buffer is used.
-
-TYPE determines the type of sequence to use to represent the
-keys, and should be one of 'string, 'vector or 'list. The default
-is 'vector.
-
-Note that if the data does not have a read syntax, the dumped
-data can not be used to recreate the dictionary using
-`dictree-populate-from-file'."
-
- ;; select the buffer, creating it if necessary
- (if buffer
- (setq buffer (get-buffer-create buffer))
- (setq buffer (current-buffer)))
- (set-buffer buffer)
-
- ;; move point to end of buffer and make sure it's at start of new line
- (goto-char (point-max))
- (unless (= (point) (line-beginning-position))
- (insert "\n"))
-
- ;; dump keys
- (message "Dumping keys from %s to %s..."
- (dictree-name dict) (buffer-name buffer))
- (let ((count 0) (dictsize (dictree-size dict)))
- (message "Dumping keys from %s to %s...(key 1 of %d)"
- (dictree-name dict) (buffer-name buffer) dictsize)
-
- ;; map dump function over dictionary
- (dictree--mapc
- (lambda (key data metadata)
- (when (= 99 (mod count 100))
- (message "Dumping keys from %s to %s...(key %d of %d)"
- (dictree-name dict) (buffer-name buffer)
- (1+ count) dictsize))
- (insert (prin1-to-string key))
- (let (data)
- (when data (insert " " (prin1-to-string data)))
- (when metadata (insert " " (prin1-to-string metadata)))
- (insert "\n"))
- (setq count (1+ count)))
- dict type) ; dictree-mapc target
-
- (message "Dumping keys from %s to %s...done"
- (dictree-name dict) (buffer-name buffer)))
- (switch-to-buffer buffer))
-
-
-
-(defun dictree-dump-to-file (dict filename &optional type overwrite)
- "Dump keys and their associated data
-from dictionary DICT to a text file FILENAME, in the same format
-as that used by `dictree-populate-from-file'. Prompts to overwrite
-FILENAME if it already exists, unless OVERWRITE is non-nil.
-
-TYPE determines the type of sequence to use to represent the
-keys, and should be one of 'string, 'vector or 'list. The default
-is 'vector.
-
-Note that if the data does not have a read syntax, the dumped
-data can not be used to recreate the dictionary using
-`dictree-populate-from-file'."
-
- ;; check if file exists, and prompt to overwrite it if necessary
- (if (and (file-exists-p filename)
- (not overwrite)
- (not (y-or-n-p
- (format "File %s already exists. Overwrite? "
- filename))))
- (message "Key dump cancelled")
-
- (let (buff)
- ;; create temporary buffer, dump keys to it, and save to FILENAME
- (setq buff (generate-new-buffer filename))
- (save-window-excursion
- (dictree-dump-to-buffer dict buff type)
- (write-file filename))
- (kill-buffer buff))))
-
-
-
-(defun dictree-write-dict-code (dict dictname)
- "Write code for normal dictionary DICT to current buffer,
-giving it the name DICTNAME."
-
- (let (hashcode
- tmpdict
- lookup-alist
- complete-alist
- complete-ranked-alist)
+(defun dictree--write-dict-code (dict dictname)
+ ;; Write code for normal dictionary DICT to current buffer, giving it the
+ ;; name DICTNAME.
+ (let (hashcode tmpdict tmptrie
+ lookup-alist complete-alist complete-ranked-alist)
+
+ ;; --- convert trie data ---
+ ;; if dictionary doesn't use any custom save functions, write dictionary's
+ ;; trie directly as is
+ (setq tmptrie (dictree--trie dict))
+ ;; otherwise, create a temporary trie and populate it with the converted
+ ;; contents of the dictionary's trie
+ (when (or (dictree--data-savefun dict) (dictree--plist-savefun dict))
+ (setq tmptrie
+ (trie-create-custom
+ (trie-comparison-function tmptrie)
+ :createfun (trie--createfun tmptrie)
+ :insertfun (trie--insertfun tmptrie)
+ :deletefun (trie--deletefun tmptrie)
+ :lookupfun (trie--lookupfun tmptrie)
+ :mapfun (trie--mapfun tmptrie)
+ :emptyfun (trie--emptyfun tmptrie)
+ :stack-createfun (trie--stack-createfun tmptrie)
+ :stack-popfun (trie--stack-popfun tmptrie)
+ :stack-emptyfun (trie--stack-emptyfun tmptrie)))
+ (trie-mapc
+ (lambda (key cell)
+ (trie-insert tmptrie key
+ (dictree--cell-create
+ (funcall (or (dictree--data-savefun dict) 'identity)
+ (dictree--cell-data cell))
+ (funcall (or (dictree--plist-savefun dict) 'identity)
+ (dictree--cell-plist cell)))))
+ (dictree--trie dict)))
+ ;; generate code to convert contents of trie back to original form
+ (cond
+ ;; convert both data and plist
+ ((and (dictree--data-loadfun dict) (dictree--plist-loadfun dict))
+ (setq hashcode
+ (concat
+ hashcode
+ "(trie-map\n"
+ " (lambda (key cell)\n"
+ " (dictree--cell-create\n"
+ " (funcall (dictree--data-loadfun " dictname ")\n"
+ " (dictree--cell-data cell))\n"
+ " (funcall (dictree--plist-loadfun " dictname ")\n"
+ " (dictree--cell-plist cell))))\n"
+ " (dictree--trie " dictname "))\n")))
+ ;; convert only data
+ ((dictree--data-loadfun dict)
+ (setq hashcode
+ (concat
+ hashcode
+ "(trie-map\n"
+ " (lambda (key cell)\n"
+ " (dictree--cell-create\n"
+ " (funcall (dictree--data-loadfun " dictname ")\n"
+ " (dictree--cell-data cell))\n"
+ " (dictree--cell-plist cell)))\n"
+ " (dictree--trie " dictname "))\n")))
+ ;; convert only plist
+ ((dictree--plist-loadfun dict)
+ (setq hashcode
+ (concat
+ hashcode
+ "(trie-map\n"
+ " (lambda (key cell)\n"
+ " (dictree--cell-create\n"
+ " (dictree--cell-data cell)\n"
+ " (funcall (dictree--plist-loadfun " dictname ")\n"
+ " (dictree--cell-plist cell))))\n"
+ " (dictree--trie " dictname "))\n"))))
- ;; dump caches to alists as necessary and generate code to reonstruct the
- ;; hash tables from the alists
- ;; create the lookup alist, if necessary
+ ;; --- convert hash tables to alists ---
+ ;; convert lookup cache hash table to alist, if it exists
(when (dictree--lookup-cache-threshold dict)
(maphash
(lambda (key val)
@@ -2259,10 +2285,11 @@ giving it the name DICTNAME."
" (dictree--cache-maxnum (cdr entry)))\n"
" lookup-cache))\n"
" (dictree--lookup-cache " dictname "))\n"
- " (setf (dictree--lookup-cache " dictname ") lookup-cache))\n"
+ " (setf (dictree--lookup-cache " dictname ")\n"
+ " lookup-cache))\n"
)))
- ;; create the completion alist, if necessary
+ ;; convert completion cache hash table to alist, if it exists
(when (dictree--complete-cache-threshold dict)
(maphash
(lambda (key val)
@@ -2291,10 +2318,11 @@ giving it the name DICTNAME."
" (dictree--cache-maxnum (cdr entry)))\n"
" complete-cache))\n"
" (dictree--complete-cache " dictname "))\n"
- " (setf (dictree--complete-cache " dictname ") complete-cache))\n"
+ " (setf (dictree--complete-cache " dictname ")\n"
+ " complete-cache))\n"
)))
- ;; create the ordered completion alist, if necessary
+ ;; convert ranked completion cache hash table to alist, if it exists
(when (dictree--complete-ranked-cache-threshold dict)
(maphash
(lambda (key val)
@@ -2308,8 +2336,7 @@ giving it the name DICTNAME."
(setq hashcode
(concat
hashcode
- "(let ((complete-ranked-cache"
- "(make-hash-table :test 'equal))\n"
+ "(let ((complete-ranked-cache (make-hash-table :test 'equal))\n"
" (trie (dictree--trie " dictname ")))\n"
" (mapc\n"
" (lambda (entry)\n"
@@ -2323,10 +2350,12 @@ giving it the name DICTNAME."
" (dictree--cache-maxnum (cdr entry)))\n"
" complete-ranked-cache))\n"
" (dictree--complete-ranked-cache " dictname "))\n"
- " (setf (dictree--complete-ranked-cache " dictname ")"
- " complete-ranked-cache))\n"
+ " (setf (dictree--complete-ranked-cache " dictname ")\n"
+ " complete-ranked-cache))\n"
)))
+
+ ;; --- write to file ---
;; generate the structure to save
(setq tmpdict (dictree-create))
(setf (dictree--name tmpdict) dictname)
@@ -2356,7 +2385,13 @@ giving it the name DICTNAME."
(setf (dictree--complete-ranked-cache tmpdict) complete-ranked-alist)
(setf (dictree--complete-ranked-cache-threshold tmpdict)
(dictree--complete-ranked-cache-threshold dict))
- (setf (dictree--trie tmpdict) (dictree--trie dict))
+ (setf (dictree--trie tmpdict) tmptrie)
+ (setf (dictree--key-savefun tmpdict) (dictree--key-savefun dict))
+ (setf (dictree--key-loadfun tmpdict) (dictree--key-loadfun dict))
+ (setf (dictree--data-savefun tmpdict) (dictree--data-savefun dict))
+ (setf (dictree--data-loadfun tmpdict) (dictree--data-loadfun dict))
+ (setf (dictree--plist-savefun tmpdict) (dictree--plist-savefun dict))
+ (setf (dictree--plist-loadfun tmpdict) (dictree--plist-loadfun dict))
(setf (dictree--meta-dict-list tmpdict) nil)
;; write lisp code that generates the dictionary object
@@ -2365,16 +2400,16 @@ giving it the name DICTNAME."
(insert "(defvar " dictname " nil \"Dictionary " dictname ".\")\n")
(insert "(setq " dictname " '" (prin1-to-string tmpdict) ")\n")
(insert hashcode)
- (insert "(setf (dictree-filename " dictname ")"
- " (locate-library \"" dictname "\"))\n")
- (insert "(unless (memq " dictname " dictree-loaded-list)"
- " (push " dictname " dictree-loaded-list))\n")
- (insert "(provide '" dictname ")\n")))
+ (insert "(setf (dictree-filename " dictname ")\n"
+ " (locate-library \"" dictname "\"))\n")
+ (insert "(unless (memq " dictname " dictree-loaded-list)\n"
+ " (push " dictname " dictree-loaded-list))\n")
+ (insert "(provide '" dictname ")\n")))
-(defun dictree-write-meta-dict-code (dict dictname)
+(defun dictree--write-meta-dict-code (dict dictname)
"Write code for meta-dictionary DICT to current buffer,
giving it the name DICTNAME."
@@ -2485,6 +2520,220 @@ giving it the name DICTNAME."
;; ----------------------------------------------------------------
+;; Dumping and restoring contents
+
+(defun dictree-populate-from-file (dict file)
+ "Populate dictionary DICT from the key list in file FILE.
+
+Each line of the file should contain a key, either a string
+\(delimeted by \"\), a vector or a list. (Use the escape sequence
+\\\" to include a \" in a string.) If a line does not contain a
+key, it is silently ignored. The keys should ideally be sorted
+\"lexically\", as defined by the dictionary's comparison-function
+\(see `dictree-create'\).
+
+Each line can optionally include data and meta-data to be
+associated with the key, in that order, and separated from each
+other and the key by whitespace.
+
+
+Technicalities:
+
+The key, data and property list are read as lisp expressions
+using `read', and are read from the middle outwards, i.e. first
+the middle key is read, then the key directly after it, then the
+key directly before it, then the one two lines after the middle,
+then the one two lines before, and so on. Assuming the keys in
+the file are sorted \"lexically\", for some types of dictionary
+this can help produce an efficient data-structure."
+
+ (save-excursion
+ (let ((buff (generate-new-buffer " *dictree-populate*")))
+ ;; insert the key list into a temporary buffer
+ (set-buffer buff)
+ (insert-file-contents file)
+
+ ;; insert the keys starting from the median to ensure a reasonably
+ ;; well-balanced tree
+ (let* ((lines (count-lines (point-min) (point-max)))
+ (midpt (+ (/ lines 2) (mod lines 2)))
+ entry)
+ ;; insert the median key and set the dictionary's modified flag
+ (dictree-goto-line midpt)
+ (when (setq entry
+ (condition-case nil
+ (dictree--read-line dict)
+ (error (error "Error reading line %d of %s"
+ midpt file))))
+ (dictree-insert dict (car entry) (nth 1 entry))
+ (setf (dictree--cell-plist (dictree--lookup dict (car entry) nil))
+ (nth 2 entry)))
+ (message "Inserting keys in %s...(1 of %d)"
+ (dictree-name dict) lines)
+ ;; insert keys successively further away from the median in both
+ ;; directions
+ (dotimes (i (1- midpt))
+ (dictree-goto-line (+ midpt i 1))
+ (when (setq entry
+ (condition-case nil
+ (dictree--read-line dict)
+ (error (error "Error reading line %d of %s"
+ (+ midpt i 1) file))))
+ (dictree-insert dict (car entry) (nth 1 entry))
+ (setf (dictree--cell-plist (dictree--lookup dict (car entry) nil))
+ (nth 2 entry)))
+ (when (= 49 (mod i 50))
+ (message "Inserting keys in %s...(%d of %d)"
+ (dictree-name dict) (+ (* 2 i) 2) lines))
+ (dictree-goto-line (- midpt i 1))
+ (when (setq entry
+ (condition-case nil
+ (dictree--read-line dict)
+ (error (error "Error reading line %d of %s"
+ (- midpt i 1) file))))
+ (dictree-insert dict (car entry) (nth 1 entry))
+ (setf (dictree--cell-plist (dictree--lookup dict (car entry) nil))
+ (nth 2 entry))))
+
+ ;; if file contains an even number of keys, we still have to add
+ ;; the last one
+ (when (= 0 (mod lines 2))
+ (dictree-goto-line lines)
+ (when (setq entry
+ (condition-case nil
+ (dictree--read-line dict)
+ (error (error "Error reading line %d of %s"
+ lines file))))
+ (dictree-insert dict (car entry) (nth 1 entry))
+ (setf (dictree--cell-plist (dictree--lookup dict (car entry) nil))
+ (nth 2 entry))))
+ (message "Inserting keys in %s...done" (dictree-name dict)))
+
+ (kill-buffer buff))))
+
+
+
+(defun dictree--read-line (dict)
+ ;; Return a list containing the key, data (if any, otherwise nil) and
+ ;; property list (ditto) at the current line of the current buffer, for
+ ;; dictionary DICT.
+ (save-excursion
+ (let (key data plist)
+ ;; read key
+ (beginning-of-line)
+ (setq key (read (current-buffer)))
+ (when (dictree--key-loadfun dict)
+ (setq key (funcall (dictree--key-loadfun dict) key)))
+ ;; if there's anything after the key, use it as data
+ (if (eq (line-end-position) (point))
+ (list key)
+ (setq data (read (current-buffer)))
+ (when (dictree--data-loadfun dict)
+ (setq data (funcall (dictree--data-loadfun dict) data)))
+ (if (eq (line-end-position) (point))
+ (list key data)
+ ;; if there's anything after the data, use is as the property list
+ (setq plist (read (current-buffer)))
+ (when (dictree--plist-loadfun dict)
+ (funcall (dictree--plist-loadfun dict) plist))
+ ;; return the key and data
+ (list key data plist))))))
+
+
+
+(defun dictree-dump-to-buffer (dict &optional buffer type)
+ "Dump keys and their associated data
+from dictionary DICT to BUFFER, in the same format as that used
+by `dictree-populate-from-file'. If BUFFER exists, data will be
+appended to the end of it. Otherwise, a new buffer will be
+created. If BUFFER is omitted, the current buffer is used.
+
+TYPE determines the type of sequence to use to represent the
+keys, and should be one of 'string, 'vector or 'list. The default
+is 'vector.
+
+Note that if the data does not have a read syntax, the dumped
+data can not be used to recreate the dictionary using
+`dictree-populate-from-file'."
+
+ ;; select the buffer, creating it if necessary
+ (if buffer
+ (setq buffer (get-buffer-create buffer))
+ (setq buffer (current-buffer)))
+ (set-buffer buffer)
+
+ ;; move point to end of buffer and make sure it's at start of new line
+ (goto-char (point-max))
+ (unless (= (point) (line-beginning-position))
+ (insert "\n"))
+
+ ;; dump keys
+ (message "Dumping keys from %s to %s..."
+ (dictree-name dict) (buffer-name buffer))
+ (let ((count 0) (dictsize (dictree-size dict)))
+ (message "Dumping keys from %s to %s...(key 1 of %d)"
+ (dictree-name dict) (buffer-name buffer) dictsize)
+
+ ;; map dump function over dictionary
+ (dictree--mapc
+ (lambda (key data plist)
+ (when (= 99 (mod count 100))
+ (message "Dumping keys from %s to %s...(key %d of %d)"
+ (dictree-name dict) (buffer-name buffer)
+ (1+ count) dictsize))
+ (insert (prin1-to-string
+ (funcall (or (dictree--key-savefun dict) 'identity) key)))
+ (when (setq data
+ (funcall (or (dictree--data-savefun dict) 'identity) data))
+ (insert " " (prin1-to-string data)))
+ (when (setq plist
+ (funcall (or (dictree--plist-savefun dict) 'identity) plist))
+ (unless data (insert " nil"))
+ (insert " " (prin1-to-string plist)))
+ (insert "\n")
+ (setq count (1+ count)))
+ dict type) ; dictree-mapc target
+
+ (message "Dumping keys from %s to %s...done"
+ (dictree-name dict) (buffer-name buffer)))
+ (switch-to-buffer buffer))
+
+
+
+(defun dictree-dump-to-file (dict filename &optional type overwrite)
+ "Dump keys and their associated data
+from dictionary DICT to a text file FILENAME, in the same format
+as that used by `dictree-populate-from-file'. Prompts to overwrite
+FILENAME if it already exists, unless OVERWRITE is non-nil.
+
+TYPE determines the type of sequence to use to represent the
+keys, and should be one of 'string, 'vector or 'list. The default
+is 'vector.
+
+Note that if the data does not have a read syntax, the dumped
+data can not be used to recreate the dictionary using
+`dictree-populate-from-file'."
+
+ ;; check if file exists, and prompt to overwrite it if necessary
+ (if (and (file-exists-p filename)
+ (not overwrite)
+ (not (y-or-n-p
+ (format "File %s already exists. Overwrite? "
+ filename))))
+ (message "Key dump cancelled")
+
+ (let (buff)
+ ;; create temporary buffer, dump keys to it, and save to FILENAME
+ (setq buff (generate-new-buffer filename))
+ (save-window-excursion
+ (dictree-dump-to-buffer dict buff type)
+ (write-file filename))
+ (kill-buffer buff))))
+
+
+
+
+;; ----------------------------------------------------------------
;; Minibuffer completion
(defvar dictree-history nil
