1 ;;; dict-tree.el --- Dictionary data structure
3 ;; Copyright (C) 2004-2012 Free Software Foundation, Inc
5 ;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
7 ;; Keywords: extensions, matching, data structures
8 ;; trie, tree, dictionary, completion, regexp
9 ;; Package-Requires: ((trie "0.2.5") (tNFA "0.1.1") (heap "0.3"))
10 ;; URL: http://www.dr-qubit.org/emacs.php
12 ;; This file is part of Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify it under
15 ;; the terms of the GNU General Public License as published by the Free
16 ;; Software Foundation, either version 3 of the License, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
21 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
24 ;; You should have received a copy of the GNU General Public License along
25 ;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 ;; A dictionary is used to store strings, along with arbitrary data associated
31 ;; with each string. As well as basic data insertion, manipulation and
32 ;; retrieval, a dictionary can perform prefix searches on those strings,
33 ;; retrieving all strings with a given prefix in either alphabetical or any
34 ;; other order (see the `dictree-complete' and `dictree-complete-ordered'
35 ;; functions), and is able to cache results in order to speed up those
36 ;; searches. The package also provides persistent storage of the data
37 ;; structures to files.
39 ;; You create a dictionary using `dictree-create', add entries to it using
40 ;; `dictree-insert', lookup entries using `dictree-lookup', find completions
41 ;; of sequences using `dictree-complete', find completions and sort them in
42 ;; any order you speficy using `dictree-complete-ordered', map over it using
43 ;; `dictree-map' and `dictree-mapcar', save it to a file using `dictree-save'
44 ;; or `dictree-write', and load from file it using `dictree-load'. Various
45 ;; other useful functions are also provided.
47 ;; This package uses the trie package trie.el. the tagged NFA package tNFA.el,
48 ;; and the heap package heap.el.
53 (eval-when-compile (require 'cl))
60 ;;; ================================================================
61 ;;; Replacements for CL and Elisp functions
63 ;; copied from cl-extra.el
64 (defun dictree--subseq (seq start &optional end)
65 "Return the subsequence of SEQ from START to END.
66 If END is omitted, it defaults to the length of the sequence.
67 If START or END is negative, it counts from the end."
68 (if (stringp seq) (substring seq start end)
70 (and end (< end 0) (setq end (+ end (setq len (length seq)))))
72 (setq start (+ start (or len (setq len (length seq))))))
74 (if (> start 0) (setq seq (nthcdr start seq)))
77 (while (>= (setq end (1- end)) start)
82 (or end (setq end (or len (length seq))))
83 (let ((res (make-vector (max (- end start) 0) nil))
86 (aset res i (aref seq start))
87 (setq i (1+ i) start (1+ start)))
92 ;; `goto-line' without messing around with mark and messages
93 ;; Note: This is a bug in simple.el. There's clearly a place for
94 ;; non-interactive calls to goto-line from Lisp code, and there's
95 ;; no warning against doing this in the documentation. Yet
96 ;; goto-line *always* calls push-mark, which usually *shouldn't*
97 ;; be invoked by Lisp programs, as its docstring warns.
98 (defmacro dictree--goto-line (line)
99 "Goto line LINE, counting from line 1 at beginning of buffer."
102 (if (eq selective-display t)
103 (re-search-forward "[\n\C-m]" nil 'end (1- ,line))
104 (forward-line (1- ,line)))))
108 ;;; ====================================================================
109 ;;; Internal functions and variables for use in the dictionary package
111 (defvar dictree-loaded-list nil
112 "Stores list of loaded dictionaries.")
115 ;; ----------------------------------------------------------------
116 ;; Dictionary data cell structures
118 ;; Note: It would be more elegant to use a defstruct for the data cells,
119 ;; but the problem is that the resulting setf in
120 ;; `dictree--wrap-insfun' won't get expanded into the cell-data
121 ;; accessor function at compile-time because it's burried inside a
122 ;; backquote construct. Not only is it inelegant to have to expand
123 ;; macros at run-time whenever `dictree--wrap-insfun' is called,
124 ;; but it also requires the 'cl-macs package to be loaded at
125 ;; run-time rather than just at compile-time. We could use
126 ;; `lexical-let' instead, but it doesn't seem worth it here.
128 ;; wrap data in a cons cell
129 (defalias 'dictree--cell-create 'cons) ; INTERNAL USE ONLY
131 ;; get data component from data cons cell
132 (defalias 'dictree--cell-data 'car) ; INTERNAL USE ONLY
134 ;; get property list component from data cons cell
135 (defalias 'dictree--cell-plist 'cdr) ; INTERNAL USE ONLY
137 ;; set data component of data cons cell
138 (defalias 'dictree--cell-set-data 'setcar) ; INTERNAL USE ONLY
140 ;; set property list component of data cons cell
141 (defalias 'dictree--cell-set-plist 'setcdr) ; INTERNAL USE ONLY
143 ;; define setf methods so we can use setf abstraction wherever possible
144 (defsetf dictree--cell-data dictree--cell-set-data)
145 (defsetf dictree--cell-plist dictree--cell-set-plist)
148 ;; ----------------------------------------------------------------
149 ;; Dictionary cache entry structures
151 ;; Note: We *could* us a defstruct for the cache entries, but for
152 ;; something this simple it doesn't seem worth it, especially
153 ;; given that we're using the defalias approach anyway for the
154 ;; data cells (above).
156 ;; Construct and return a completion cache entry
157 (defalias 'dictree--cache-create 'cons) ; INTERNAL USE ONLY
159 ;; Return the completions list for cache entry CACHE
160 (defalias 'dictree--cache-results 'car) ; INTERNAL USE ONLY
162 ;; Return the max number of completions returned for cache entry CACHE
163 (defalias 'dictree--cache-maxnum 'cdr) ; INTERNAL USE ONLY
165 ;; Set the completions list for cache entry CACHE
166 (defalias 'dictree--cache-set-completions 'setcar) ; INTERNAL USE ONLY
168 ;; Set the completions list for cache entry CACHE
169 (defalias 'dictree--cache-set-maxnum 'setcdr) ; INTERNAL USE ONLY
172 ;; ----------------------------------------------------------------
173 ;; Wrapping functions
175 (defun dictree--wrap-insfun (insfun) ; INTERNAL USE ONLY
176 ;; return wrapped insfun to deal with data wrapping
178 (dictree--cell-set-data old (,insfun (dictree--cell-data new)
179 (dictree--cell-data old)))
182 (defun dictree--wrap-rankfun (rankfun) ; INTERNAL USE ONLY
183 ;; return wrapped rankfun to deal with data wrapping
185 (,rankfun (cons (car a) (dictree--cell-data (cdr a)))
186 (cons (car b) (dictree--cell-data (cdr b))))))
188 (defun dictree--wrap-combfun (combfun) ; INTERNAL USE ONLY
189 ;; return wrapped combfun to deal with data wrapping
190 `(lambda (cell1 cell2)
191 (cons (,combfun (dictree--cell-data cell1)
192 (dictree--cell-data cell2))
193 (append (dictree--cell-plist cell1)
194 (dictree--cell-plist cell2)))))
196 (defun dictree--wrap-filter (filter) ; INTERNAL USE ONLY
197 ;; return wrapped filter function to deal with data wrapping
198 `(lambda (key data) (,filter key (dictree--cell-data data))))
200 (defun dictree--wrap-resultfun (resultfun) ; INTERNAL USE ONLY
201 ;; return wrapped result function to deal with data wrapping
202 `(lambda (res) (,resultfun (car res) (dictree--cell-data (cdr res)))))
206 ;; ----------------------------------------------------------------
207 ;; The dictionary data structures
213 (:constructor dictree--create
217 (file-name-sans-extension
218 (file-name-nondirectory filename))))
221 (comparison-function '<)
222 (insert-function (lambda (a b) a))
223 (rank-function (lambda (a b) (> (cdr a) (cdr b))))
225 (cache-update-policy 'synchronize)
226 lookup-cache-threshold
227 complete-cache-threshold
228 complete-ranked-cache-threshold
229 regexp-cache-threshold
230 regexp-ranked-cache-threshold
231 key-savefun key-loadfun
232 data-savefun data-loadfun
233 plist-savefun plist-loadfun
237 (trie (trie-create comparison-function))
238 (insfun (dictree--wrap-insfun insert-function))
239 (rankfun (dictree--wrap-rankfun rank-function))
241 (if lookup-cache-threshold
242 (make-hash-table :test 'equal)
245 (if complete-cache-threshold
246 (make-hash-table :test 'equal)
248 (complete-ranked-cache
249 (if complete-ranked-cache-threshold
250 (make-hash-table :test 'equal)
253 (if regexp-cache-threshold
254 (make-hash-table :test 'equal)
257 (if regexp-ranked-cache-threshold
258 (make-hash-table :test 'equal)
262 (:constructor dictree--create-custom
266 (file-name-sans-extension
267 (file-name-nondirectory filename))))
270 (comparison-function '<)
271 (insert-function (lambda (a b) a))
272 (rank-function (lambda (a b) (> (cdr a) (cdr b))))
274 (cache-update-policy 'synchronize)
275 lookup-cache-threshold
276 complete-cache-threshold
277 complete-ranked-cache-threshold
278 regexp-cache-threshold
279 regexp-ranked-cache-threshold
280 key-savefun key-loadfun
281 data-savefun data-loadfun
282 plist-savefun plist-loadfun
284 createfun insertfun deletefun
285 lookupfun mapfun emptyfun
286 stack-createfun stack-popfun stack-emptyfun
287 transform-for-print transform-from-read
290 (trie (trie-create-custom
298 :stack-createfun stack-createfun
299 :stack-popfun stack-popfun
300 :stack-emptyfun stack-emptyfun
301 :transform-for-print transform-for-print
302 :transform-from-read transform-from-read))
303 (insfun (dictree--wrap-insfun insert-function))
304 (rankfun (dictree--wrap-rankfun rank-function))
306 (if lookup-cache-threshold
307 (make-hash-table :test 'equal)
310 (if complete-cache-threshold
311 (make-hash-table :test 'equal)
313 (complete-ranked-cache
314 (if complete-ranked-cache-threshold
315 (make-hash-table :test 'equal)
318 (if regexp-cache-threshold
319 (make-hash-table :test 'equal)
322 (if regexp-ranked-cache-threshold
323 (make-hash-table :test 'equal)
327 (:copier dictree--copy))
328 name filename autosave modified
329 comparison-function insert-function insfun rank-function rankfun
330 cache-policy cache-update-policy
331 lookup-cache lookup-cache-threshold
332 complete-cache complete-cache-threshold
333 complete-ranked-cache complete-ranked-cache-threshold
334 regexp-cache regexp-cache-threshold
335 regexp-ranked-cache regexp-ranked-cache-threshold
336 key-savefun key-loadfun
337 data-savefun data-loadfun
338 plist-savefun plist-loadfun
346 (:constructor dictree--meta-dict-create
350 (name (file-name-sans-extension
351 (file-name-nondirectory filename)))
354 (combine-function '+)
356 (cache-update-policy 'synchronize)
357 lookup-cache-threshold
358 complete-cache-threshold
359 complete-ranked-cache-threshold
360 regexp-cache-threshold
361 regexp-ranked-cache-threshold
367 ((dictree-p dic) dic)
368 ((symbolp dic) (eval dic))
369 (t (error "Invalid object in DICTIONARY-LIST"))))
371 (combfun (dictree--wrap-combfun combine-function))
373 (if lookup-cache-threshold
374 (make-hash-table :test 'equal)
377 (if complete-cache-threshold
378 (make-hash-table :test 'equal)
380 (complete-ranked-cache
381 (if complete-ranked-cache-threshold
382 (make-hash-table :test 'equal)
385 (if regexp-cache-threshold
386 (make-hash-table :test 'equal)
389 (if regexp-ranked-cache-threshold
390 (make-hash-table :test 'equal)
393 (:copier dictree--meta-dict-copy))
394 name filename autosave modified
395 combine-function combfun
396 cache-policy cache-update-policy
397 lookup-cache lookup-cache-threshold
398 complete-cache complete-cache-threshold
399 complete-ranked-cache complete-ranked-cache-threshold
400 regexp-cache regexp-cache-threshold
401 regexp-ranked-cache regexp-ranked-cache-threshold
402 dictlist meta-dict-list)
406 ;; ----------------------------------------------------------------
407 ;; Miscelaneous internal functions and macros
409 (defun dictree--trielist (dict)
410 ;; Return a list of all the tries on which DICT is based. If DICT is a
411 ;; meta-dict, this recursively descends the hierarchy, gathering all
412 ;; the tries from the base dictionaries.
414 (dictree--do-trielist dict)
417 (defun dictree--do-trielist (dict)
418 (declare (special accumulate))
419 (if (dictree-meta-dict-p dict)
420 (mapc 'dictree--do-trielist (dictree--meta-dict-dictlist dict))
421 (setq accumulate (cons (dictree--trie dict) accumulate))))
424 (defun dictree--merge (list1 list2 cmpfun &optional combfun maxnum)
425 ;; Destructively merge together sorted lists LIST1 and LIST2, sorting
426 ;; elements according to CMPFUN. For non-null MAXNUM, only the first
427 ;; MAXNUM are kept. For non-null COMBFUN, duplicate elements will be
428 ;; merged by passing the two elements as arguments to COMBFUN, and
429 ;; using the return value as the merged element.
430 (or (listp list1) (setq list1 (append list1 nil)))
431 (or (listp list2) (setq list2 (append list2 nil)))
434 ;; build up result list backwards
435 (while (and list1 list2 (or (null maxnum) (< (incf i) maxnum)))
436 ;; move smaller element to result list
437 (if (funcall cmpfun (car list1) (car list2))
438 (push (pop list1) res)
439 (if (funcall cmpfun (car list2) (car list1))
440 (push (pop list2) res)
441 ;; if elements are equal, merge them for non-null COMBFUN
443 (push (funcall combfun (pop list1) (pop list2))
445 ;; otherwise, add both to result list, in order
446 (push (pop list1) res)
447 (push (pop list2) res)))))
449 ;; return result if we already have MAXNUM entries
450 (if (and maxnum (= i maxnum))
452 ;; otherwise, return result plus enough leftover entries to make
453 ;; up MAXNUM (only one of list1 or list2 will be non-nil)
456 (and (setq tmp (nthcdr (- maxnum i 1) list1))
458 (and (setq tmp (nthcdr (- maxnum i 1) list2))
460 (nconc (nreverse res) list1 list2)))
464 ;; (defun dictree--merge-sort (list sortfun &optional combfun)
465 ;; ;; Destructively sort LIST according to SORTFUN, combining
466 ;; ;; identical elements using COMBFUN if supplied.
467 ;; (dictree--do-merge-sort list (/ (length list) 2) sortfun combfun))
470 ;; (defun dictree--do-merge-sort (list1 len sortfun combfun)
471 ;; ;; Merge sort LIST according to SORTFUN, combining identical
472 ;; ;; elements using COMBFUN.
473 ;; (let* ((p (nthcdr (1- len) list1))
477 ;; (dictree--do-merge-sort list1 (/ len 2) sortfun combfun)
478 ;; (dictree--do-merge-sort list2 (/ len 2) sortfun combfun)
479 ;; sortfun combfun)))
484 ;;; ================================================================
485 ;;; The (mostly) public functions which operate on dictionaries
490 name filename autosave unlisted
491 comparison-function insert-function rank-function
492 cache-policy cache-update-policy
493 lookup-cache-threshold
494 complete-cache-threshold
495 complete-ranked-cache-threshold
496 regexp-cache-threshold
497 regexp-ranked-cache-threshold
498 key-savefun key-loadfun
499 data-savefun data-loadfun
500 plist-savefun plist-loadfun
502 "Create an empty dictionary and return it.
504 If NAME is supplied, the dictionary is stored in the variable
505 NAME. Defaults to FILENAME stripped of directory and
506 extension. (Regardless of the value of NAME, the dictionary will
507 be stored in the default variable name when it is reloaded from
510 FILENAME supplies a directory and file name to use when saving
511 the dictionary. If the AUTOSAVE flag is non-nil, then the
512 dictionary will automatically be saved to this file when it is
513 unloaded or when exiting Emacs.
515 If UNLISTED is non-nil, the dictionary will not be added to the
516 list of loaded dictionaries. Note that this disables autosaving.
518 COMPARE-FUNCTION sets the function used to compare elements of
519 the keys. It should take two arguments, A and B, both of the type
520 contained by the sequences used as keys \(e.g. if the keys will
521 be strings, the function will be passed two characters\). It
522 should return t if the first is \"less than\" the
523 second. Defaults to `<'.
525 INSERT-FUNCTION sets the function used to insert data into the
526 dictionary. It should take two arguments: the new data, and the
527 data already in the dictionary, and should return the data to
528 insert. Defaults to replacing any existing data with the new
531 RANK-FUNCTION sets the function used to rank the results of
532 `dictree-complete'. It should take two arguments, each a cons
533 whose car is a dictree key (a sequence) and whose cdr is the data
534 associated with that key. It should return non-nil if the first
535 argument is \"better\" than the second, nil otherwise. It
536 defaults to \"lexical\" comparison of the keys, ignoring the data
537 \(which is not very useful, since an unranked `dictree-complete'
538 query already does this much more efficiently\).
540 CACHE-POLICY should be a symbol ('time, 'length, or 'both), which
541 determines which query operations are cached. The 'time setting
542 caches queries that take longer (in seconds) than the
543 corresponding CACHE-THRESHOLD value. The 'length setting caches
544 lookups of key sequences that are longer than
545 LOOKUP-CACHE-THRESHOLD value (since those are likely to be the
546 slower ones), and caches completions of prefixes that are shorter
547 than the corresponding CACHE-THRESHOLD (since those are likely to
548 be the slower ones in that case). The setting 'both requires both
549 conditions to be satisfied simultaneously. In this case,
550 CACHE-THRESHOLD must be a plist with properties :time and :length
551 specifying the corresponding cache thresholds.
553 CACHE-UPDATE-POLICY should be a symbol ('synchronize or 'delete),
554 which determines how the caches are updated when data is inserted
555 or deleted. The former updates tainted cache entries, which makes
556 queries faster but insertion and deletion slower, whereas the
557 latter deletes any tainted cache entries, which makes queries
558 slower but insertion and deletion faster.
560 The CACHE-THRESHOLD settings set the threshold for caching the
561 corresponding dictionary query (lookup, completion, ranked
562 completion). The meaning of these values depends on the setting
563 of CACHE-POLICY (see above).
565 All CACHE-THRESHOLD's default to nil. The values nil and t are
566 special. If a CACHE-THRESHOLD is set to nil, no caching is done
567 for that type of query. If it is t, everything is cached for that
568 type of query \(similar behaviour can be obtained by setting the
569 CACHE-THRESHOLD to 0, but it is better to use t\).
571 KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN are functions used to
572 convert keys, data and property lists into lisp objects that have
573 a valid read syntax, for writing to file. DATA-SAVEFUN and
574 PLIST-SAVEFUN are used when saving the dictionary (see
575 `dictree-save' and `dictree-write'), and all three functions are
576 used when dumping the contents of the dictionary \(see
577 `dictree-dump-to-buffer' and `dictree-dump-to-file'\).
578 KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN should each accept
579 one argument: a key, data or property list from DICT,
580 respectively. They should return a lisp object which has a valid
581 read syntax. When defining these functions, be careful not to
582 accidentally modify the lisp object in the dictionary; usually,
583 you will need to make a copy before converting it.
585 KEY-LOADFUN, DATA-LOADFUN and PLIST-LOADFUN are used to convert
586 keys, data and property lists back again when loading a
587 dictionary (only DATA-LOADFUN and PLIST-LOADFUN, see
588 `dictree-save' and `dictree-write') or populating it from a
589 file (all three, see `dictree-populate-from-file'). They should
590 accept one argument: a lisp object of the type produced by the
591 corresponding SAVEFUN, and return a lisp object to use in the
594 TRIE-TYPE sets the type of trie to use as the underlying data
595 structure. See `trie-create' for details."
597 ;; sadly, passing null values over-rides the defaults in the defstruct
598 ;; dictree--create, so we have to explicitly set the defaults again
600 (or name (setq name (and filename (file-name-sans-extension
601 (file-name-nondirectory filename)))))
602 (or comparison-function (setq comparison-function '<))
603 (or insert-function (setq insert-function (lambda (a b) a)))
604 (or rank-function (setq rank-function (lambda (a b) (> (cdr a) (cdr b)))))
605 (or cache-policy (setq cache-policy 'time))
606 (or cache-update-policy (setq cache-update-policy 'synchronize))
610 filename (when name (symbol-name name)) autosave unlisted
611 comparison-function insert-function rank-function
612 cache-policy cache-update-policy
613 lookup-cache-threshold
614 complete-cache-threshold
615 complete-ranked-cache-threshold
616 regexp-cache-threshold
617 regexp-ranked-cache-threshold
618 key-savefun key-loadfun
619 data-savefun data-loadfun
620 plist-savefun plist-loadfun
622 ;; store dictionary in variable NAME
623 (when name (set name dict))
624 ;; add it to loaded dictionary list, unless it's unlisted
625 (unless (or (null name) unlisted)
626 (push dict dictree-loaded-list))
631 (defalias 'dictree-create 'make-dictree)
635 (defun* make-dictree-custom
637 name filename autosave unlisted
639 comparison-function insert-function rank-function
640 cache-policy cache-update-policy
641 lookup-cache-threshold
642 complete-cache-threshold
643 complete-ranked-cache-threshold
644 regexp-cache-threshold
645 regexp-ranked-cache-threshold
646 key-savefun key-loadfun
647 data-savefun data-loadfun
648 plist-savefun plist-loadfun
649 createfun insertfun deletefun lookupfun mapfun emptyfun
650 stack-createfun stack-popfun stack-emptyfun
651 transform-for-print transform-from-read)
652 "Create an empty dictionary and return it.
654 The NAME through PLIST-LOADFUN arguments are as for
655 `dictree-create' (which see).
657 The remaining arguments control the type of trie to use as the
658 underlying data structure. See `trie-create' for details."
660 ;; sadly, passing null values over-rides the defaults in the defstruct
661 ;; dictree--create, so we have to explicitly set the defaults again
663 (or name (setq name (and filename (file-name-sans-extension
664 (file-name-nondirectory filename)))))
665 (or comparison-function (setq comparison-function '<))
666 (or insert-function (setq insert-function (lambda (a b) a)))
667 (or rank-function (setq rank-function (lambda (a b) (< (cdr a) (cdr b)))))
668 (or cache-policy (setq cache-policy 'time))
669 (or cache-update-policy (setq cache-update-policy 'synchronize))
672 (dictree--create-custom
673 filename (when name (symbol-name name)) autosave unlisted
674 comparison-function insert-function rank-function
675 cache-policy cache-update-policy
676 lookup-cache-threshold
677 complete-cache-threshold
678 complete-ranked-cache-threshold
679 regexp-cache-threshold
680 regexp-ranked-cache-threshold
681 key-savefun key-loadfun
682 data-savefun data-loadfun
683 plist-savefun plist-loadfun
690 :stack-createfun stack-createfun
691 :stack-popfun stack-popfun
692 :stack-emptyfun stack-emptyfun
693 :transform-for-print transform-for-print
694 :transform-from-read transform-from-read)))
695 ;; store dictionary in variable NAME
696 (when name (set name dict))
697 ;; add it to loaded dictionary list, unless it's unlisted
698 (unless (or (null name) unlisted)
699 (push dict dictree-loaded-list))
704 (defalias 'dictree-create-custom 'make-dictree-custom)
708 (defun make-dictree-meta-dict
711 name filename autosave unlisted
713 cache-policy cache-update-policy
714 lookup-cache-threshold
715 complete-cache-threshold
716 complete-ranked-cache-threshold
717 regexp-cache-threshold
718 regexp-ranked-cache-threshold)
719 "Create a meta-dictionary based on the list of dictionaries
722 COMBINE-FUNCTION is used to combine data from different
723 dictionaries. It is passed two pieces of data, each an
724 association of the same key, but in different dictionaries. It
725 should return a combined datum.
727 The other arguments are as for `dictree-create'. Note that
728 caching is only possible if NAME is supplied, otherwise the
729 cache-threshold arguments are ignored."
731 ;; sadly, passing null values over-rides the defaults in the defstruct
732 ;; `dictree--create', so we have to explicitly set the defaults again
734 (or name (setq name (and filename
735 (file-name-sans-extension
736 (file-name-nondirectory filename)))))
737 (or combine-function (setq combine-function '+))
738 (or cache-policy (setq cache-policy 'time))
739 (or cache-update-policy (setq cache-update-policy 'synchronize))
742 (dictree--meta-dict-create
743 dictionary-list filename (when name (symbol-name name))
746 cache-policy cache-update-policy
747 (when name lookup-cache-threshold)
748 (when name complete-cache-threshold)
749 (when name complete-ranked-cache-threshold)
750 (when name regexp-cache-threshold)
751 (when name regexp-ranked-cache-threshold))
753 ;; store dictionary in variable NAME
754 (when name (set name dict))
755 ;; add it to loaded dictionary list, unless it's unlisted
756 (unless (or (null name) unlisted)
757 (push dict dictree-loaded-list))
758 ;; update meta-dict-list cells of constituent dictionaries
759 (unless (or (null name)
760 (not (or lookup-cache-threshold
761 complete-cache-threshold
762 complete-ranked-cache-threshold
763 regexp-cache-threshold
764 regexp-ranked-cache-threshold)))
767 (if (symbolp dic) (setq dic (eval dic)))
768 (setf (dictree--meta-dict-list dic)
769 (cons dict (dictree--meta-dict-list dic))))
773 (defalias 'dictree-create-meta-dict 'make-dictree-meta-dict)
777 (defun dictree-p (obj)
778 "Return t if OBJ is a dictionary tree, nil otherwise."
779 (or (dictree--p obj) (dictree--meta-dict-p obj)))
782 (defalias 'dictree-meta-dict-p 'dictree--meta-dict-p
783 "Return t if argument is a meta-dictionary, nil otherwise.")
785 (defun dictree-empty-p (dict)
786 "Return t if the dictionary DICT is empty, nil otherwise."
787 (if (dictree--meta-dict-p dict)
790 (if (not (dictree-empty-p dic)) (throw 'nonempty t)))
791 (dictree--meta-dict-dictlist dict)))
792 (trie-empty (dictree--trie dict))))
794 (defsubst dictree-autosave (dict)
795 "Return dictionary's autosave flag."
796 (if (dictree--meta-dict-p dict)
797 (dictree--meta-dict-autosave dict)
798 (dictree--autosave dict)))
800 (defsetf dictree-autosave (dict) (val)
801 ;; setf method for dictionary autosave flag
802 `(if (dictree--meta-dict-p ,dict)
803 (setf (dictree--meta-dict-autosave ,dict) ,val)
804 (setf (dictree--autosave ,dict) ,val)))
806 (defsubst dictree-modified (dict)
807 "Return dictionary's modified flag."
808 (if (dictree--meta-dict-p dict)
809 (dictree--meta-dict-modified dict)
810 (dictree--modified dict)))
812 (defsetf dictree-modified (dict) (val)
813 ;; setf method for dictionary modified flag
814 `(if (dictree--meta-dict-p ,dict)
815 (setf (dictree--meta-dict-modified ,dict) ,val)
816 (setf (dictree--modified ,dict) ,val)))
818 (defsubst dictree-name (dict)
819 "Return dictionary DICT's name."
820 (if (dictree--meta-dict-p dict)
821 (dictree--meta-dict-name dict)
822 (dictree--name dict)))
824 (defsetf dictree-name (dict) (name)
825 ;; setf method for dictionary name
826 `(if (dictree--meta-dict-p ,dict)
827 (setf (dictree--meta-dict-name ,dict) ,name)
828 (setf (dictree--name ,dict) ,name)))
830 (defsubst dictree-filename (dict)
831 "Return dictionary DICT's associated file name."
832 (if (dictree--meta-dict-p dict)
833 (dictree--meta-dict-filename dict)
834 (dictree--filename dict)))
836 (defsetf dictree-filename (dict) (filename)
837 ;; setf method for dictionary filename
838 `(if (dictree--meta-dict-p ,dict)
839 (setf (dictree--meta-dict-filename ,dict) ,filename)
840 (setf (dictree--filename ,dict) ,filename)))
842 (defun dictree-comparison-function (dict)
843 "Return dictionary DICT's comparison function."
844 (if (dictree--meta-dict-p dict)
845 (dictree-comparison-function
846 (car (dictree--meta-dict-dictlist dict)))
847 (dictree--comparison-function dict)))
849 (defalias 'dictree-insert-function 'dictree--insert-function
850 "Return the insertion function for dictionary DICT.")
852 (defun dictree-rank-function (dict)
853 "Return the rank function for dictionary DICT"
854 (if (dictree--meta-dict-p dict)
855 (dictree-rank-function (car (dictree--meta-dict-dictlist dict)))
856 (dictree--rank-function dict)))
858 (defun dictree-rankfun (dict)
859 ;; Return the rank function for dictionary DICT
860 (if (dictree--meta-dict-p dict)
861 (dictree-rankfun (car (dictree--meta-dict-dictlist dict)))
862 (dictree--rankfun dict)))
864 (defalias 'dictree-meta-dict-combine-function
865 'dictree--meta-dict-combine-function
866 "Return the combine function for meta-dictionary DICT.")
868 (defalias 'dictree-meta-dict-dictlist
869 'dictree--meta-dict-dictlist
870 "Return the list of constituent dictionaries
871 for meta-dictionary DICT.")
873 (defsubst dictree-cache-policy (dict)
874 "Return the cache policy for dictionary DICT."
875 (if (dictree--meta-dict-p dict)
876 (dictree--meta-dict-cache-policy dict)
877 (dictree--cache-policy dict)))
879 (defsubst dictree-cache-update-policy (dict)
880 "Return the cache update policy for dictionary DICT."
881 (if (dictree--meta-dict-p dict)
882 (dictree--meta-dict-cache-update-policy dict)
883 (dictree--cache-update-policy dict)))
885 (defsubst dictree-lookup-cache-threshold (dict)
886 "Return the lookup cache threshold for dictionary DICT."
887 (if (dictree--meta-dict-p dict)
888 (dictree--meta-dict-lookup-cache-threshold dict)
889 (dictree--lookup-cache-threshold dict)))
891 (defsetf dictree-lookup-cache-threshold (dict) (param)
892 ;; setf method for lookup cache threshold
893 `(if (dictree--meta-dict-p ,dict)
894 (setf (dictree--meta-dict-lookup-cache-threshold ,dict)
896 (setf (dictree--lookup-cache-threshold ,dict)
899 (defsubst dictree-lookup-cache (dict)
900 ;; Return the lookup cache for dictionary DICT.
901 (if (dictree--meta-dict-p dict)
902 (dictree--meta-dict-lookup-cache dict)
903 (dictree--lookup-cache dict)))
905 (defsubst dictree-complete-cache-threshold (dict)
906 "Return the completion cache threshold for dictionary DICT."
907 (if (dictree--meta-dict-p dict)
908 (dictree--meta-dict-complete-cache-threshold dict)
909 (dictree--complete-cache-threshold dict)))
911 (defsetf dictree-complete-cache-threshold (dict) (param)
912 ;; setf method for completion cache threshold
913 `(if (dictree--meta-dict-p ,dict)
914 (setf (dictree--meta-dict-complete-cache-threshold ,dict)
916 (setf (dictree--complete-cache-threshold ,dict)
919 (defun dictree-complete-cache (dict)
920 ;; Return the completion cache for dictionary DICT.
921 (if (dictree--meta-dict-p dict)
922 (dictree--meta-dict-complete-cache dict)
923 (dictree--complete-cache dict)))
925 (defsubst dictree-complete-ranked-cache-threshold (dict)
926 "Return the ranked completion cache threshold for dictionary DICT."
927 (if (dictree--meta-dict-p dict)
928 (dictree--meta-dict-complete-ranked-cache-threshold dict)
929 (dictree--complete-ranked-cache-threshold dict)))
931 (defsetf dictree-complete-ranked-cache-threshold (dict) (param)
932 ;; setf method for ranked completion cache threshold
933 `(if (dictree--meta-dict-p ,dict)
934 (setf (dictree--meta-dict-complete-ranked-cache-threshold ,dict)
936 (setf (dictree--complete-ranked-cache-threshold ,dict)
939 (defun dictree-complete-ranked-cache (dict)
940 ;; Return the ranked completion cache for dictionary DICT.
941 (if (dictree--meta-dict-p dict)
942 (dictree--meta-dict-complete-ranked-cache dict)
943 (dictree--complete-ranked-cache dict)))
945 (defsubst dictree-regexp-cache-threshold (dict)
946 "Return the regexp cache threshold for dictionary DICT."
947 (if (dictree--meta-dict-p dict)
948 (dictree--meta-dict-regexp-cache-threshold dict)
949 (dictree--regexp-cache-threshold dict)))
951 (defsetf dictree-regexp-cache-threshold (dict) (param)
952 ;; setf method for regexp cache threshold
953 `(if (dictree--meta-dict-p ,dict)
954 (setf (dictree--meta-dict-regexp-cache-threshold ,dict)
956 (setf (dictree--regexp-cache-threshold ,dict)
959 (defun dictree-regexp-cache (dict)
960 ;; Return the regexp cache for dictionary DICT.
961 (if (dictree--meta-dict-p dict)
962 (dictree--meta-dict-regexp-cache dict)
963 (dictree--regexp-cache dict)))
965 (defsubst dictree-regexp-ranked-cache-threshold (dict)
966 "Return the ranked regexp cache threshold for dictionary DICT."
967 (if (dictree--meta-dict-p dict)
968 (dictree--meta-dict-regexp-ranked-cache-threshold dict)
969 (dictree--regexp-ranked-cache-threshold dict)))
971 (defsetf dictree-regexp-ranked-cache-threshold (dict) (param)
972 ;; setf method for ranked regexp cache threshold
973 `(if (dictree--meta-dict-p ,dict)
974 (setf (dictree--meta-dict-regexp-ranked-cache-threshold ,dict)
976 (setf (dictree--regexp-ranked-cache-threshold ,dict)
979 (defun dictree-regexp-ranked-cache (dict)
980 ;; Return the ranked regexp cache for dictionary DICT.
981 (if (dictree--meta-dict-p dict)
982 (dictree--meta-dict-regexp-ranked-cache dict)
983 (dictree--regexp-ranked-cache dict)))
987 ;; ----------------------------------------------------------------
988 ;; Inserting and deleting data
990 (defun dictree-insert (dict key &optional data insert-function)
991 "Insert KEY and DATA into dictionary DICT.
992 If KEY does not already exist, this creates it. How the data is
993 inserted depends on the dictionary's insertion function \(see
996 The optional INSERT-FUNCTION over-rides the dictionary's own
997 insertion function. If KEY already exists in DICT,
998 INSERT-FUNCTION is called with two arguments: the data DATA, and
999 the data associated with KEY in the dictionary. Its return value
1000 becomes the new association for KEY."
1002 ;; if dictionary is a meta-dictionary, insert key into all the
1003 ;; dictionaries it's based on
1004 (if (dictree--meta-dict-p dict)
1006 (dictree-insert dic key data insert-function))
1007 (dictree--meta-dict-dictlist dict))
1011 ;; set the dictionary's modified flag
1012 (setf (dictree-modified dict) t)
1013 ;; insert key in dictionary's ternary search tree
1016 (dictree--trie dict) key (dictree--cell-create data nil)
1017 (or (and insert-function
1018 (dictree--wrap-insfun insert-function))
1019 (dictree--insfun dict))))
1020 ;; update dictionary's caches
1021 (dictree--update-cache dict key newdata)
1022 ;; update cache's of any meta-dictionaries based on dict
1023 (mapc (lambda (dic) (dictree--update-cache dic key newdata))
1024 (dictree--meta-dict-list dict))
1026 ;; return the new data
1027 (dictree--cell-data newdata))))
1031 (defun dictree-delete (dict key &optional test)
1032 "Delete KEY from DICT.
1033 Returns non-nil if KEY was deleted, nil if KEY was not in DICT.
1035 If TEST is supplied, it should be a function that accepts three
1036 arguments: the key being deleted, its associated data, and its
1037 associated property list. The key will then only be deleted if
1038 TEST returns non-nil."
1040 (let ((dictree--delete-test test)
1043 ;; if DICT is a meta-dictionary, delete KEY from all dictionaries
1045 ((dictree--meta-dict-p dict)
1046 (dolist (dic (dictree--meta-dict-dictlist dict))
1047 (when (setq del (dictree-delete dic key))
1048 (setq deleted (cons del deleted))))
1049 (setf (dictree-modified dict) (and deleted t))
1050 (setq deleted (nreverse deleted)))
1055 (trie-delete (dictree--trie dict) key
1056 (when dictree--delete-test
1058 (funcall dictree--delete-test
1059 k (dictree--cell-data cell)
1060 (dictree--cell-plist cell))))))
1061 ;; if key was deleted, have to update the caches
1063 (dictree--update-cache dict key nil t)
1064 (setf (dictree-modified dict) t)
1065 ;; update cache's of any meta-dictionaries based on DICT
1067 (dictree--update-cache dic key nil t))
1068 (dictree--meta-dict-list dict)))))
1070 ;; return deleted key/data pair
1072 (cons (car deleted) (dictree--cell-data (cdr deleted))))))
1076 ;; ----------------------------------------------------------------
1079 (defun dictree--prefix-p (prefix str)
1080 "Return t if PREFIX is a prefix of STR, nil otherwise.
1082 PREFIX and STR can be any sequence type (string, vector, or
1083 list), but they must both be the same type. PREFIX can also be a
1084 list of sequences, in which case it returns t if any element of
1085 PREFIX is a prefix of STR."
1086 ;; wrap prefix in a list if necessary
1087 ;; FIXME: the test for a list of prefixes, below, will fail if the
1088 ;; PREFIX sequence is a list, and the elements of PREFIX are
1089 ;; themselves lists (there might be no easy way to fully fix
1091 (when (or (atom prefix)
1092 (and (listp prefix) (not (sequencep (car prefix)))))
1093 (setq prefix (list prefix)))
1096 (dolist (pfx prefix)
1097 (setq len (length pfx))
1098 (when (and (<= len (length str))
1099 (equal pfx (dictree--subseq str 0 len)))
1100 (throw 'is-prefix t))))))
1103 (defun dictree--above-cache-threshold-p
1104 (time length policy threshold &optional cache-long-keys)
1105 ;; Return t if query taking TIME seconds for a key of length LENGTH
1106 ;; should be cached according to the cache POLICY and
1107 ;; THRESHOLD. Otherwise, return nil. Optional argument CACHE-LONG-KEYS
1108 ;; means that keys of length longer than THRESHOLD are to be
1109 ;; cached. Default is keys of length shorter than THRESHOLD.
1111 (or (eq threshold t)
1112 (and (eq policy 'time) (>= time threshold))
1113 ;; note: we cache lookups of *longer* keys, because those are
1114 ;; likely to be slower ones
1115 (and (eq policy 'length)
1117 (>= length threshold) (<= length threshold)))
1118 (and (eq policy 'both)
1119 (or (>= time (plist-get threshold :time))
1121 (>= length (plist-get threshold :length))
1122 (<= length (plist-get threshold :length))))))))
1125 (defun dictree--update-cache (dict key newdata &optional deleted)
1126 ;; Synchronise dictionary DICT's caches, given that the data
1127 ;; associated with KEY has been changed to NEWDATA, or KEY has been
1128 ;; deleted if DELETED is non-nil (NEWDATA is ignored in that case)."
1129 (let (arg reverse cache cache-entry completions cmpl maxnum)
1131 ;; synchronise the lookup cache if dict is a meta-dictionary, since
1132 ;; it's not done automatically
1133 (when (and (dictree--meta-dict-p dict)
1134 (dictree--meta-dict-lookup-cache-threshold dict))
1135 (setq cache (dictree--lookup-cache dict))
1137 ;; if updating dirty cache entries...
1138 ((eq (dictree-cache-update-policy dict) 'synchronize)
1139 (when (gethash key cache)
1140 (if deleted (remhash key cache) (puthash key newdata cache))))
1141 ;; if deleting dirty cache entries...
1142 (t (remhash key cache))))
1144 ;; synchronize the completion cache, if it exists
1145 (when (dictree-complete-cache-threshold dict)
1146 (setq cache (dictree-complete-cache dict))
1147 ;; check every cache entry to see if it matches
1149 (lambda (cache-key cache-entry)
1150 (setq arg (car cache-key))
1151 (when (dictree--prefix-p arg key)
1152 (setq reverse (cdr cache-key))
1154 ;; if updating dirty cache entries...
1155 ((eq (dictree-cache-update-policy dict) 'synchronize)
1156 (dictree--synchronize-completion-cache
1157 dict cache-entry arg reverse key newdata deleted))
1158 ;; if deleting dirty cache entries...
1159 (t (remhash (cons arg reverse) cache)))))
1162 ;; synchronize the ranked completion cache, if it exists
1163 (when (dictree-complete-ranked-cache-threshold dict)
1164 (setq cache (dictree-complete-ranked-cache dict))
1165 ;; check every cache entry to see if it matches
1167 (lambda (cache-key cache-entry)
1168 (setq arg (car cache-key))
1169 (when (dictree--prefix-p arg key)
1170 (setq reverse (cdr cache-key))
1172 ;; if updating dirty cache entries...
1173 ((eq (dictree-cache-update-policy dict) 'synchronize)
1174 (dictree--synchronize-ranked-completion-cache
1175 dict cache-entry arg reverse key newdata deleted))
1176 ;; if deleting dirty cache entries...
1177 (t (remhash (cons arg reverse) cache)))))
1180 ;; synchronize the regexp cache, if it exists
1181 (when (dictree-regexp-cache-threshold dict)
1182 (setq cache (dictree--regexp-cache dict))
1183 ;; check every cache entry to see if it matches
1185 (lambda (cache-key cache-entry)
1186 (setq arg (car cache-key))
1187 (when (tNFA-regexp-match
1188 arg key :test (dictree--comparison-function dict))
1189 (setq reverse (cdr cache-key))
1191 ;; if updating dirty cache entries...
1192 ((eq (dictree-cache-update-policy dict) 'synchronize)
1193 (dictree--synchronize-regexp-cache
1194 dict cache-entry arg reverse key newdata deleted))
1195 ;; if deleting dirty cache entries...
1196 (t (remhash (cons arg reverse) cache)))))
1199 ;; synchronize the ranked regexp cache, if it exists
1200 (when (dictree-regexp-ranked-cache-threshold dict)
1201 (setq cache (dictree-regexp-ranked-cache dict))
1202 ;; have to check every cache entry to see if it matches
1204 (lambda (cache-key cache-entry)
1205 (setq arg (car cache-key))
1206 (when (tNFA-regexp-match
1207 arg key :test (dictree--comparison-function dict))
1208 (setq reverse (cdr cache-key))
1210 ;; if updating dirty cache entries...
1211 ((eq (dictree-cache-update-policy dict) 'synchronize)
1212 (dictree--synchronize-ranked-regexp-cache
1213 dict cache-entry arg reverse key newdata deleted))
1214 ;; if deleting dirty cache entries...
1215 (t (remhash (cons arg reverse) cache)))))
1221 (defun dictree--synchronize-completion-cache
1222 (dict cache-entry arg reverse key newdata deleted)
1223 ;; Synchronize DICT's completion CACHE-ENTRY for ARG and REVERSE, for
1224 ;; a KEY whose data was either updated to NEWDATA or DELETED.
1225 (let* ((completions (dictree--cache-results cache-entry))
1226 (maxnum (dictree--cache-maxnum cache-entry))
1227 (cmpl (assoc key completions)))
1230 ;; deleted and in cached result: remove cache entry and re-run the
1231 ;; same completion to update the cache
1233 (remhash (cons arg reverse) (dictree-complete-cache dict))
1234 (dictree-complete dict arg nil maxnum reverse))
1235 ;; modified and not in cached result: merge it into the completion
1236 ;; list, retaining only the first maxnum
1237 ((and (not deleted) (not cmpl))
1238 (dictree--cache-set-completions
1241 (list (cons key newdata)) completions
1243 (,(trie-construct-sortfun
1244 (dictree-comparison-function dict))
1246 (when (dictree--meta-dict-p dict)
1247 (dictree--meta-dict-combfun dict))
1249 ;; modified and in the cached result: update the associated data if
1250 ;; dict is a meta-dictionary (this is done automatically for a
1252 ((and (not deleted) cmpl (dictree--meta-dict-p dict))
1253 (setcdr cmpl newdata))
1254 ;; deleted and not in cached result: requires no action
1259 (defun dictree--synchronize-ranked-completion-cache
1260 (dict cache-entry arg reverse key newdata deleted)
1261 ;; Synchronize DICT's ranked completion CACHE-ENTRY for ARG and
1262 ;; REVERSE, for a KEY whose data was either updated to NEWDATA or
1264 (let* ((completions (dictree--cache-results cache-entry))
1265 (maxnum (dictree--cache-maxnum cache-entry))
1266 (cmpl (assoc key completions))
1267 (cache (dictree--complete-ranked-cache dict)))
1270 ;; deleted and in cached result: remove cache entry and re-run the
1271 ;; same query to update the cache
1273 (remhash (cons arg reverse) cache)
1274 (dictree-complete dict arg 'ranked maxnum reverse))
1275 ;; modified and not in cached result: merge it into the completion
1276 ;; list, retaining only the first maxnum
1277 ((and (not deleted) (not cmpl))
1278 (dictree--cache-set-completions
1281 (list (cons key newdata)) completions
1282 (dictree-rankfun dict)
1283 (when (dictree--meta-dict-p dict)
1284 (dictree--meta-dict-combfun dict))
1286 ;; modified and in the cached result: update the associated data if
1287 ;; dict is a meta-dictionary (this is done automatically for a
1288 ;; normal dict), re-sort, and if key is now at end of list re-run
1289 ;; the same query to update the cache
1290 ((and (not deleted) cmpl)
1291 (when (dictree--meta-dict-p dict) (setcdr cmpl newdata))
1292 (dictree--cache-set-completions
1293 cache-entry (sort completions (dictree-rankfun dict)))
1294 (when (equal key (car (last completions)))
1295 (remhash (cons arg reverse) cache)
1296 (dictree-complete dict arg 'ranked maxnum reverse)))
1297 ;; deleted and not in cached result: requires no action
1301 (defun dictree--synchronize-regexp-cache
1302 (dict cache-entry arg reverse key newdata deleted)
1303 ;; Synchronize DICT's completion CACHE-ENTRY for ARG and REVERSE, for
1304 ;; a KEY whose data was either updated to NEWDATA or DELETED.
1305 (let* ((completions (dictree--cache-results cache-entry))
1306 (maxnum (dictree--cache-maxnum cache-entry))
1309 (dolist (c completions)
1310 (if (and (listp (car c))
1311 (or (stringp (caar c))
1314 (when (equal key (caar c)) (throw 'found c))
1315 (when (equal key (car c)) (throw 'found c)))))))
1318 ;; deleted and in cached result: remove cache entry and re-run the
1319 ;; same completion to update the cache
1321 (remhash (cons arg reverse) (dictree-complete-cache dict))
1322 (dictree-regexp-search dict arg nil maxnum reverse))
1323 ;; modified and not in cached result: merge it into the completion
1324 ;; list, retaining only the first maxnum
1325 ((and (not deleted) (not cmpl))
1327 (set-match-data nil)
1328 (tNFA-regexp-match arg key
1329 :test (dictree--comparison-function dict))
1330 (when (setq group-data (nthcdr 2 (match-data)))
1331 (setq key (cons key group-data))))
1332 (dictree--cache-set-completions
1335 (list (cons key newdata)) completions
1337 (,(trie-construct-sortfun (dictree-comparison-function dict))
1338 ,(if group-data '(caar a) '(car a))
1339 ,(if group-data '(caar b) '(car b))))
1340 (when (dictree--meta-dict-p dict)
1341 (dictree--meta-dict-combfun dict))
1343 ;; modified and in the cached result: update the associated data if
1344 ;; dict is a meta-dictionary (this is done automatically for a
1346 ((and (not deleted) cmpl (dictree--meta-dict-p dict))
1347 (setcdr cmpl newdata))
1348 ;; deleted and not in cached result: requires no action
1353 (defun dictree--synchronize-ranked-regexp-cache
1354 (dict cache-entry arg reverse key newdata deleted)
1355 ;; Synchronize DICT's ranked regexp CACHE-ENTRY for ARG and REVERSE,
1356 ;; for a KEY whose data was either updated to NEWDATA or DELETED.
1357 (let ((completions (dictree--cache-results cache-entry))
1358 (maxnum (dictree--cache-maxnum cache-entry))
1359 (cache (dictree--regexp-ranked-cache dict))
1361 (setq group-data (and (listp (caar completions))
1362 (or (stringp (caar (car completions)))
1363 (vectorp (caar (car completions)))
1364 (listp (caar (car completions))))))
1367 (dolist (c completions)
1369 (when (equal key (caar c)) (throw 'found c))
1370 (when (equal key (car c)) (throw 'found c))))))
1373 ;; deleted and in cached result: remove cache entry and re-run the
1374 ;; same query to update the cache
1376 (remhash (cons arg reverse) cache)
1377 (dictree-regexp-search dict arg 'ranked maxnum reverse))
1378 ;; modified and not in cached result: merge it into the completion
1379 ;; list, retaining only the first maxnum
1380 ((and (not deleted) (not cmpl))
1382 (set-match-data nil)
1383 (tNFA-regexp-match arg key
1384 :test (dictree--comparison-function dict))
1385 (when (setq group-data (nthcdr 2 (match-data)))
1386 (setq key (cons key group-data))))
1387 (dictree--cache-set-completions
1390 (list (cons key newdata)) completions
1391 (dictree-rankfun dict)
1392 (when (dictree--meta-dict-p dict)
1393 (dictree--meta-dict-combfun dict))
1395 ;; modified and in the cached result: update the associated data if
1396 ;; dict is a meta-dictionary (this is done automatically for a
1397 ;; normal dict), re-sort, and if key is now at end of list re-run
1398 ;; the same query to update the cache
1399 ((and (not deleted) cmpl)
1400 (when (dictree--meta-dict-p dict) (setcdr cmpl newdata))
1401 (dictree--cache-set-completions
1406 (,(dictree-rankfun dict)
1407 (cons (caar a) (cdr a))
1408 (cons (caar b) (cdr b))))
1409 (dictree-rankfun dict))))
1410 (when (equal key (car (last completions)))
1411 (remhash (cons arg reverse) cache)
1412 (dictree-complete dict arg 'ranked maxnum reverse)))
1413 ;; deleted and not in cached result: requires no action
1417 (defun dictree-clear-caches (dict)
1418 "Clear all DICT's query caches."
1419 (interactive (list (read-dict "Dictionary: ")))
1420 (when (and (called-interactively-p 'any) (symbolp dict))
1421 (setq dict (eval dict)))
1422 (dolist (cachefun '(dictree-lookup-cache
1423 dictree-complete-cache
1424 dictree-complete-ranked-cache
1425 dictree-regexp-cache
1426 dictree-regexp-ranked-cache))
1427 (when (funcall cachefun dict)
1428 (clrhash (funcall cachefun dict))))
1429 (when (called-interactively-p 'interactive)
1430 (message "Cleared caches for dictionary %s" (dictree-name dict))))
1435 ;; ----------------------------------------------------------------
1438 (defun dictree-member (dict key &optional nilflag)
1439 "Return the data associated with KEY in dictionary DICT,
1440 or nil if KEY is not in the dictionary.
1442 Optional argument NILFLAG specifies a value to return instead of
1443 nil if KEY does not exist in TREE. This allows a non-existent KEY
1444 to be distinguished from an element with a null association. (See
1445 also `dictree-member-p' for testing existence alone.)"
1446 (let* ((data (dictree--lookup dict key nilflag)))
1447 (if (eq data nilflag)
1449 (dictree--cell-data data))))
1451 (defalias 'dictree-lookup 'dictree-member)
1453 (defun dictree-member-p (dict key)
1454 "Return t if KEY exists in DICT, nil otherwise."
1455 (let ((flag '(nil)))
1456 (not (eq flag (dictree-member dict key flag)))))
1459 (defun dictree--lookup (dict key nilflag)
1460 ;; Return association of KEY in DICT, or NILFLAG if KEY does not
1461 ;; exist. Does not do any data/meta-data unwrapping
1463 (let* ((flag '(nil))
1466 ;; if KEY is in the cache, then we're done
1467 (unless (and (dictree-lookup-cache dict)
1468 (setq data (gethash key (dictree--lookup-cache dict))))
1470 ;; otherwise, we have to look in the dictionary itself...
1472 ;; if DICT is a meta-dict, look in its constituent dictionaries
1473 ((dictree--meta-dict-p dict)
1474 (let (newdata (newflag '(nil)))
1475 ;; time the lookup for caching
1476 (setq time (float-time))
1477 ;; look in each constituent dictionary in turn
1478 (dolist (dic (dictree--meta-dict-dictlist dict))
1479 (setq newdata (dictree--lookup dic key newflag))
1480 ;; skip dictionary if it doesn't contain KEY
1481 (unless (eq newdata newflag)
1482 ;; if we haven't found KEY before, we have now!
1483 (if (eq data flag) (setq data newdata)
1484 ;; otherwise, combine the previous data with the new
1486 (setq data (funcall (dictree--meta-dict-combfun dict)
1488 (setq time (- (float-time) time))))
1490 ;; otherwise, DICT is a normal dictionary, so look in it's trie
1492 ;; time the lookup for caching
1493 (setq time (float-time))
1494 (setq data (trie-member (dictree--trie dict) key flag))
1495 (setq time (- (float-time) time))))
1497 ;; if lookup found something, and we're above the lookup
1498 ;; cache-threshold, cache the result
1499 (when (and (not (eq data flag))
1500 (dictree--above-cache-threshold-p
1501 time (length key) (dictree-cache-policy dict)
1502 (dictree-lookup-cache-threshold dict) 'long-keys))
1503 (setf (dictree-modified dict) t)
1504 (puthash key data (dictree-lookup-cache dict))))
1506 ;; return the desired data
1507 (if (eq data flag) nilflag data)))
1511 ;; ----------------------------------------------------------------
1512 ;; Getting and setting meta-data
1514 (defun dictree-put-property (dict key property value)
1515 "Set PROPERTY for KEY in dictionary DICT.
1516 PROPERTY should be a symbol. Returns VALUE if successful, nil if
1517 KEY was not found in DICT.
1519 Note that if DICT is a meta-dictionary, then this will set KEY's
1520 PROPERTY to VALUE in *all* its constituent dictionaries.
1522 Unlike the data associated with a key (cf. `dictree-insert'),
1523 properties are not included in the results of queries on the
1524 dictionary \(`dictree-lookup', `dictree-complete',
1525 `dictree-complete-ordered'\), nor do they affect the outcome of
1526 any of the queries. They merely serves to tag a key with some
1527 additional information, and can only be retrieved using
1528 `dictree-get-property'."
1530 ;; sort out arguments
1531 (and (symbolp dict) (setq dict (eval dict)))
1533 ;; set PROPERTY for KEY in all constituent dicts of a meta-dict
1534 ((dictree--meta-dict-p dict)
1535 (warn "Setting %s property for key %s in all constituent\
1536 dictionaries of meta-dicttionary %s" property key (dictree-name dict))
1537 (setf (dictree-modified dict) t)
1538 (let (dictree--put-property-ret)
1539 (mapc (lambda (dic k p v)
1540 (setq dictree--put-property-ret
1541 (or dictree--put-property-ret
1542 (dictree-put-property dic k p v))))
1543 (dictree--meta-dict-dictlist dict))
1544 ;; return VALUE if KEY was found in at least one constituent dict
1545 dictree--put-property-ret))
1546 (t ;; set PROPERTY for KEY in normal dict
1547 (let ((cell (trie-member (dictree--trie dict) key)))
1549 (setf (dictree-modified dict) t)
1550 (setf (dictree--cell-plist cell)
1551 (plist-put (dictree--cell-plist cell) property value))
1552 value))) ; return VALUE
1557 (defun dictree-delete-property (dict key property)
1558 "Delete PROPERTY from KEY in dictionary DICT.
1559 Returns the new property list for KEY, with PROPERTY deleted.
1561 Setting PROPERTY to nil using `dictree-put-property' is not quite
1562 the same thing as deleting it, since null property values can
1563 still be detected by supplying the optional argument to
1564 `dictree-get-propery' (which see).
1566 Note that if DICT is a meta-dictionary, then this will delete
1567 KEY's PROPERTY in *all* its constituent dictionaries."
1568 ;; sort out arguments
1569 (and (symbolp dict) (setq dict (eval dict)))
1571 ;; delete PROPERTY from KEY in all constituent dicts of a meta-dict
1572 ((dictree--meta-dict-p dict)
1573 (warn "Deleting %s property from key %s in all constituent\
1574 dictionaries of meta-dicttionary %s" property key (dictree-name dict))
1575 (setf (dictree-modified dict) t)
1576 (mapcar (lambda (dic k p) (dictree-delete-property dic k p))
1577 (dictree--meta-dict-dictlist dict)))
1578 (t ;; delete PROPERTY from KEY in normal dict
1579 (let* ((cell (trie-member (dictree--trie dict) key))
1584 (setq plist (dictree--cell-plist cell))
1586 (setf (dictree-modified dict) t)
1587 ;; delete property and value from plist
1588 (setcdr tail (cddr tail))
1589 (setq plist (delq property plist))
1590 (setf (dictree--cell-plist cell) plist))))
1595 (defun dictree-get-property (dict key property &optional nilflag)
1596 "Get the value of PROPERTY for KEY in dictionary DICT,
1597 or return nil if KEY is not in the dictionary.
1599 Optional argument NILFLAG specifies a value to return instead of
1600 nil if KEY does not exist in TREE. This allows a non-existent KEY
1601 to be distinguished from a key for which PROPERTY is not
1602 set. (See also `dictree-member-p' for testing existence alone.)"
1603 (let ((cell (dictree--lookup dict key nilflag)))
1604 (unless (eq cell nilflag)
1605 (plist-get (dictree--cell-plist cell) property))))
1610 ;; ----------------------------------------------------------------
1611 ;; Mapping functions
1613 (defun dictree-mapc (function dict &optional type reverse)
1614 "Apply FUNCTION to all entries in dictionary DICT,
1615 for side-effects only.
1617 FUNCTION will be passed two arguments: a key of type
1618 TYPE ('string, 'vector, or 'list, defaulting to 'vector) from the
1619 dictionary, and the data associated with that key. The dictionary
1620 entries will be traversed in \"lexical\" order, i.e. the order
1621 defined by the dictionary's comparison function (cf.
1624 If TYPE is 'string, it must be possible to apply the function
1625 `string' to the elements of sequences stored in DICT.
1627 FUNCTION is applied in ascending order, or descending order if
1630 Note: to avoid nasty dynamic scoping bugs, FUNCTION must *not*
1631 bind any variables with names commencing \"--\"."
1633 ;; "rename" FUNCTION to something hopefully unique to lessen the
1634 ;; likelihood of dynamic scoping bugs caused by a supplied function
1635 ;; binding a variable with the same name as one of the arguments
1636 (let ((--dictree-mapc--function function))
1638 (lambda (key data plist)
1639 (funcall --dictree-mapc--function key data))
1640 dict type reverse)))
1644 (defun dictree--mapc (function dict &optional type reverse)
1645 ;; Like `dictree-mapc', but FUNCTION is passed three arguments: the
1646 ;; key, the data, and the property list, instead of just key and data.
1648 ;; try to avoid dynamic binding bugs
1649 (let ((--dictree--mapc--function function))
1650 (if (dictree--meta-dict-p dict)
1651 ;; for a meta-dict, use a dictree-stack
1652 (let ((stack (dictree-stack dict))
1654 (while (setq entry (dictree--stack-pop stack))
1655 (funcall --dictree--mapc--function
1657 (dictree--cell-data (cdr entry))
1658 (dictree--cell-plist (cdr entry)))))
1659 ;; for a normal dictionary, map the function over its trie
1662 (funcall --dictree--mapc--function
1664 (dictree--cell-data cell)
1665 (dictree--cell-plist cell)))
1666 (dictree--trie dict)
1672 (defun dictree-mapf (function combinator dict &optional type reverse)
1673 "Apply FUNCTION to all entries in dictionary DICT,
1674 and combine the results using COMBINATOR.
1676 FUNCTION should take two arguments: a key sequence from the
1677 dictionary and its associated data.
1679 Optional argument TYPE (one of the symbols vector, lisp or
1680 string; defaults to vector) sets the type of sequence passed to
1681 FUNCTION. If TYPE is 'string, it must be possible to apply the
1682 function `string' to the individual elements of key sequences
1685 The FUNCTION will be applied and the results combined in
1686 asscending \"lexical\" order (i.e. the order defined by the
1687 dictionary's comparison function; cf. `dictree-create'), or
1688 descending order if REVERSE is non-nil.
1690 Note: to avoid nasty dynamic scoping bugs, FUNCTION and
1691 COMBINATOR must *not* bind any variables with names
1694 ;; try to avoid dynamic scoping bugs
1695 (let ((--dictree-mapf--function function)
1696 (--dictree-mapf--combinator combinator))
1698 ;; for a normal dictionary, map the function over its trie
1699 (if (not (dictree--meta-dict-p dict))
1702 (,--dictree-mapf--function key (dictree--cell-data data)))
1703 --dictree-mapf--combinator (dictree--trie dict) type reverse)
1705 ;; for a meta-dict, use a dictree-stack
1706 (let ((--dictree-mapf--stack (dictree-stack dict))
1707 --dictree-mapf--entry
1708 --dictree-mapf--accumulate)
1709 (while (setq --dictree-mapf--entry
1710 (dictree-stack-pop --dictree-mapf--stack))
1711 (setq --dictree-mapf--accumulate
1712 (funcall --dictree-mapf--combinator
1713 (funcall --dictree-mapf--function
1714 (car --dictree-mapf--entry)
1715 (cdr --dictree-mapf--entry))
1716 --dictree-mapf--accumulate)))
1717 --dictree-mapf--accumulate))))
1721 (defun dictree-mapcar (function dict &optional type reverse)
1722 "Apply FUNCTION to all entries in dictionary DICT,
1723 and make a list of the results.
1725 FUNCTION should take two arguments: a key sequence from the
1726 dictionary and its associated data.
1728 Optional argument TYPE (one of the symbols vector, lisp or
1729 string; defaults to vector) sets the type of sequence passed to
1730 FUNCTION. If TYPE is 'string, it must be possible to apply the
1731 function `string' to the individual elements of key sequences
1734 The FUNCTION will be applied and the results combined in
1735 asscending \"lexical\" order \(i.e. the order defined by the
1736 dictionary's comparison function; cf. `dictree-create'\), or
1737 descending order if REVERSE is non-nil.
1739 Note that if you don't care about the order in which FUNCTION is
1740 applied, just that the resulting list is in the correct order,
1743 (trie-mapf function 'cons trie type (not reverse))
1747 Note: to avoid nasty dynamic scoping bugs, FUNCTION must *not*
1748 bind any variables with names commencing \"--\"."
1749 (nreverse (dictree-mapf function 'cons dict type)))
1753 (defun dictree-size (dict)
1754 "Return the number of entries in dictionary DICT.
1755 Interactively, DICT is read from the mini-buffer."
1756 (interactive (list (read-dict "Dictionary: ")))
1757 (when (and (called-interactively-p 'any) (symbolp dict))
1758 (setq dict (eval dict)))
1760 (dictree-mapc (lambda (&rest dummy) (incf count)) dict)
1761 (when (called-interactively-p 'interactive)
1762 (message "Dictionary %s contains %d entries"
1763 (dictree--name dict) count))
1768 ;; ----------------------------------------------------------------
1769 ;; Using dictrees as stacks
1771 ;; A dictree--meta-stack is the meta-dict version of a dictree-stack
1772 ;; (the ordinary version is just a single trie-stack). It consists of a
1773 ;; heap of trie-stacks for its constituent tries, where the heap order
1774 ;; is the usual lexical order over the keys at the top of the
1778 (dictree--meta-stack
1780 (:constructor dictree--meta-stack-create
1781 (dict &optional (type 'vector) reverse
1783 (combfun (dictree--meta-dict-combfun dict))
1784 (sortfun (trie-construct-sortfun
1785 (dictree-comparison-function dict)))
1787 (dictree--construct-meta-stack-heapfun sortfun)
1788 (length (dictree--trielist dict))))
1793 heap (trie-stack dic type reverse)))
1794 (dictree--trielist dict)))))
1795 (:constructor dictree--complete-meta-stack-create
1796 (dict prefix &optional reverse
1798 (combfun (dictree--meta-dict-combfun dict))
1799 (sortfun (trie-construct-sortfun
1800 (dictree-comparison-function dict)))
1802 (dictree--construct-meta-stack-heapfun
1804 (length (dictree--trielist dict))))
1808 (let ((stack (trie-complete-stack
1809 trie prefix reverse)))
1810 (unless (trie-stack-empty-p stack)
1811 (heap-add heap stack))))
1812 (dictree--trielist dict)))))
1813 (:constructor dictree--regexp-meta-stack-create
1814 (dict regexp &optional reverse
1816 (combfun (dictree--meta-dict-combfun dict))
1817 (sortfun (trie-construct-sortfun
1818 (dictree-comparison-function dict)))
1820 (dictree--construct-meta-stack-heapfun
1822 (length (dictree--trielist dict))))
1826 (let ((stack (trie-regexp-stack
1827 trie regexp reverse)))
1828 (unless (trie-stack-empty-p stack)
1829 (heap-add heap stack))))
1830 (dictree--trielist dict)))))
1832 combfun sortfun heap pushed)
1836 (defun dictree--construct-meta-stack-heapfun (sortfun &optional reverse)
1837 ;; Wrap SORTFUN, which sorts keys, so it can act on
1838 ;; dictree--meta-stack elements.
1840 `(lambda (b a) (,sortfun (car (dictree-stack-first a))
1841 (car (dictree-stack-first b))))
1842 `(lambda (a b) (,sortfun (car (dictree-stack-first a))
1843 (car (dictree-stack-first b))))))
1846 (defun dictree-stack (dict &optional type reverse)
1847 "Create an object that allows DICT to be accessed as a stack.
1849 The stack is sorted in \"lexical\" order, i.e. the order defined
1850 by the DICT's comparison function, or in reverse order if REVERSE
1851 is non-nil. Calling `dictree-stack-pop' pops the top element (a
1852 key and its associated data) from the stack.
1854 Optional argument TYPE (one of the symbols vector, lisp or
1855 string) sets the type of sequence used for the keys.
1857 Note that any modification to DICT *immediately* invalidates all
1858 dictree-stacks created before the modification (in particular,
1859 calling `dictree-stack-pop' will give unpredictable results).
1861 Operations on dictree-stacks are significantly more efficient
1862 than constructing a real stack from the dictionary and using
1863 standard stack functions. As such, they can be useful in
1864 implementing efficient algorithms on dictionaries. However, in
1865 cases where mapping functions `dictree-mapc', `dictree-mapcar' or
1866 `dictree-mapf' would be sufficient, it is better to use one of
1868 (if (dictree--meta-dict-p dict)
1869 (dictree--meta-stack-create dict type reverse)
1870 (trie-stack (dictree--trie dict) type reverse)))
1873 (defun dictree-complete-stack (dict prefix &optional reverse)
1874 "Return an object that allows completions of PREFIX to be accessed
1875 as if they were a stack.
1877 The stack is sorted in \"lexical\" order, i.e. the order defined
1878 by DICT's comparison function, or in reverse order if REVERSE is
1879 non-nil. Calling `dictree-stack-pop' pops the top element (a key
1880 and its associated data) from the stack.
1882 PREFIX must be a sequence (vector, list or string) that forms the
1883 initial part of a TRIE key. (If PREFIX is a string, it must be
1884 possible to apply `string' to individual elements of TRIE keys.)
1885 The completions returned in the alist will be sequences of the
1886 same type as KEY. If PREFIX is a list of sequences, completions
1887 of all sequences in the list are included in the stack. All
1888 sequences in the list must be of the same type.
1890 Note that any modification to DICT *immediately* invalidates all
1891 trie-stacks created before the modification (in particular,
1892 calling `dictree-stack-pop' will give unpredictable results).
1894 Operations on dictree-stacks are significantly more efficient
1895 than constructing a real stack from completions of PREFIX in DICT
1896 and using standard stack functions. As such, they can be useful
1897 in implementing efficient algorithms on tries. However, in cases
1898 where `dictree-complete' or `dictree-complete-ordered' is
1899 sufficient, it is better to use one of those instead."
1900 (if (dictree--meta-dict-p dict)
1901 (dictree--complete-meta-stack-create dict prefix reverse)
1902 (trie-complete-stack (dictree--trie dict) prefix reverse)))
1905 (defun dictree-regexp-stack (dict regexp &optional reverse)
1906 "Return an object that allows REGEXP matches to be accessed
1907 as if they were a stack.
1909 The stack is sorted in \"lexical\" order, i.e. the order defined
1910 by DICT's comparison function, or in reverse order if REVERSE is
1911 non-nil. Calling `dictree-stack-pop' pops the top element (a key
1912 and its associated data) from the stack.
1914 REGEXP is a regular expression, but it need not necessarily be a
1915 string. It must be a sequence (vector, list of string) whose
1916 elements are either elements of the same type as elements of the
1917 trie keys (which behave as literals in the regexp), or any of the
1918 usual regexp special characters and backslash constructs. If
1919 REGEXP is a string, it must be possible to apply `string' to
1920 individual elements of the keys stored in the trie. The matches
1921 returned in the alist will be sequences of the same type as KEY.
1923 Back-references and non-greedy postfix operators are *not*
1924 supported, and the matches are always anchored, so `$' and `^'
1925 lose their special meanings.
1927 If the regexp contains any non-shy grouping constructs, subgroup
1928 match data is included in the results. In this case, the car of
1929 each match is no longer just a key. Instead, it is a list whose
1930 first element is the matching key, and whose remaining elements
1931 are cons cells whose cars and cdrs give the start and end indices
1932 of the elements that matched the corresponding groups, in order.
1934 Note that any modification to DICT *immediately* invalidates all
1935 trie-stacks created before the modification (in particular,
1936 calling `dictree-stack-pop' will give unpredictable results).
1938 Operations on dictree-stacks are significantly more efficient
1939 than constructing a real stack from completions of PREFIX in DICT
1940 and using standard stack functions. As such, they can be useful
1941 in implementing efficient algorithms on tries. However, in cases
1942 where `dictree-complete' or `dictree-complete-ordered' is
1943 sufficient, it is better to use one of those instead."
1944 (if (dictree--meta-dict-p dict)
1945 (dictree--regexp-meta-stack-create dict regexp reverse)
1946 (trie-regexp-stack (dictree--trie dict) regexp reverse)))
1949 (defun dictree-stack-pop (dictree-stack)
1950 "Pop the first element from the DICTREE-STACK.
1951 Returns nil if the stack is empty."
1953 ;; if elements have been pushed onto a dict stack, pop those first
1954 ;; FIXME: shouldn't be using internal trie functions!
1955 ((and (trie-stack-p dictree-stack)
1956 (trie--stack-pushed dictree-stack))
1957 (trie-stack-pop dictree-stack))
1958 ;; if elements have been pushed onto a meta-dict stack, pop those
1960 ((and (dictree--meta-stack-p dictree-stack)
1961 (dictree--meta-stack-pushed dictree-stack))
1962 (pop (dictree--meta-stack-pushed dictree-stack)))
1963 ;; otherwise, pop first element from dictree-stack
1964 (t (let ((popped (dictree--stack-pop dictree-stack)))
1966 (cons (car popped) (dictree--cell-data (cdr popped))))))
1970 (defun dictree-stack-push (element dictree-stack)
1971 "Push ELEMENT onto DICTREE-STACK."
1972 (if (trie-stack-p dictree-stack)
1974 (trie-stack-push element dictree-stack)
1976 (push element (dictree--meta-stack-pushed dictree-stack))))
1979 (defun dictree-stack-first (dictree-stack)
1980 "Return the first element from DICTREE-STACK, without removing it.
1981 Returns nil if the stack is empty."
1982 ;; if elements have been pushed onto the stack, return first of those
1983 (if (and (dictree--meta-stack-p dictree-stack)
1984 (dictree--meta-stack-pushed dictree-stack))
1985 (car (dictree--meta-stack-pushed dictree-stack))
1986 ;; otherwise, return first element from dictree-stack
1987 (let ((first (dictree--stack-first dictree-stack)))
1988 (cons (car first) (dictree--cell-data (cdr first))))))
1991 (defun dictree-stack-empty-p (dictree-stack)
1992 "Return t if DICTREE-STACK is empty, nil otherwise."
1993 (if (trie-stack-p dictree-stack)
1995 (trie-stack-empty-p dictree-stack)
1997 (and (heap-empty (dictree--meta-stack-heap dictree-stack))
1998 (null (dictree--meta-stack-pushed dictree-stack)))))
2001 (defun dictree--stack-first (dictree-stack)
2002 "Return the first element from DICTREE-STACK, without removing it.
2003 Returns nil if the stack is empty."
2004 (if (trie-stack-p dictree-stack)
2006 (trie-stack-first dictree-stack)
2008 (if (dictree--meta-stack-pushed dictree-stack)
2010 (car (dictree--meta-stack-pushed dictree-stack))
2011 ;; dictree-stack element
2012 (dictree--stack-first
2013 (heap-root (dictree--meta-stack-heap dictree-stack))))))
2016 (defun dictree--stack-pop (dictree-stack)
2017 ;; Pop the raw first element from DICTREE-STACK. Returns nil if the
2020 ;; dictree-stack for normal dictionaries is a trie-stack
2021 (if (trie-stack-p dictree-stack)
2022 (trie-stack-pop dictree-stack)
2024 ;; meta-dictionary dictree-stack...more work!
2025 ;; if elements have been pushed onto meta-dict stack, pop those
2027 (if (dictree--meta-stack-pushed dictree-stack)
2028 (pop (dictree--meta-stack-pushed dictree-stack))
2030 (let ((heap (dictree--meta-stack-heap dictree-stack))
2031 (sortfun (dictree--meta-stack-sortfun dictree-stack))
2032 stack curr next cell)
2033 (unless (heap-empty heap)
2034 ;; remove the first dictree-stack from the heap, pop it's
2035 ;; first element, and add it back to the heap (note that it
2036 ;; will almost certainly not end up at the root again)
2037 (setq stack (heap-delete-root heap))
2038 (setq curr (dictree--stack-pop stack))
2039 (unless (dictree-stack-empty-p stack) (heap-add heap stack))
2040 ;; peek at the first element of the stack now at the root of
2042 (unless (heap-empty heap)
2043 (setq next (dictree--stack-first (heap-root heap)))
2044 ;; repeat this as long as we keep finding elements with the
2045 ;; same key, combining them together as we go
2046 (when (dictree--meta-stack-combfun dictree-stack)
2047 (while (and (null (funcall sortfun
2048 (car curr) (car next)))
2049 (null (funcall sortfun
2050 (car next) (car curr))))
2051 (setq stack (heap-delete-root heap))
2052 (setq next (dictree--stack-pop stack))
2056 (dictree--cell-create
2058 (dictree--meta-stack-combfun dictree-stack)
2059 (dictree--cell-data (cdr curr))
2060 (dictree--cell-data (cdr next)))
2061 (append (dictree--cell-plist (cdr curr))
2062 (dictree--cell-plist (cdr next))))))
2063 (heap-add heap stack)
2064 (setq next (dictree--stack-first (heap-root heap))))))
2065 ;; return the combined dictionary element
2071 ;; ----------------------------------------------------------------
2072 ;; Functions for building advanced queries
2074 (defun dictree--query
2075 (dict arg cachefun cacheparamfun triefun stackfun
2076 &optional rank-function maxnum reverse no-cache filter resultfun)
2077 ;; Return results of querying DICT with argument ARG using TRIEFUN or
2078 ;; STACKFUN. If result of calling CACHEPARAMFUN on DICT is non-nil,
2079 ;; look first for cached result in cache returned by calling CACHEFUN
2080 ;; on DICT, and cache result if query fulfils caching conditions. If
2081 ;; RANK-FUNCTION is non-nil, return results ordered accordingly. If
2082 ;; MAXNUM is an integer, only the first MAXNUM results will be
2083 ;; returned. If REVERSE is non-nil, results are in reverse order. A
2084 ;; non-nil NO-CACHE prevents caching of results, irrespective of
2085 ;; DICT's cache settings. If supplied, only results that pass FILTER
2086 ;; are included. A non-nil RESULTFUN is applied to results before
2087 ;; adding them to final results list. Otherwise, an alist of key-data
2088 ;; associations is returned.
2090 ;; wrap DICT in a list if necessary
2091 (when (dictree-p dict) (setq dict (list dict)))
2093 (let (cache cacheparam completions cmpl cache-entry)
2094 ;; map over all dictionaries in list
2096 (setq cache (funcall cachefun dic)
2097 cacheparam (funcall cacheparamfun dic))
2099 ;; If FILTER or custom RANK-FUNCTION was specified, look in trie
2100 ;; since we don't cache custom searches. We pass a slightly
2101 ;; redefined filter to `trie-complete' to deal with data
2105 (not (eq rank-function (dictree-rank-function dic)))))
2107 (dictree--do-query dic arg triefun stackfun
2108 (dictree--wrap-rankfun rank-function)
2111 (dictree--wrap-filter filter)))))
2114 ;; if there's a cached result with enough completions, use it
2115 ((and (setq cache-entry
2117 (gethash (cons arg reverse) cache)
2119 (or (null (dictree--cache-maxnum cache-entry))
2121 (<= maxnum (dictree--cache-maxnum cache-entry)))))
2122 (setq cmpl (dictree--cache-results cache-entry))
2123 ;; drop any excess completions
2125 (or (null (dictree--cache-maxnum cache-entry))
2126 (> (dictree--cache-maxnum cache-entry) maxnum)))
2127 (setcdr (nthcdr (1- maxnum) completions) nil)))
2130 ;; if there was nothing useful in the cache, do query and time it
2133 (setq time (float-time))
2136 dic arg triefun stackfun
2138 (dictree--wrap-rankfun rank-function))
2139 maxnum reverse nil))
2140 (setq time (- (float-time) time))
2141 ;; if we're above the dictionary's completion cache threshold,
2143 (when (and (not no-cache)
2144 (dictree--above-cache-threshold-p
2145 time (length arg) (dictree-cache-policy dic)
2147 (setf (dictree-modified dic) t)
2148 (puthash (cons arg reverse)
2149 (dictree--cache-create cmpl maxnum)
2152 ;; merge new completion into completions list
2157 (dictree--wrap-rankfun rank-function)
2159 (,(trie-construct-sortfun
2160 (dictree-comparison-function (car dict)))
2164 ;; return completions list, applying RESULTFUN is specified,
2165 ;; otherwise just stripping meta-data
2168 (dictree--wrap-resultfun resultfun)
2169 (lambda (el) (cons (car el) (dictree--cell-data (cdr el)))))
2174 (defun dictree--do-query
2175 (dict arg triefun stackfun &optional rank-function maxnum reverse filter)
2176 ;; Return first MAXNUM results of querying DICT with ARG using TRIEFUN
2177 ;; or STACKFUN that satisfy FILTER, ordered according to RANK-FUNCTION
2178 ;; (defaulting to "lexical" order).
2180 ;; for a meta-dict, use a dictree-stack
2181 (if (dictree--meta-dict-p dict)
2182 (let ((stack (funcall stackfun dict arg reverse))
2183 (heap (when rank-function
2184 (heap-create ; heap order is inverse of rank order
2188 (not (funcall rank-function a b))))
2190 (i 0) cmpl completions)
2191 ;; pop MAXNUM completions from the stack
2192 (while (and (or (null maxnum) (< i maxnum))
2193 (setq cmpl (dictree--stack-pop stack)))
2194 ;; check completion passes FILTER
2195 (when (or (null filter) (funcall filter cmpl))
2197 (heap-add heap cmpl) ; for ranked query, add to heap
2198 (push cmpl completions)) ; for lexical query, add to list
2200 (if (null rank-function)
2201 ;; for lexical query, reverse and return completion list (we
2202 ;; built it backwards)
2203 (nreverse completions)
2204 ;; for ranked query, pass rest of completions through heap
2205 (while (setq cmpl (dictree--stack-pop stack))
2206 (heap-add heap cmpl)
2207 (heap-delete-root heap))
2208 ;; extract completions from heap
2209 (while (setq cmpl (heap-delete-root heap))
2210 (push cmpl completions))
2211 completions)) ; return completion list
2213 ;; for a normal dict, call corresponding trie function on dict's
2214 ;; trie. Note: could use a dictree-stack here too - would it be more
2217 (dictree--trie dict) arg rank-function
2218 maxnum reverse filter)))
2222 ;; ----------------------------------------------------------------
2225 (defun dictree-complete
2227 &optional rank-function maxnum reverse no-cache filter resultfun)
2228 "Return an alist containing all completions of PREFIX in DICT
2229 along with their associated data, sorted according to
2230 RANK-FUNCTION (defaulting to \"lexical\" order, i.e. the order
2231 defined by the dictionary's comparison function,
2232 cf. `dictree-create'). Return nil if no completions are found.
2234 PREFIX can also be a list of sequences, in which case completions of
2235 all elements in the list are returned, merged together in a
2236 single sorted alist.
2238 DICT can also be a list of dictionaries, in which case
2239 completions are sought in all dictionaries in the list. (Note
2240 that if the same key appears in multiple dictionaries, the alist
2241 may contain the same key multiple times, each copy associated
2242 with the data from a different dictionary. If you want to combine
2243 identical keys, use a meta-dictionary; see
2244 `dictree-create-meta-dict'.)
2246 If optional argument RANK-FUNCTION is any non-nil value that is
2247 not a function, the completions are sorted according to the
2248 dictionary's rank-function (see `dictree-create'). Any non-nil
2249 value that *is* a function over-rides this. In that case,
2250 RANK-FUNCTION should accept two arguments, both cons cells. The
2251 car of each contains a sequence from the trie (of the same type
2252 as PREFIX), the cdr contains its associated data. The
2253 RANK-FUNCTION should return non-nil if first argument is ranked
2254 strictly higher than the second, nil otherwise.
2256 The optional integer argument MAXNUM limits the results to the
2257 first MAXNUM completions. The default is to return all matches.
2259 If the optional argument NO-CACHE is non-nil, it prevents caching
2260 of the result. Ignored for dictionaries that do not have
2261 completion caching enabled.
2263 The FILTER argument sets a filter function for the
2264 completions. For each potential completion, it is passed two
2265 arguments: the completion, and its associated data. If the filter
2266 function returns nil, the completion is not included in the
2267 results, and doesn't count towards MAXNUM.
2269 RESULTFUN defines a function used to process results before
2270 adding them to the final result list. If specified, it should
2271 accept two arguments: a key and its associated data. It's return
2272 value is what gets added to the final result list, instead of the
2273 default key-data cons cell."
2274 ;; run completion query
2278 'dictree-complete-ranked-cache
2279 'dictree-complete-cache)
2281 'dictree-complete-ranked-cache-threshold
2282 'dictree-complete-cache-threshold)
2283 'trie-complete 'dictree-complete-stack
2285 (if (functionp rank-function)
2287 (dictree-rank-function (if (listp dict) (car dict) dict))))
2288 maxnum reverse no-cache filter resultfun))
2292 (defun dictree-collection-function (dict string predicate all)
2293 "Function for use in `try-completion', `all-completions',
2294 and `completing-read'. To complete from dictionary DICT, use the
2295 following as the COLLECTION argument of any of those functions:
2297 (lambda (string predicate all)
2298 (dictree-collection-function dict string predicate all))
2300 Note that PREDICATE will be called with two arguments: the
2301 completion, and its associated data."
2303 (dictree-complete dict string nil nil nil nil
2304 predicate (lambda (key data) key))))
2305 (if all completions (try-completion "" completions))))
2309 ;; ----------------------------------------------------------------
2312 (defun dictree-regexp-search
2314 &optional rank-function maxnum reverse no-cache filter resultfun)
2315 "Return an alist containing all matches for REGEXP in TRIE
2316 along with their associated data, in the order defined by
2317 RANKFUN, defauling to \"lexical\" order (i.e. the order defined
2318 by the trie's comparison function). If REVERSE is non-nil, the
2319 completions are sorted in the reverse order. Returns nil if no
2320 completions are found.
2322 DICT can also be a list of dictionaries, in which case matches
2323 are sought in all dictionaries in the list. (Note that if the
2324 same key appears in multiple dictionaries, the alist may contain
2325 the same key multiple times, each copy associated with the data
2326 from a different dictionary. If you want to combine identical
2327 keys, use a meta-dictionary; see `dictree-create-meta-dict'.)
2329 REGEXP is a regular expression, but it need not necessarily be a
2330 string. It must be a sequence (vector, list of string) whose
2331 elements are either elements of the same type as elements of the
2332 trie keys (which behave as literals in the regexp), or any of the
2333 usual regexp special characters and backslash constructs. If
2334 REGEXP is a string, it must be possible to apply `string' to
2335 individual elements of the keys stored in the trie. The matches
2336 returned in the alist will be sequences of the same type as KEY.
2338 Only a subset of the full Emacs regular expression syntax is
2339 supported. There is no support for regexp constructs that are
2340 only meaningful for strings (character ranges and character
2341 classes inside character alternatives, and syntax-related
2342 backslash constructs). Back-references and non-greedy postfix
2343 operators are not supported, so `?' after a postfix operator
2344 loses its special meaning. Also, matches are always anchored, so
2345 `$' and `^' lose their special meanings (use `.*' at the
2346 beginning and end of the regexp to get an unanchored match).
2348 If the regexp contains any non-shy grouping constructs, subgroup
2349 match data is included in the results. In this case, the car of
2350 each match is no longer just a key. Instead, it is a list whose
2351 first element is the matching key, and whose remaining elements
2352 are cons cells whose cars and cdrs give the start and end indices
2353 of the elements that matched the corresponding groups, in order.
2355 If optional argument RANK-FUNCTION is any non-nil value that is
2356 not a function, the matches are sorted according to the
2357 dictionary's rank-function (see `dictree-create'). Any non-nil
2358 value that *is* a function over-rides this. In that case,
2359 RANK-FUNCTION should accept two arguments, both cons cells. The
2360 car of each contains a sequence from the dictionary (of the same
2361 type as PREFIX), the cdr contains its associated data. The
2362 RANK-FUNCTION should return non-nil if first argument is ranked
2363 strictly higher than the second, nil otherwise.
2365 The optional integer argument MAXNUM limits the results to the
2366 first MAXNUM matches. The default is to return all matches.
2368 If the optional argument NO-CACHE is non-nil, it prevents caching
2369 of the result. Ignored for dictionaries that do not have wildcard
2372 The FILTER argument sets a filter function for the matches. If
2373 supplied, it is called for each possible match with two
2374 arguments: the matching key, and its associated data. If the
2375 filter function returns nil, the match is not included in the
2376 results, and does not count towards MAXNUM.
2378 RESULTFUN defines a function used to process results before
2379 adding them to the final result list. If specified, it should
2380 accept two arguments: a key and its associated data. It's return
2381 value is what gets added to the final result list, instead of the
2382 default key-data cons cell."
2387 'dictree-regexp-ranked-cache
2388 'dictree-regexp-cache)
2390 'dictree-regexp-ranked-cache-threshold
2391 'dictree-regexp-cache-threshold)
2392 'trie-regexp-search 'dictree-regexp-stack
2394 (if (functionp rank-function)
2396 (dictree-rank-function (if (listp dict) (car dict) dict))))
2397 maxnum reverse no-cache filter resultfun))
2402 ;; ----------------------------------------------------------------
2403 ;; Persistent storage
2405 (defun dictree-save (dict &optional compilation)
2406 "Save dictionary DICT to it's associated file.
2407 Use `dictree-write' to save to a different file.
2409 Optional argument COMPILATION determines whether to save the
2410 dictionary in compiled or uncompiled form. The default is to save
2411 both forms. See `dictree-write'.
2413 Interactively, DICT is read from the mini-buffer."
2414 (interactive (list (read-dict "Dictionary: ")))
2415 (when (and (called-interactively-p 'any) (symbolp dict))
2416 (setq dict (eval dict)))
2418 (let ((filename (dictree-filename dict)))
2419 ;; if dictionary has no associated file, prompt for one
2420 (unless (and filename (> (length filename) 0))
2423 (format "Save dictionary %s to file\
2424 (leave blank to NOT save): "
2425 (dictree-name dict))
2428 ;; if filename is blank, don't save
2429 (if (string= filename "")
2430 (message "Dictionary %s NOT saved" (dictree-name dict))
2431 ;; otherwise write dictionary to file
2432 (setf (dictree-filename dict) filename)
2433 (dictree-write dict filename t compilation))))
2437 (defun dictree-write (dict &optional filename overwrite compilation)
2438 "Write dictionary DICT to file FILENAME.
2439 Defaults to dictionary's current filename if FILENAME is not
2440 specified (like `dictree-save').
2442 If optional argument OVERWRITE is non-nil, no confirmation will
2443 be asked for before overwriting an existing file.
2445 The default is to create both compiled and uncompiled versions of
2446 the dictionary, with extensions .elc and .el respectively (if
2447 FILENAME has either of these extensions, they are stripped off
2448 before proceeding). The compiled version is always used in
2449 preference to the uncomplied version, as it loads
2450 faster. However, only the uncompiled version is portable between
2451 different Emacs versions.
2453 If optional argument COMPILATION is the symbol 'compiled, only
2454 the compiled version will be created, whereas if it is the symbol
2455 'uncompiled, only the uncompiled version will be created.
2457 Interactively, DICT and FILENAME are read from the mini-buffer,
2458 and OVERWRITE is the prefix argument."
2459 (interactive (list (read-dict "Dictionary: ")
2460 (read-file-name "Write dictionary to file: "
2462 current-prefix-arg))
2463 (when (and (called-interactively-p 'any) (symbolp dict))
2464 (setq dict (eval dict)))
2465 ;; default to DICT's current file, if any
2466 (when (or (null filename)
2467 (and (called-interactively-p 'any) (string= filename "")))
2468 (setq filename (dictree-filename dict)))
2471 (message "Dictionary %s NOT written" (dictree-name dict))
2472 nil) ; indicate dictionary wasn't written
2474 (let (dictname buff tmpfile)
2475 ;; remove any .el(c) extension from filename
2477 ((and (> (length filename) 3)
2478 (string= (substring filename -3) ".el"))
2479 (setq filename (substring filename 0 -3)))
2480 ((and (> (length filename) 4)
2481 (string= (substring filename -4) ".elc"))
2482 (setq filename (substring filename 0 -4))))
2483 ;; create saved dictionary name from filename
2484 (setq dictname (file-name-nondirectory filename))
2487 ;; create a temporary file
2490 (setq tmpfile (make-temp-file dictname))))
2492 ;; call the appropriate write function to write the dictionary code
2493 (if (dictree--meta-dict-p dict)
2494 (dictree--write-meta-dict-code dict dictname filename)
2495 (dictree--write-dict-code dict dictname filename))
2499 ;; prompt to overwrite if necessary
2502 (or (eq compilation 'compiled)
2503 (not (file-exists-p (concat filename ".el"))))
2504 (or (eq compilation 'uncompiled)
2505 (not (file-exists-p (concat filename ".elc")))))
2507 (format "File %s already exists. Overwrite? "
2508 (concat filename ".el(c)"))))
2511 ;; move the uncompiled version to its final destination
2512 (unless (eq compilation 'compiled)
2513 (copy-file tmpfile (concat filename ".el") t))
2514 ;; byte-compile and move the compiled version to its final
2516 (unless (eq compilation 'uncompiled)
2517 (if (save-window-excursion
2518 (let ((byte-compile-disable-print-circle t)
2520 (setq err (byte-compile-file tmpfile))
2522 (rename-file (concat tmpfile ".elc")
2523 (concat filename ".elc") t)
2525 (error "Error writing dictionary. Dictionary %s NOT saved"
2528 ;; if writing to a different name, unload dictionary under old
2529 ;; name and reload it under new one
2530 (setf (dictree-modified dict) nil)
2531 (setf (dictree-filename dict) filename)
2532 (unless (string= dictname (dictree-name dict))
2533 (dictree-unload dict)
2534 (dictree-load filename)))
2536 (delete-file tmpfile)
2537 (message "Dictionary %s saved to %s" dictname filename)
2538 t) ; return t to indicate dictionary was successfully saved
2543 (defun dictree-save-modified (&optional dict ask compilation force
2545 "Save all modified dictionaries that have their autosave flag set.
2546 Returns t if all dictionaries were successfully saved. Otherwise,
2547 inform the user about the dictionaries which failed to save
2548 properly, ask them whether they wish to continue anyway, and
2549 return t or nil accordingly.
2551 If optional argument DICT is a list of dictionaries or a single
2552 dictionary, only save those.
2554 If optional argument ASK is non-nil, ask for confirmation before
2557 Optional argument COMPILATION determines whether to save the
2558 dictionaries in compiled or uncompiled form. The default is to
2559 save both forms. See `dictree-write'.
2561 If optional argument FORCE is non-nil, save modified dictionaries
2562 irrespective of their autosave flag.
2564 If optional argument NO-FAIL-QUERY is non-nil, the user will not
2565 be queried if a dictionary fails to save properly, and the return
2566 value is always nil.
2568 Interactively, FORCE is the prefix argument, and the user will not be
2569 asked whether they wish to continue after a failed save."
2572 ;; sort out arguments
2573 (when (and (called-interactively-p 'any) dict) (setq dict nil force t))
2574 (when (dictree-p dict) (setq dict (list dict)))
2576 ;; For each dictionary in list / each loaded dictionary, check if
2577 ;; dictionary has been modified. If so, save it if autosave is set or
2578 ;; FORCE is non-nil.
2579 (let (save-failures)
2580 (dolist (dic (if (null dict)
2583 (when (and (dictree-modified dic)
2584 (or force (dictree-autosave dic))
2586 (y-or-n-p (format "Save modified dictionary %s? "
2587 (dictree-filename dic)))))
2590 (dictree-save dic compilation)
2591 (setf (dictree-modified dic) nil))
2592 (error (push dic save-failures)))))
2594 ;; prompt if dictionary saving failed
2596 (if (or (called-interactively-p 'any) no-fail-query)
2600 "Error: failed to save the following modified "
2602 (mapconcat 'dictree--name save-failures ", ")))
2605 (concat "Error: failed to save the following modified "
2607 (mapconcat 'dictree--name save-failures ", ")
2608 "; continue anyway? ")))
2612 ;; Add the dictree-save-modified function to the kill-emacs-hook to save
2613 ;; modified dictionaries when exiting emacs
2614 (add-hook 'kill-emacs-query-functions 'dictree-save-modified)
2619 (defun dictree-load (file)
2620 "Load a dictionary object from file FILE.
2621 Returns the dictionary if successful, nil otherwise.
2623 Interactively, FILE is read from the mini-buffer."
2624 (interactive (list (read-dict "Load dictionary: " nil nil t t)))
2626 ;; sort out dictionary name and file name
2627 (if (or (symbolp file) (dictree-p file))
2628 (message "Dictionary %s already loaded" (dictree-name file))
2630 ;; load the dictionary
2631 (if (not (load file t))
2632 ;; if loading failed, throw error interactively, return nil
2633 ;; non-interactively
2634 (if (called-interactively-p 'any)
2635 (error "Cannot open dictionary file: %s" file)
2638 (let (dictname dict)
2640 (file-name-nondirectory (file-name-sans-extension file))
2641 dict (eval (intern-soft dictname)))
2642 (if (not (dictree-p dict))
2643 ;; if loading failed, throw error interactively, return nil
2644 ;; non-interactively
2645 (if (called-interactively-p 'any)
2646 (error "Error loading dictionary file: %s" file)
2649 ;; ensure the dictionary name and file name associated with
2650 ;; the dictionary match the file it was loaded from
2651 (when (and (string= (file-name-nondirectory file) file)
2653 (locate-file file load-path load-suffixes)))
2654 (setf (dictree-filename dict) file))
2655 (setf (dictree-name dict) dictname)
2657 ;; make sure the dictionary is in dictree-loaded-list
2658 ;; (normally the lisp code in the dictionary itself should do
2659 ;; this, but just to make sure...)
2660 (unless (memq dict dictree-loaded-list)
2661 (push dict dictree-loaded-list))
2662 (message (format "Loaded dictionary %s" dictname))
2664 ;; return dictionary
2669 (defun dictree-unload (dict &optional dont-save)
2670 "Unload dictionary DICT.
2671 If optional argument DONT-SAVE is non-nil, the dictionary will
2672 NOT be saved even if its autosave flag is set.
2674 Interactively, DICT is read from the mini-buffer, and DONT-SAVE
2675 is the prefix argument."
2676 (interactive (list (read-dict "Dictionary: ")
2677 current-prefix-arg))
2678 (when (and (called-interactively-p 'any) (symbolp dict))
2679 (setq dict (eval dict)))
2681 ;; if dictionary has been modified, autosave is set and not overidden,
2683 (when (and (dictree-modified dict)
2685 (or (eq (dictree-autosave dict) t)
2686 (and (eq (dictree-autosave dict) 'ask)
2689 "Dictionary %s modified.\
2690 Save before unloading? "
2691 (dictree-name dict))))))
2692 (dictree-save dict))
2694 ;; if unloading a meta-dict, remove reference to it from constituent
2695 ;; dictionaries' meta-dict-list cell
2696 (when (dictree--meta-dict-p dict)
2699 (setf (dictree--meta-dict-list dic)
2700 (delq dict (dictree--meta-dict-list dic))))
2701 (dictree--meta-dict-dictlist dict)))
2703 ;; remove dictionary from list of loaded dictionaries and unload it
2704 (setq dictree-loaded-list (delq dict dictree-loaded-list))
2705 (unintern (dictree-name dict))
2706 (message "Dictionary %s unloaded" (dictree-name dict)))
2710 (defun dictree--write-dict-code (dict dictname filename)
2711 ;; Write code for normal dictionary DICT to current buffer, giving it
2712 ;; the name DICTNAME and file FILENAME.
2713 (let (hashcode tmpdict tmptrie lookup-alist
2714 complete-alist complete-ranked-alist
2715 regexp-alist regexp-ranked-alist)
2717 ;; --- convert trie data ---
2718 ;; if dictionary doesn't use any custom save functions, write
2719 ;; dictionary's trie directly as is
2720 (setq tmptrie (dictree--trie dict))
2721 ;; otherwise, create a temporary trie and populate it with the
2722 ;; converted contents of the dictionary's trie
2723 (when (or (dictree--data-savefun dict)
2724 (dictree--plist-savefun dict))
2727 (trie-comparison-function tmptrie)
2728 :createfun (trie--createfun tmptrie)
2729 :insertfun (trie--insertfun tmptrie)
2730 :deletefun (trie--deletefun tmptrie)
2731 :lookupfun (trie--lookupfun tmptrie)
2732 :mapfun (trie--mapfun tmptrie)
2733 :emptyfun (trie--emptyfun tmptrie)
2734 :stack-createfun (trie--stack-createfun tmptrie)
2735 :stack-popfun (trie--stack-popfun tmptrie)
2736 :stack-emptyfun (trie--stack-emptyfun tmptrie)))
2739 (trie-insert tmptrie key
2740 (dictree--cell-create
2741 (funcall (or (dictree--data-savefun dict)
2743 (dictree--cell-data cell))
2744 (funcall (or (dictree--plist-savefun dict)
2746 (dictree--cell-plist cell)))))
2747 (dictree--trie dict))
2749 ;; generate code to convert contents of trie back to original form
2754 " (lambda (key cell)\n"
2755 " (dictree--cell-create\n"
2756 (if (dictree--data-loadfun dict)
2758 "(funcall (dictree--data-loadfun " dictname ")\n"
2759 " (dictree--cell-data cell))\n")
2760 " (dictree--cell-data cell)\n")
2761 (if (dictree--plist-loadfun dict)
2763 "(funcall (dictree--plist-loadfun " dictname ")\n"
2764 " (dictree--cell-plist cell))))\n")
2765 " (dictree--cell-plist cell)))\n")
2766 " (dictree--trie " dictname "))\n")))
2769 ;; --- convert caches for writing to file ---
2770 ;; hash tables have no read syntax in older Emacsen, so we convert
2771 ;; them to alists for writing
2772 (unless (featurep 'hashtable-print-readable)
2773 ;; convert lookup cache hash table to alist, if it exists
2774 (when (dictree--lookup-cache-threshold dict)
2779 (cons (mapcar 'car (dictree--cache-results val))
2780 (dictree--cache-maxnum val)))
2782 (dictree--lookup-cache dict))
2783 ;; generate code to reconstruct the lookup hash table
2787 "(let ((lookup-cache (make-hash-table :test 'equal))\n"
2788 " (trie (dictree--trie " dictname ")))\n"
2790 " (lambda (entry)\n"
2793 " (dictree--cache-create\n"
2796 " (cons key (trie-member trie key)))\n"
2797 " (dictree--cache-results (cdr entry)))\n"
2798 " (dictree--cache-maxnum (cdr entry)))\n"
2800 " (dictree--lookup-cache " dictname "))\n"
2801 " (setf (dictree--lookup-cache " dictname ")\n"
2802 " lookup-cache))\n")))
2804 ;; convert query caches, if they exist
2805 (dolist (cache-details
2806 '((dictree--complete-cache-threshold
2807 complete-alist dictree--complete-cache)
2808 (dictree--complete-ranked-cache-threshold
2809 complete-ranked-alist dictree--complete-ranked-cache)
2810 (dictree--regexp-cache-threshold
2811 regexp-alist dictree--regexp-cache)
2812 (dictree--regexp-ranked-cache-threshold
2813 regexp-ranked-alist dictree--regexp-ranked-cache)))
2814 (when (funcall (nth 0 cache-details) dict)
2815 ;; convert hash table to alist
2816 (set (nth 1 cache-details)
2823 (mapcar 'car (dictree--cache-results val))
2824 (dictree--cache-maxnum val)))
2826 (funcall (nth 2 cache-details) dict))
2828 ;; generate code to reconstruct hash table from alist
2833 "(let ((cache (make-hash-table :test 'equal))\n"
2834 " (trie (dictree--trie " dictname ")))\n"
2836 " (lambda (entry)\n"
2839 " (dictree--cache-create\n"
2844 " trie (if (stringp key) key (car key)))))\n"
2845 " (dictree--cache-results (cdr entry)))\n"
2846 " (dictree--cache-maxnum (cdr entry)))\n"
2848 " (" (symbol-name (nth 2 cache-details)) " " dictname "))\n"
2849 " (setf (" (symbol-name (nth 2 cache-details)) " "
2854 ;; --- write to file ---
2855 ;; generate the structure to save
2856 (setq tmpdict (dictree--copy dict))
2857 (setf (dictree--trie tmpdict) tmptrie
2858 (dictree--name tmpdict) dictname
2859 (dictree--filename tmpdict) filename
2860 (dictree--modified tmpdict) nil
2861 (dictree--meta-dict-list tmpdict) nil)
2862 (unless (featurep 'hashtable-print-readable)
2863 (setf (dictree--lookup-cache tmpdict) lookup-alist
2864 (dictree--complete-cache tmpdict) complete-alist
2865 (dictree--complete-ranked-cache tmpdict) complete-ranked-alist
2866 (dictree--regexp-cache tmpdict) regexp-alist
2867 (dictree--regexp-ranked-cache tmpdict) regexp-ranked-alist))
2869 ;; write lisp code that generates the dictionary object
2870 (let ((print-circle t) (print-level nil) (print-length nil))
2871 (insert "(eval-when-compile (require 'cl))\n")
2872 (insert "(require 'dict-tree)\n")
2873 (insert "(defvar " dictname " nil \"Dictionary " dictname ".\")\n")
2876 ;; transform trie to print form
2877 (trie-transform-for-print (dictree--trie tmpdict))
2878 (insert "(setq " dictname
2879 " '" (prin1-to-string tmpdict) ")\n"))
2880 ;; if dictionary doesn't use any custom save functions, tmpdict's trie
2881 ;; is identical to original dict, so transform it back to usable form
2883 (unless (or (dictree--data-savefun dict)
2884 (dictree--plist-savefun dict))
2885 (trie-transform-from-read (dictree--trie tmpdict))))
2886 (insert "(trie-transform-from-read (dictree--trie "
2888 (when hashcode (insert hashcode))
2889 (insert "(unless (memq " dictname " dictree-loaded-list)\n"
2890 " (push " dictname " dictree-loaded-list))\n"))))
2894 (defun dictree--write-meta-dict-code (dict dictname filename)
2895 ;; Write code for meta-dictionary DICT to current buffer, giving it
2896 ;; the name DICTNAME and file FILENAME.
2897 (let (hashcode tmpdict lookup-alist
2898 complete-alist complete-ranked-alist
2899 regexp-alist regexp-ranked-alist)
2901 ;; --- convert caches for writing to file ---
2902 ;; hash tables have no read syntax in older Emacsen, so we convert
2903 ;; them to alists for writing
2904 (unless (featurep 'hashtable-print-readable)
2905 ;; convert lookup cache hash table to an alist, if it exists
2906 (when (dictree--meta-dict-lookup-cache-threshold dict)
2907 (maphash (lambda (key val)
2908 (push (cons key (mapcar 'car val)) lookup-alist))
2909 (dictree--meta-dict-lookup-cache dict))
2910 ;; generate code to reconstruct the lookup hash table
2914 "(let ((cache (make-hash-table :test 'equal)))\n"
2915 " (mapc (lambda (entry)\n"
2916 " (puthash (car entry) (cdr entry) cache))\n"
2917 " (dictree--meta-dict-lookup-cache " dictname "))\n"
2918 " (setf (dictree--meta-dict-lookup-cache " dictname ")\n"
2921 ;; convert query caches, if they exist
2922 (dolist (cache-details
2923 '((dictree--meta-dict-complete-cache-threshold
2925 dictree--meta-dict-complete-cache)
2926 (dictree--meta-dict-complete-ranked-cache-threshold
2927 complete-ranked-alist
2928 dictree--meta-dict-complete-ranked-cache)
2929 (dictree--meta-dict-regexp-cache-threshold
2931 dictree--meta-dict-regexp-cache)
2932 (dictree--meta-dict-regexp-ranked-cache-threshold
2934 dictree--meta-dict-regexp-ranked-cache)))
2935 (when (funcall (nth 0 cache-details) dict)
2936 ;; convert hash table to alist
2937 (set (nth 1 cache-details)
2940 (lambda (key val) (push (cons key val) alist))
2941 (funcall (nth 2 cache-details) dict))
2943 ;; generate code to reconstruct hash table from alist
2948 "(let ((cache (make-hash-table :test 'equal)))\n"
2949 " (mapc (lambda (entry)\n"
2950 " (puthash (car entry) (cdr entry) cache))\n"
2951 " (" (symbol-name (nth 2 cache-details)) " "
2953 " (setf (" (symbol-name (nth 2 cache-details)) " "
2958 ;; --- write to file ---
2959 ;; generate the structure to save
2960 (setq tmpdict (dictree--meta-dict-copy dict))
2961 (setf (dictree--meta-dict-name tmpdict) dictname
2962 (dictree--meta-dict-filename tmpdict) filename
2963 (dictree--meta-dict-modified tmpdict) nil
2964 (dictree--meta-dict-meta-dict-list tmpdict) nil
2965 (dictree--meta-dict-dictlist tmpdict)
2966 (mapcar (lambda (dic) (intern (dictree-name dic)))
2967 (dictree--meta-dict-dictlist dict)))
2968 (unless (featurep 'hashtable-print-readable)
2969 (setf (dictree--meta-dict-lookup-cache tmpdict) lookup-alist
2970 (dictree--meta-dict-complete-cache tmpdict) complete-alist
2971 (dictree--meta-dict-complete-ranked-cache tmpdict)
2972 complete-ranked-alist
2973 (dictree--meta-dict-regexp-cache tmpdict) regexp-alist
2974 (dictree--meta-dict-regexp-ranked-cache tmpdict)
2975 regexp-ranked-alist))
2977 ;; write lisp code that generates the dictionary object
2978 (let ((print-circle t) (print-level nil) (print-length nil))
2979 (insert "(eval-when-compile (require 'cl))\n"
2980 "(require 'dict-tree)\n")
2983 (insert "(unless (dictree-load \"" (dictree-filename dic) "\")\n"
2984 " (error \"Failed to load dictionary \\\""
2985 (dictree-name dic) "\\\" required by meta-dict \\\""
2986 dictname "\\\"\"))\n"))
2987 (dictree--meta-dict-dictlist dict))
2988 (insert "(defvar " dictname " nil \"Dictionary " dictname ".\")\n"
2989 "(setq " dictname " " (prin1-to-string tmpdict) ")\n"
2990 "(setf (dictree--meta-dict-dictlist " dictname ")\n"
2991 " (mapcar 'eval (dictree--meta-dict-dictlist "
2993 (when hashcode (insert hashcode))
2994 (insert "(unless (memq " dictname " dictree-loaded-list)"
2995 " (push " dictname " dictree-loaded-list))\n"))))
2999 ;; ----------------------------------------------------------------
3000 ;; Dumping and restoring contents
3002 (defun dictree-populate-from-file
3004 &optional insert-function key-loadfun data-loadfun plist-loadfun
3006 "Populate dictionary DICT from the key list in file FILE.
3008 Each line of FILE should contain a key, either a string
3009 \(delimited by \"\), a vector, or a list. (Use the escape
3010 sequence \\\" to include a \" in a string.) If a line does not
3011 contain a key, it is silently ignored.
3013 Each line can optionally include data and a property list (in
3014 that order) to be associated with the key. If present, these
3015 should separated from each other and the key by whitespace.
3017 INSERT-FUNCTION, KEY-LOAD-FUNCTION, DATA-LOAD-FUNCTION and
3018 PLIST-LOAD-FUNCTION override the corresponding default functions
3019 for DICT (see `dictree-create').
3021 Interactively, DICT and FILE are read from the mini-buffer.
3026 The key, data and property list are read as lisp expressions
3027 using `read'. The keys will be read from FILE in order, unless
3028 BALANCE is non-nil, in which case they are read from the median
3029 element outwards (which can help ensure efficient data structures
3030 are created when using a trie that is not self-balancing, see
3032 (interactive (list (read-dict "Dictionary: ")
3033 (read-file-name "File to populate from: "
3035 (when (and (called-interactively-p 'any) (symbolp dict))
3036 (setq dict (eval dict)))
3038 (if (and (called-interactively-p 'any) (string= file ""))
3039 (message "No file specified; dictionary %s NOT populated"
3040 (dictree-name dict))
3042 (unless (dictree--meta-dict-p dict)
3044 (setq key-loadfun (dictree--key-loadfun dict)))
3045 (unless data-loadfun
3046 (setq data-loadfun (dictree--data-loadfun dict)))
3047 (unless plist-loadfun
3048 (setq plist-loadfun (dictree--plist-loadfun dict))))
3051 (let ((buff (find-file-noselect file)))
3054 ;; insert the keys starting from the median to ensure a
3055 ;; reasonably well-balanced tree
3056 (let* ((lines (count-lines (point-min) (point-max)))
3057 (midpt (+ (/ lines 2) (mod lines 2)))
3059 (message "Inserting keys in %s...(1 of %d)"
3060 (dictree-name dict) lines)
3061 ;; insert the median key and set the dictionary's modified
3064 (dictree--goto-line midpt)
3065 (goto-char (point-min)))
3069 dict key-loadfun data-loadfun
3071 (error (error "Error reading line %d of %s"
3073 (dictree-insert dict (car entry) (nth 1 entry)
3075 (setf (dictree--cell-plist
3076 (dictree--lookup dict (car entry) nil))
3078 ;; insert keys successively further away from the median in
3080 (dotimes (i (1- (if balance midpt lines)))
3082 (dictree--goto-line (+ midpt i 1))
3087 dict key-loadfun data-loadfun
3089 (error (error "Error reading line %d of %s"
3090 (+ midpt i 1) file))))
3091 (dictree-insert dict (car entry) (nth 1 entry)
3093 (setf (dictree--cell-plist
3094 (dictree--lookup dict (car entry) nil))
3096 (when (= 49 (mod i 50))
3097 (message "Inserting keys in %s...(%d of %d)"
3099 (if balance (+ (* 2 i) 2) i)
3102 (dictree--goto-line (- midpt i 1))
3106 dict key-loadfun data-loadfun
3108 (error (error "Error reading line %d of %s"
3109 (- midpt i 1) file))))
3110 (dictree-insert dict (car entry)
3111 (nth 1 entry) insert-function)
3113 (dictree--cell-plist
3114 (dictree--lookup dict (car entry) nil))
3117 ;; if inserting from mid-point out, and file contains an even
3118 ;; number of keys, we still have to add the last one
3119 (when (and balance (= 0 (mod lines 2)))
3120 (dictree--goto-line lines)
3124 dict key-loadfun data-loadfun
3126 (error (error "Error reading line %d of %s"
3128 (dictree-insert dict (car entry) (nth 1 entry)
3130 (setf (dictree--cell-plist
3131 (dictree--lookup dict (car entry) nil))
3134 (message "Inserting keys in %s...done" (dictree-name dict)))
3135 (kill-buffer buff)))))
3139 (defun dictree--read-line
3140 (dict &optional key-loadfun data-loadfun plist-loadfun)
3141 ;; Return a list containing the key, data (if any, otherwise nil) and
3142 ;; property list (ditto) at the current line of the current buffer,
3143 ;; for dictionary DICT.
3145 (let (key data plist)
3148 (when (setq key (read (current-buffer)))
3149 (when key-loadfun (setq key (funcall key-loadfun key)))
3150 ;; if there's anything after the key, use it as data
3151 (unless (eq (line-end-position) (point))
3152 (setq data (read (current-buffer))))
3153 (when data-loadfun (setq data (funcall data-loadfun data)))
3154 ;; if there's anything after the data, use is as the property
3156 (unless (eq (line-end-position) (point))
3157 (setq plist (read (current-buffer))))
3158 (when plist-loadfun (funcall plist-loadfun plist))
3159 ;; return the key and data
3160 (list key data plist)))))
3164 (defun dictree-dump-to-buffer (dict &optional buffer type)
3165 "Dump keys and their associated data
3166 from dictionary DICT to BUFFER, in the same format as that used
3167 by `dictree-populate-from-file'. If BUFFER exists, data will be
3168 appended to the end of it. Otherwise, a new buffer will be
3169 created. If BUFFER is omitted, the current buffer is used.
3171 TYPE determines the type of sequence to use to represent the
3172 keys, and should be one of 'string, 'vector or 'list. The default
3175 Note that if the data does not have a read syntax, the dumped
3176 data can not be used to recreate the dictionary using
3177 `dictree-populate-from-file'.
3179 Interactively, DICT and BUFFER are read from the mini-buffer,
3180 TYPE is always 'string."
3181 (interactive (list (read-dict "Dictionary: ")
3183 "Buffer to dump to (defaults to current): "
3184 (buffer-name (current-buffer)))
3186 (when (and (called-interactively-p 'any) (symbolp dict))
3187 (setq dict (eval dict)))
3189 ;; select the buffer, creating it if necessary
3191 (setq buffer (get-buffer-create buffer))
3192 (setq buffer (current-buffer)))
3195 ;; move point to end of buffer and make sure it's at start of new line
3196 (goto-char (point-max))
3197 (unless (= (point) (line-beginning-position))
3201 (message "Dumping keys from %s to %s..."
3202 (dictree-name dict) (buffer-name buffer))
3203 (let ((count 0) (dictsize (dictree-size dict)))
3204 (message "Dumping keys from %s to %s...(key 1 of %d)"
3205 (dictree-name dict) (buffer-name buffer) dictsize)
3207 ;; map dump function over dictionary
3209 (lambda (key data plist)
3210 (when (= 99 (mod count 100))
3211 (message "Dumping keys from %s to %s...(key %d of %d)"
3212 (dictree-name dict) (buffer-name buffer)
3213 (1+ count) dictsize))
3214 (insert (prin1-to-string
3215 (funcall (or (dictree--key-savefun dict) 'identity)
3218 (funcall (or (dictree--data-savefun dict) 'identity)
3220 (insert " " (prin1-to-string data)))
3222 (funcall (or (dictree--plist-savefun dict) 'identity)
3224 (unless data (insert " nil"))
3225 (insert " " (prin1-to-string plist)))
3227 (setq count (1+ count)))
3228 dict type) ; dictree-mapc target
3230 (message "Dumping keys from %s to %s...done"
3231 (dictree-name dict) (buffer-name buffer)))
3232 (switch-to-buffer buffer))
3236 (defun dictree-dump-to-file (dict filename &optional type overwrite)
3237 "Dump keys and their associated data
3238 from dictionary DICT to a text file FILENAME, in the same format
3239 as that used by `dictree-populate-from-file'. Prompts to overwrite
3240 FILENAME if it already exists, unless OVERWRITE is non-nil.
3242 TYPE determines the type of sequence to use to represent the
3243 keys, and should be one of 'string, 'vector or 'list. The default
3246 Note that if the data does not have a read syntax and no , the dumped
3247 data can not be used to recreate the dictionary using
3248 `dictree-populate-from-file'.
3250 Interactively, DICT and FILE are read from the mini-buffer,
3251 OVERWRITE is the prefix argument, and TYPE is always 'string."
3252 (interactive (list (read-dict "Dictionary: ")
3253 (read-file-name "File to dump to: " nil "")))
3254 (when (and (called-interactively-p 'any) (symbolp dict))
3255 (setq dict (eval dict)))
3257 (if (and (called-interactively-p 'any) (string= filename ""))
3258 (message "Dictionary %s NOT dumped" (dictree-name dict))
3260 ;; check if file exists, and prompt to overwrite it if necessary
3261 (if (and (file-exists-p filename)
3264 (format "File %s already exists. Overwrite? "
3266 (message "Key dump cancelled")
3269 ;; create temporary buffer, dump keys to it, and save to
3271 (setq buff (generate-new-buffer filename))
3272 (save-window-excursion
3273 (dictree-dump-to-buffer dict buff type)
3274 (write-file filename))
3275 (kill-buffer buff)))))
3280 ;; ----------------------------------------------------------------
3281 ;; Minibuffer completion
3283 (defvar dictree-history nil
3284 "History list for commands that read a dictionary name.")
3286 (defvar dictree-loaded-history nil
3287 "History list for commands that read a loaded dictionary name.")
3292 (prompt &optional default dictlist allow-unloaded allow-unmatched)
3293 "Read the name of a dictionary with completion, and return it.
3295 Prompt with PROMPT. By default, return DEFAULT. If DICTLIST is
3296 supplied, only complete on dictionaries in that list.
3298 If ALLOW-UNLOADED is non-nil, also complete on the names of
3299 unloaded dictionaries (actually, on any Elisp file in the current
3300 `load-path' restricted to subdirectories of your home directory
3301 whose file name starts with \"dict-\"). If an unloaded dictionary
3302 is read, the name of the Elisp file will be returned, without
3303 extension, suitable for passing to `load-library'."
3305 (let (dictname paths)
3306 ;; when allowing unloaded dictionaries...
3307 (when allow-unloaded
3308 ;; get paths in load-path that are subdirectories of home
3310 (dolist (d load-path)
3311 (when (eq (aref d 0) ?~) (push d paths)))
3312 ;; gather names of all Elisp libraries in this restricted
3314 (dolist (f (all-completions
3315 "" (apply-partially 'locate-file-completion-table
3316 paths (get-load-suffixes))))
3317 (when (and (null (file-name-directory f))
3318 (and (> (length f) 5)
3319 (string= (substring f 0 5) "dict-"))
3320 (null (file-name-extension f))
3321 (not (member (file-name-sans-extension f) dictname)))
3322 (push (file-name-sans-extension f) dictname))))
3323 ;; gather names of loaded dictionaries
3324 (mapc (lambda (dict)
3325 (unless (or (null (dictree-name dict))
3326 (member (dictree-name dict) dictname))
3327 (push (list (dictree-name dict)) dictname)))
3328 (or dictlist dictree-loaded-list))
3329 ;; do completing-read
3330 (setq dictname (completing-read
3333 (completion-table-in-turn
3334 dictname 'read-file-name-internal)
3336 nil (not allow-unmatched) nil
3339 'dictree-loaded-history)
3340 (and (dictree-p default) (dictree-name default))))
3341 ;; return dictionary
3343 ;; if user typed a file name, return that
3344 ((and allow-unmatched (file-regular-p dictname)) dictname)
3345 ;; if user selected a loaded dictionary, return dict itself
3346 ((condition-case nil
3347 (dictree-p (eval (intern-soft dictname)))
3348 (void-variable nil))
3349 (intern-soft dictname))
3350 ;; if user selected an unloaded dictionary, return dict name
3351 ((and allow-unloaded (stringp dictname)) dictname)
3352 ;; if DEFAULT was specified, return that
3354 ;; should never get here!
3355 (t (error "Unknown error reading dictionary")))
3360 ;; ----------------------------------------------------------------
3361 ;; Pretty-print dictionaries during edebug
3363 ;; We advise the `edebug-prin1' and `edebug-prin1-to-string' functions
3364 ;; (actually, aliases) so that they print "#<dict-tree NAME>" instead of
3365 ;; the full print form for dictionaries.
3367 ;; This is because, if left to its own devices, edebug hangs for ages
3368 ;; whilst printing large dictionaries, and you either have to wait for a
3369 ;; *very* long time for it to finish, or kill Emacs entirely. (Even C-g
3372 ;; We do this also for lists of dictionaries, since those occur quite
3373 ;; often, but not for other sequence types or deeper nested structures,
3374 ;; to keep the implementation as simple as possible.
3376 ;; Since the print form of a dictionary is practically incomprehensible
3377 ;; anyway, we don't lose much by doing this. If you *really* want to
3378 ;; print dictionaries in full whilst edebugging, despite this warning,
3379 ;; disable the advice.
3381 ;; FIXME: Should use `cedet-edebug-prin1-extensions' instead of advice
3382 ;; when `cedet-edebug' is loaded, though I believe this still
3383 ;; works in that case.
3391 (defun dictree--edebug-pretty-print (object)
3394 (concat "#<dict-tree \"" (dictree-name object) "\">"))
3395 ((null object) "nil")
3396 ((let ((dlist object) (test t))
3397 (while (or (dictree-p (car-safe dlist))
3398 (and dlist (setq test nil)))
3399 (setq dlist (cdr dlist)))
3401 (concat "(" (mapconcat (lambda (d)
3402 (concat "#<dict-tree \""
3403 (dictree-name d) "\">"))
3405 ;; ((vectorp object)
3406 ;; (let ((pretty "[") (len (length object)))
3407 ;; (dotimes (i (1- len))
3410 ;; (if (trie-p (aref object i))
3411 ;; "#<trie>" (prin1-to-string (aref object i))) " ")))
3413 ;; (if (trie-p (aref object (1- len)))
3414 ;; "#<trie>" (prin1-to-string (aref object (1- len))))
3419 (when (fboundp 'ad-define-subr-args)
3420 (ad-define-subr-args 'edebug-prin1 '(object &optional printcharfun)))
3422 (defadvice edebug-prin1
3423 (around dictree activate compile preactivate)
3424 (let ((pretty (dictree--edebug-pretty-print object)))
3427 (prin1 pretty printcharfun)
3428 (setq ad-return-value pretty))
3432 (when (fboundp 'ad-define-subr-args)
3433 (ad-define-subr-args 'edebug-prin1-to-string '(object &optional noescape)))
3435 (defadvice edebug-prin1-to-string
3436 (around dictree activate compile preactivate)
3437 (let ((pretty (dictree--edebug-pretty-print object)))
3439 (setq ad-return-value pretty)
3444 (provide 'dict-tree)
3446 ;;; dict-tree.el ends here