[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master a7732cf: * externals-list: Convert `dict-tree` from subtre
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master a7732cf: * externals-list: Convert `dict-tree` from subtree to external |
|
Date: |
Mon, 14 Dec 2020 12:22:39 -0500 (EST) |
branch: master
commit a7732cf7000cda62089039621c91af4b4d0d14cf
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* externals-list: Convert `dict-tree` from subtree to external
---
externals-list | 1 +
packages/dict-tree/dict-tree.el | 4115 ---------------------------------------
2 files changed, 1 insertion(+), 4115 deletions(-)
diff --git a/externals-list b/externals-list
index 4910dae..c6549d6 100644
--- a/externals-list
+++ b/externals-list
@@ -97,6 +97,7 @@
("dbus-codegen" :external "https://github.com/ueno/dbus-codegen-el.git";)
("debbugs" :external nil)
("delight" :external "https://git.savannah.gnu.org/r/delight.git";)
+ ("dict-tree" :external "http://www.dr-qubit.org/git/predictive.git";)
("diffview" :external
"https://github.com/mgalgs/diffview-mode.git";)
("diff-hl" :external "https://github.com/dgutov/diff-hl.git";)
("dired-du" :external nil)
diff --git a/packages/dict-tree/dict-tree.el b/packages/dict-tree/dict-tree.el
deleted file mode 100644
index 0930a34..0000000
--- a/packages/dict-tree/dict-tree.el
+++ /dev/null
@@ -1,4115 +0,0 @@
-;;; dict-tree.el --- Dictionary data structure -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2004-2015, 2017 Free Software Foundation, Inc
-
-;; Author: Toby Cubitt <toby-predictive@dr-qubit.org>
-;; Version: 0.14
-;; Keywords: extensions, matching, data structures
-;; trie, tree, dictionary, completion, regexp
-;; Package-Requires: ((trie "0.3") (tNFA "0.1.1") (heap "0.3"))
-;; URL: http://www.dr-qubit.org/emacs.php
-
-;; This file is part of Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify it under
-;; the terms of the GNU General Public License as published by the Free
-;; Software Foundation, either version 3 of the License, or (at your option)
-;; any later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
-;; more details.
-;;
-;; You should have received a copy of the GNU General Public License along
-;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-
-;;; Commentary:
-;;
-;; A dict-tree (created using `dictree-create') is used to store strings,
-;; along with arbitrary data associated with each string. (Note that the
-;; "strings" can be any sequence data type, not just Elisp strings.) As well
-;; as basic data insertion (`dictree-insert'), manipulation
-;; (`dictree-insert'), and retrieval (`dictree-lookup', `dictree-member-p'), a
-;; dict-tree can perform sophisticated queries on strings, including:
-;;
-;; - retrieve all completions of a prefix
-;; (`dictree-complete')
-;;
-;; - retrieve all strings that match a regular expression
-;; (`dictree-regexp-search')
-;;
-;; - retrieve all fuzzy matches to a string, i.e. matches within a specified
-;; Lewenstein distance (a.k.a. edit distance)
-;; (`dictree-fuzzy-match')
-;;
-;; - retrieve all fuzzy completions of a prefix, i.e. completions of prefixes
-;; within a specified Lewenstein distance
-;; (`dictree-fuzzy-complete')
-;;
-;; The results of all of these queries can be ranked in alphabetical order, or
-;; according to any other desired ranking. The results can also be limited to
-;; a given number of matches.
-;;
-;; These sophisticated string queries are fast even for very large dict-trees,
-;; and dict-tree's also cache query results (and automatically keep these
-;; caches synchronised) to speed up queries even further.
-;;
-;; Other functions allow you to:
-;;
-;; - create dict-tree stack objects, which allow efficient access to the
-;; strings in the dictionary or in query results as though they were sorted
-;; on a stack (useful for designing efficient algorithms on top of
-;; dict-trees)
-;; (`dictree-stack', `dictree-complete-stack', `dictree-regexp-stack',
-;; `dictree-fuzzy-match-stack', `dictree-fuzzy-complete-stack')
-;;
-;; - generate dict-tree iterator objects which allow you to retrieve
-;; successive elements by calling `iter-next'
-;; (`dictree-iter', `dictree-complete-iter', `dictree-regexp-iter',
-;; `dictree-fuzzy-match-iter', `dictree-fuzzy-complete-iter')
-;;
-;; - map over all strings in alphabetical order
-;; (`dictree-mapc', `dictree-mapcar' and `dictree-mapf')
-;;
-;; Dict-trees can be combined together into a "meta dict-tree", which combines
-;; the data from identical keys in its constituent dict-trees, in whatever way
-;; you specify (`dictree-create-meta-dict'). Any number of dict-trees can be
-;; combined in this way. Meta-dicts behave *exactly* like dict-trees: all of
-;; the above functions work on meta-dicts as well as dict-trees, and
-;; meta-dicts can themselves be used in new meta-dicts.
-;;
-;; The package also provides persistent storage of dict-trees to file.
-;; (`dictree-save', `dictree-write', `dictee-load')
-;;
-;; This package uses the trie package trie.el, the tagged NFA package tNFA.el,
-;; and the heap package heap.el.
-
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'trie)
-(require 'tNFA)
-
-
-;;; ================================================================
-;;; Replacements for CL and Elisp functions
-
-;; copied from cl-extra.el
-(defun dictree--subseq (seq start &optional end)
- "Return the subsequence of SEQ from START to END.
-If END is omitted, it defaults to the length of the sequence.
-If START or END is negative, it counts from the end."
- (if (stringp seq) (substring seq start end)
- (let (len)
- (and end (< end 0) (setq end (+ end (setq len (length seq)))))
- (when (< start 0)
- (setq start (+ start (or len (setq len (length seq))))))
- (cond ((listp seq)
- (if (> start 0) (setq seq (nthcdr start seq)))
- (if end
- (let ((res nil))
- (while (>= (setq end (1- end)) start)
- (push (pop seq) res))
- (nreverse res))
- (copy-sequence seq)))
- (t
- (or end (setq end (or len (length seq))))
- (let ((res (make-vector (max (- end start) 0) nil))
- (i 0))
- (while (< start end)
- (aset res i (aref seq start))
- (setq i (1+ i) start (1+ start)))
- res))))))
-
-
-
-;; `goto-line' without messing around with mark and messages
-(defun dictree--goto-line (line)
- "Goto line LINE, counting from line 1 at beginning of buffer."
- (goto-char 1)
- (if (eq selective-display t)
- (re-search-forward "[\n\C-m]" nil 'no-error (1- line))
- (forward-line (1- line))))
-
-
-
-
-;;; ====================================================================
-;;; Internal functions and variables for use in the dictionary package
-
-(defvar dictree-loaded-list nil
- "Stores list of loaded dictionaries.")
-
-
-;; ----------------------------------------------------------------
-;; Dictionary data cell structures
-
-;; Note: It would be more elegant to use a defstruct for the data cells,
-;; but the problem is that the resulting setf in
-;; `dictree--wrap-insfun' won't get expanded into the cell-data
-;; accessor function at compile-time because it's burried inside a
-;; backquote construct. Not only is it inelegant to have to expand
-;; macros at run-time whenever `dictree--wrap-insfun' is called,
-;; but it also requires the 'cl-macs package to be loaded at
-;; run-time rather than just at compile-time. We could use
-;; `lexical-let' instead, but it doesn't seem worth it here.
-
-;; wrap data in a cons cell
-(defalias 'dictree--cell-create 'cons) ; INTERNAL USE ONLY
-
-;; get data component from data cons cell
-(defalias 'dictree--cell-data 'car) ; INTERNAL USE ONLY
-
-;; get property list component from data cons cell
-(defalias 'dictree--cell-plist 'cdr) ; INTERNAL USE ONLY
-
-;; set data component of data cons cell
-(defalias 'dictree--cell-set-data 'setcar) ; INTERNAL USE ONLY
-
-;; set property list component of data cons cell
-(defalias 'dictree--cell-set-plist 'setcdr) ; INTERNAL USE ONLY
-
-;; define setf methods so we can use setf abstraction wherever possible
-(defsetf dictree--cell-data dictree--cell-set-data)
-(defsetf dictree--cell-plist dictree--cell-set-plist)
-
-
-;; ----------------------------------------------------------------
-;; Dictionary cache entry structures
-
-;; Note: We *could* use a defstruct for the cache entries, but for
-;; something this simple it doesn't seem worth it, especially
-;; given that we're using the defalias approach anyway for the
-;; data cells (above).
-
-;; Construct and return a completion cache entry
-(defalias 'dictree--cache-create 'cons) ; INTERNAL USE ONLY
-
-;; Return the completions list for cache entry CACHE
-(defalias 'dictree--cache-results 'car) ; INTERNAL USE ONLY
-
-;; Return the max number of completions returned for cache entry CACHE
-(defalias 'dictree--cache-maxnum 'cdr) ; INTERNAL USE ONLY
-
-;; Set the completions list for cache entry CACHE
-(defalias 'dictree--cache-set-results 'setcar) ; INTERNAL USE ONLY
-
-;; Set the completions list for cache entry CACHE
-(defalias 'dictree--cache-set-maxnum 'setcdr) ; INTERNAL USE ONLY
-
-;; define setf methods so we can use setf abstraction wherever possible
-(defsetf dictree--cache-results dictree--cache-set-results)
-(defsetf dictree--cache-maxnum dictree--cache-set-maxnum)
-
-
-
-;; ----------------------------------------------------------------
-;; Wrapping functions
-
-;; return wrapped insfun to deal with data wrapping
-(trie--if-lexical-binding
- (defun dictree--wrap-insfun (insfun) ; INTERNAL USE ONLY
- (lambda (new old)
- (dictree--cell-set-data old (funcall insfun
- (dictree--cell-data new)
- (dictree--cell-data old)))
- old))
- (defun dictree--wrap-insfun (insfun) ; INTERNAL USE ONLY
- `(lambda (new old)
- (dictree--cell-set-data old (,insfun (dictree--cell-data new)
- (dictree--cell-data old)))
- old)))
-
-
-;; return wrapped rankfun to deal with data wrapping
-(trie--if-lexical-binding
- (defun dictree--wrap-rankfun (rankfun) ; INTERNAL USE ONLY
- (lambda (a b)
- (funcall rankfun
- (cons (car a) (dictree--cell-data (cdr a)))
- (cons (car b) (dictree--cell-data (cdr b))))))
- (defun dictree--wrap-rankfun (rankfun) ; INTERNAL USE ONLY
- `(lambda (a b)
- (,rankfun (cons (car a) (dictree--cell-data (cdr a)))
- (cons (car b) (dictree--cell-data (cdr b)))))))
-
-
-;; return wrapped rankfun to ignore regexp grouping data
-(trie--if-lexical-binding
- (defun dictree--wrap-regexp-rankfun (rankfun)
- (lambda (a b)
- ;; if car of argument contains a key+group list rather than a straight
- ;; key, remove group list
- ;; FIXME: the test for straight key, below, will fail if the key is a
- ;; list, and the first element of the key is itself a list
- ;; (there might be no easy way to fully fix this...)
- (if (or (atom (car a))
- (and (listp (car a)) (not (sequencep (caar a)))))
- (setq a (cons (car a) (dictree--cell-data (cdr a))))
- (setq a (cons (caar a) (dictree--cell-data (cdr a)))))
- (if (or (atom (car b))
- (and (listp (car b)) (not (sequencep (caar b)))))
- (setq b (cons (car b) (dictree--cell-data (cdr b))))
- (setq b (cons (caar b) (dictree--cell-data (cdr b)))))
- (funcall rankfun a b)))
- (defun dictree--wrap-regexp-rankfun (rankfun)
- `(lambda (a b)
- ;; if car of argument contains a key+group list rather than a straight
- ;; key, remove group list
- ;; FIXME: the test for straight key, below, will fail if the key is a
- ;; list, and the first element of the key is itself a list
- ;; (there might be no easy way to fully fix this...)
- (if (or (atom (car a))
- (and (listp (car a)) (not (sequencep (caar a)))))
- (setq a (cons (car a) (dictree--cell-data (cdr a))))
- (setq a (cons (caar a) (dictree--cell-data (cdr a)))))
- (if (or (atom (car b))
- (and (listp (car b)) (not (sequencep (caar b)))))
- (setq b (cons (car b) (dictree--cell-data (cdr b))))
- (setq b (cons (caar b) (dictree--cell-data (cdr b)))))
- (,rankfun a b))))
-
-;; return wrapped sortfun to ignore regexp grouping data
-(trie--if-lexical-binding
- (defun dictree--wrap-regexp-sortfun (cmpfun &optional reverse)
- (let ((sortfun (trie-construct-sortfun cmpfun reverse)))
- (lambda (a b)
- ;; if car of argument contains a key+group list rather than a
- ;; straight key, remove group list
- ;; FIXME: the test for straight key, below, will fail if the key
- ;; is a list, and the first element of the key is itself a
- ;; list (there might be no easy way to fully fix this...)
- (if (or (atom (car a))
- (and (listp (car a)) (not (sequencep (caar a)))))
- (setq a (car a))
- (setq a (caar a)))
- (if (or (atom (car b))
- (and (listp (car b)) (not (sequencep (caar b)))))
- (setq b (car b))
- (setq b (caar b)))
- (funcall sortfun a b))))
- (defun dictree--wrap-regexp-sortfun (cmpfun &optional reverse)
- (let ((sortfun (trie-construct-sortfun cmpfun reverse)))
- `(lambda (a b)
- ;; if car of argument contains a key+group list rather than a
- ;; straight key, remove group list
- ;; FIXME: the test for straight key, below, will fail if the key
- ;; is a list, and the first element of the key is itself a
- ;; list (there might be no easy way to fully fix this...)
- (if (or (atom (car a))
- (and (listp (car a)) (not (sequencep (caar a)))))
- (setq a (car a))
- (setq a (caar a)))
- (if (or (atom (car b))
- (and (listp (car b)) (not (sequencep (caar b)))))
- (setq b (car b))
- (setq b (caar b)))
- (,sortfun a b)))))
-
-
-;; return wrapped rankfun to ignore fuzzy query distance data
-(trie--if-lexical-binding
- (defun dictree--wrap-fuzzy-rankfun (rankfun) ; INTERNAL USE ONLY
- (lambda (a b)
- (funcall rankfun
- (cons (nth 0 (car a)) (dictree--cell-data (cdr a)))
- (cons (nth 0 (car b)) (dictree--cell-data (cdr b))))))
- (defun dictree--wrap-fuzzy-rankfun (rankfun) ; INTERNAL USE ONLY
- `(lambda (a b)
- (,rankfun (cons (nth 0 (car a)) (dictree--cell-data (cdr a)))
- (cons (nth 0 (car b)) (dictree--cell-data (cdr b)))))))
-
-;; return wrapped sortfun to ignore fuzzy query distance data
-(trie--if-lexical-binding
- (defun dictree--wrap-fuzzy-sortfun (cmpfun &optional reverse)
- (let ((sortfun (trie-construct-sortfun cmpfun reverse)))
- (lambda (a b) (funcall sortfun (car a) (car b)))))
- (defun dictree--wrap-fuzzy-sortfun (cmpfun &optional reverse)
- (let ((sortfun (trie-construct-sortfun cmpfun reverse)))
- `(lambda (a b) (,sortfun (car a) (car b))))))
-
-
-;; return wrapped combfun to deal with data wrapping
-(trie--if-lexical-binding
- (defun dictree--wrap-combfun (combfun) ; INTERNAL USE ONLY
- (lambda (cell1 cell2)
- (dictree--cell-create
- (funcall combfun
- (dictree--cell-data cell1)
- (dictree--cell-data cell2))
- (append (dictree--cell-plist cell1)
- (dictree--cell-plist cell2)))))
- (defun dictree--wrap-combfun (combfun) ; INTERNAL USE ONLY
- `(lambda (cell1 cell2)
- (dictree--cell-create
- (,combfun (dictree--cell-data cell1)
- (dictree--cell-data cell2))
- (append (dictree--cell-plist cell1)
- (dictree--cell-plist cell2))))))
-
-
-;; return wrapped filter function to deal with data wrapping
-(trie--if-lexical-binding
- (defun dictree--wrap-filter (filter) ; INTERNAL USE ONLY
- (lambda (key data) (funcall filter key (dictree--cell-data data))))
- (defun dictree--wrap-filter (filter) ; INTERNAL USE ONLY
- `(lambda (key data) (,filter key (dictree--cell-data data)))))
-
-
-;; return wrapped result function to deal with data wrapping
-(trie--if-lexical-binding
- (defun dictree--wrap-resultfun (resultfun) ; INTERNAL USE ONLY
- (lambda (res)
- (funcall resultfun (car res) (dictree--cell-data (cdr res)))))
- (defun dictree--wrap-resultfun (resultfun) ; INTERNAL USE ONLY
- `(lambda (res) (,resultfun (car res) (dictree--cell-data (cdr res))))))
-
-
-;; construct lexicographic sort function from DICT's comparison function
-(trie--if-lexical-binding
- (defun dictree--construct-sortfun (dict) ; INTERNAL USE ONLY
- (let ((sortfun (trie-construct-sortfun
- (dictree-comparison-function dict))))
- (lambda (a b) (funcall sortfun (car a) (car b)))))
- (defun dictree--construct-sortfun (dict) ; INTERNAL USE ONLY
- `(lambda (a b)
- (,(trie-construct-sortfun (dictree-comparison-function (car dict)))
- (car a) (car b)))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; The dictionary data structures
-
-(defstruct
- (dictree-
- :named
- (:constructor nil)
- (:constructor dictree--create
- (&optional
- filename
- (name (and filename
- (file-name-sans-extension
- (file-name-nondirectory filename))))
- autosave
- _unlisted
- (comparison-function #'<)
- (insert-function (lambda (a _b) a))
- (rank-function (lambda (a b) (> (cdr a) (cdr b))))
- (cache-policy 'time)
- cache-threshold
- (cache-update-policy 'synchronize)
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- (trie-type 'avl)
- &aux
- (modified nil)
- (trie (make-trie comparison-function trie-type))
- (lookup-cache nil)
- (complete-cache nil)
- (regexp-cache nil)
- (fuzzy-match-cache nil)
- (fuzzy-complete-cache nil)
- (meta-dict-list nil)
- ))
- (:constructor dictree--create-custom
- (&optional
- filename
- (name (and filename
- (file-name-sans-extension
- (file-name-nondirectory filename))))
- autosave
- _unlisted
- (comparison-function #'<)
- (insert-function (lambda (a _b) a))
- (rank-function (lambda (a b) (> (cdr a) (cdr b))))
- (cache-policy 'time)
- cache-threshold
- (cache-update-policy 'synchronize)
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- &key
- createfun insertfun deletefun
- lookupfun mapfun emptyfun
- stack-createfun stack-popfun stack-emptyfun
- transform-for-print transform-from-read
- &aux
- (modified nil)
- (trie (make-trie-custom
- comparison-function
- :createfun createfun
- :insertfun insertfun
- :deletefun deletefun
- :lookupfun lookupfun
- :mapfun mapfun
- :emptyfun emptyfun
- :stack-createfun stack-createfun
- :stack-popfun stack-popfun
- :stack-emptyfun stack-emptyfun
- :transform-for-print transform-for-print
- :transform-from-read transform-from-read))
- (lookup-cache nil)
- (complete-cache nil)
- (regexp-cache nil)
- (fuzzy-match-cache nil)
- (fuzzy-complete-cache nil)
- (meta-dict-list nil)
- ))
- (:copier dictree--copy))
- name filename autosave modified
- comparison-function insert-function rank-function
- cache-policy cache-threshold cache-update-policy
- lookup-cache complete-cache regexp-cache
- fuzzy-match-cache fuzzy-complete-cache
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- trie meta-dict-list)
-
-
-(defstruct
- (dictree--meta-dict
- :named
- (:constructor nil)
- (:constructor dictree--meta-dict-create
- (dictionary-list
- &optional
- filename
- (name (when filename
- (file-name-sans-extension
- (file-name-nondirectory filename))))
- autosave
- _unlisted
- (combine-function #'+)
- (cache-policy 'time)
- cache-threshold
- (cache-update-policy 'synchronize)
- &aux
- (dictlist
- (mapcar
- (lambda (dic)
- (cond
- ((dictree-p dic) dic)
- ((symbolp dic) (symbol-value dic))
- (t (error "Invalid object in DICTIONARY-LIST"))))
- dictionary-list))
- (lookup-cache nil)
- (complete-cache nil)
- (regexp-cache nil)
- (fuzzy-match-cache nil)
- (fuzzy-complete-cache nil)
- ))
- (:copier dictree--meta-dict-copy))
- name filename autosave modified combine-function
- cache-policy cache-threshold cache-update-policy
- lookup-cache complete-cache regexp-cache
- fuzzy-match-cache fuzzy-complete-cache
- dictlist meta-dict-list)
-
-
-
-
-;; ----------------------------------------------------------------
-;; Miscelaneous internal functions and macros
-
-(defun dictree--trielist (dict)
- ;; Return a list of all the tries on which DICT is based. If DICT is a
- ;; meta-dict, this recursively descends the hierarchy, gathering all
- ;; the tries from the base dictionaries.
- (dictree--do-trielist dict))
-
-(defun dictree--do-trielist (dict)
- (if (dictree-meta-dict-p dict)
- (apply #'nconc (mapcar #'dictree--do-trielist
- (dictree--meta-dict-dictlist dict)))
- (list (dictree--trie dict))))
-
-
-(defun dictree--merge (list1 list2 cmpfun &optional combfun maxnum)
- ;; Destructively merge together sorted lists LIST1 and LIST2, sorting
- ;; elements according to CMPFUN. For non-null MAXNUM, only the first
- ;; MAXNUM are kept. For non-null COMBFUN, duplicate elements will be
- ;; merged by passing the two elements as arguments to COMBFUN, and
- ;; using the return value as the merged element.
- (or (listp list1) (setq list1 (append list1 nil)))
- (or (listp list2) (setq list2 (append list2 nil)))
- (let (res (i 0))
-
- ;; build up result list backwards
- (while (and list1 list2 (or (null maxnum) (< (incf i) maxnum)))
- ;; move smaller element to result list
- (if (funcall cmpfun (car list1) (car list2))
- (push (pop list1) res)
- (if (funcall cmpfun (car list2) (car list1))
- (push (pop list2) res)
- ;; if elements are equal, merge them for non-null COMBFUN
- (if combfun
- (push (funcall combfun (pop list1) (pop list2))
- res)
- ;; otherwise, add both to result list, in order
- (push (pop list1) res)
- (push (pop list2) res)))))
-
- ;; return result if we already have MAXNUM entries
- (if (and maxnum (= i maxnum))
- (nreverse res)
- ;; otherwise, return result plus enough leftover entries to make
- ;; up MAXNUM (only one of list1 or list2 will be non-nil)
- (let (tmp)
- (or (null maxnum)
- (and (setq tmp (nthcdr (- maxnum i 1) list1))
- (setcdr tmp nil))
- (and (setq tmp (nthcdr (- maxnum i 1) list2))
- (setcdr tmp nil)))
- (nconc (nreverse res) list1 list2)))
- ))
-
-
-;; (defun dictree--merge-sort (list sortfun &optional combfun)
-;; ;; Destructively sort LIST according to SORTFUN, combining
-;; ;; identical elements using COMBFUN if supplied.
-;; (dictree--do-merge-sort list (/ (length list) 2) sortfun combfun))
-
-
-;; (defun dictree--do-merge-sort (list1 len sortfun combfun)
-;; ;; Merge sort LIST according to SORTFUN, combining identical
-;; ;; elements using COMBFUN.
-;; (let* ((p (nthcdr (1- len) list1))
-;; (list2 (cdr p)))
-;; (setcdr p nil)
-;; (dictree--merge
-;; (dictree--do-merge-sort list1 (/ len 2) sortfun combfun)
-;; (dictree--do-merge-sort list2 (/ len 2) sortfun combfun)
-;; sortfun combfun)))
-
-
-
-
-;;; ================================================================
-;;; The (mostly) public functions which operate on dictionaries
-
-;;;###autoload
-(defun make-dictree
- (&optional
- name filename autosave unlisted
- comparison-function insert-function rank-function
- cache-policy cache-threshold cache-update-policy
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- trie-type)
- "Create an empty dictionary and return it.
-
-If NAME is supplied, the dictionary is stored in the variable
-NAME. Defaults to FILENAME stripped of directory and
-extension. (Regardless of the value of NAME, the dictionary will
-be stored in the default variable name when it is reloaded from
-file.)
-
-FILENAME supplies a directory and file name to use when saving
-the dictionary. If the AUTOSAVE flag is non-nil, then the
-dictionary will automatically be saved to this file when it is
-unloaded or when exiting Emacs.
-
-If UNLISTED is non-nil, the dictionary will not be added to the
-list of loaded dictionaries. Note that this disables autosaving.
-
-COMPARE-FUNCTION sets the function used to compare elements of
-the keys. It should take two arguments, A and B, both of the type
-contained by the sequences used as keys \(e.g. if the keys will
-be strings, the function will be passed two characters\). It
-should return t if the first is \"less than\" the
-second. Defaults to `<'.
-
-INSERT-FUNCTION sets the function used to insert data into the
-dictionary. It should take two arguments: the new data, and the
-data already in the dictionary, and should return the data to
-insert. Defaults to replacing any existing data with the new
-data.
-
-RANK-FUNCTION sets the function used to rank the results of
-`dictree-complete'. It should take two arguments, each a cons
-whose car is a dictree key (a sequence) and whose cdr is the data
-associated with that key. It should return non-nil if the first
-argument is \"better\" than the second, nil otherwise. It
-defaults to \"lexicographic\" comparison of the keys, ignoring
-the data \(which is not very useful, since an unranked
-`dictree-complete' query already does this much more
-efficiently\).
-
-CACHE-POLICY should be a symbol (`time', `length',
-`time-and-length' or `time-or-length'), which determines which
-query operations are cached. The `time' setting caches queries
-that take longer (in seconds) than the CACHE-THRESHOLD value.
-
-The `length' setting caches query operations based on the length
-of the string involved the query. For this setting, CACHE-POLICY
-should be a plist with properties :long and :short. Lookups,
-fuzzy matches, and regexp queries that do not end in \".*\" will
-be cached if the string is longer than the :long value (since
-long strings are likely to be the slower ones in these
-cases). Completions, fuzzy completions, and regexp queries that
-end in \".*\" will be cached if the string or regexp is shorter
-than the :short value \(since short strings are likely to be the
-slower ones for those cases\).
-
-The `time-and-length' setting only caches results if both
-conditions are satisfied simultaneously, whereas the
-`time-or-length' setting caches results if either condition is
-satisfied. For these settings, CACHE-THRESHOLD must be a plist
-with properties :time, :long and :short, specifying the
-corresponding cache thresholds.
-
-CACHE-THRESHOLD defaults to nil. The values nil and t are
-special. If CACHE-THRESHOLD is set to nil, no caching is done. If
-it is t, everything is cached for that type of query \(similar
-behaviour can be obtained by setting the a `time' CACHE-THRESHOLD
-of 0, but it is better to use t\).
-
-CACHE-UPDATE-POLICY should be a symbol (`synchronize' or
-`delete'), which determines how the caches are updated when data
-is inserted or deleted. The former updates tainted cache entries,
-which makes queries faster but insertion and deletion slower,
-whereas the latter deletes any tainted cache entries, which makes
-queries slower but insertion and deletion faster.
-
-KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN are functions used to
-convert keys, data and property lists into lisp objects that have
-a valid read syntax, for writing to file. DATA-SAVEFUN and
-PLIST-SAVEFUN are used when saving the dictionary (see
-`dictree-save' and `dictree-write'), and all three functions are
-used when dumping the contents of the dictionary \(see
-`dictree-dump-to-buffer' and `dictree-dump-to-file'\).
-KEY-SAVEFUN, DATA-SAVEFUN and PLIST-SAVEFUN should each accept
-one argument: a key, data or property list from DICT,
-respectively. They should return a lisp object which has a valid
-read syntax. When defining these functions, be careful not to
-accidentally modify the lisp object in the dictionary; usually,
-you will need to make a copy before converting it.
-
-KEY-LOADFUN, DATA-LOADFUN and PLIST-LOADFUN are used to convert
-keys, data and property lists back again when loading a
-dictionary (only DATA-LOADFUN and PLIST-LOADFUN, see
-`dictree-save' and `dictree-write') or populating it from a
-file (all three, see `dictree-populate-from-file'). They should
-accept one argument: a lisp object of the type produced by the
-corresponding SAVEFUN, and return a lisp object to use in the
-loaded dictionary.
-
-TRIE-TYPE sets the type of trie to use as the underlying data
-structure. See `trie-create' for details."
-
- ;; sadly, passing null values overrides the defaults in the defstruct
- ;; dictree--create, so we have to explicitly set the defaults again here
- (or name (setq name (and filename (make-symbol
- (file-name-sans-extension
- (file-name-nondirectory filename))))))
- (or comparison-function (setq comparison-function '<))
- (or insert-function (setq insert-function (lambda (a _b) a)))
- (or rank-function (setq rank-function (lambda (a b) (> (cdr a) (cdr b)))))
- (or cache-policy (setq cache-policy 'time))
- (or cache-update-policy (setq cache-update-policy 'synchronize))
- (or trie-type (setq trie-type 'avl))
-
- (let ((dict
- (dictree--create
- filename (when name (symbol-name name)) autosave unlisted
- comparison-function insert-function rank-function
- cache-policy cache-threshold cache-update-policy
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- trie-type)))
- ;; store dictionary in variable NAME
- (when name (set name dict))
- ;; add it to loaded dictionary list, unless it's unlisted
- (unless (or (null name) unlisted)
- (push dict dictree-loaded-list))
- dict))
-
-
-;;;###autoload
-(defalias 'dictree-create 'make-dictree)
-
-
-;;;###autoload
-(defun* make-dictree-custom
- (&optional
- name filename autosave unlisted
- &key
- comparison-function insert-function rank-function
- cache-policy cache-threshold cache-update-policy
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- createfun insertfun deletefun lookupfun mapfun emptyfun
- stack-createfun stack-popfun stack-emptyfun
- transform-for-print transform-from-read)
- "Create an empty dictionary and return it.
-
-The NAME through PLIST-LOADFUN arguments are as for
-`dictree-create' (which see).
-
-The remaining arguments control the type of trie to use as the
-underlying data structure. See `trie-create' for details."
-
- ;; sadly, passing null values over-rides the defaults in the defstruct
- ;; dictree--create, so we have to explicitly set the defaults again
- ;; here
- (or name (setq name (and filename (file-name-sans-extension
- (file-name-nondirectory filename)))))
- (or comparison-function (setq comparison-function #'<))
- (or insert-function (setq insert-function (lambda (a _b) a)))
- (or rank-function (setq rank-function (lambda (a b) (< (cdr a) (cdr b)))))
- (or cache-policy (setq cache-policy 'time))
- (or cache-update-policy (setq cache-update-policy 'synchronize))
-
- (let ((dict
- (dictree--create-custom
- filename (when name (symbol-name name)) autosave unlisted
- comparison-function insert-function rank-function
- cache-policy cache-threshold cache-update-policy
- key-savefun key-loadfun
- data-savefun data-loadfun
- plist-savefun plist-loadfun
- :createfun createfun
- :insertfun insertfun
- :deletefun deletefun
- :lookupfun lookupfun
- :mapfun mapfun
- :emptyfun emptyfun
- :stack-createfun stack-createfun
- :stack-popfun stack-popfun
- :stack-emptyfun stack-emptyfun
- :transform-for-print transform-for-print
- :transform-from-read transform-from-read)))
- ;; store dictionary in variable NAME
- (when name (set name dict))
- ;; add it to loaded dictionary list, unless it's unlisted
- (unless (or (null name) unlisted)
- (push dict dictree-loaded-list))
- dict))
-
-
-;;;###autoload
-(defalias 'dictree-create-custom 'make-dictree-custom)
-
-
-;;;###autoload
-(defun make-dictree-meta-dict
- (dictionary-list
- &optional
- name filename autosave unlisted
- combine-function
- cache-policy cache-threshold cache-update-policy)
- "Create a meta-dictionary based on the list of dictionaries
-in DICTIONARY-LIST.
-
-COMBINE-FUNCTION is used to combine data from different
-dictionaries. It is passed two pieces of data, each an
-association of the same key, but in different dictionaries. It
-should return a combined datum.
-
-The other arguments are as for `dictree-create'. Note that
-caching is only possible if NAME is supplied, otherwise the
-CACHE-THRESHOLD argument is ignored and caching is disabled."
-
- ;; sadly, passing null values over-rides the defaults in the defstruct
- ;; `dictree--create', so we have to explicitly set the defaults again
- ;; here
- (or name (setq name (and filename
- (file-name-sans-extension
- (file-name-nondirectory filename)))))
- (or combine-function (setq combine-function #'+))
- (or cache-policy (setq cache-policy 'time))
- (or cache-update-policy (setq cache-update-policy 'synchronize))
-
- (let ((dict
- (dictree--meta-dict-create
- dictionary-list filename (when name (symbol-name name))
- autosave unlisted
- combine-function
- cache-policy (when name cache-threshold) cache-update-policy
- )))
- ;; store dictionary in variable NAME
- (when name (set name dict))
- ;; add it to loaded dictionary list, unless it's unlisted
- (unless (or (null name) unlisted)
- (push dict dictree-loaded-list))
- ;; update meta-dict-list cells of constituent dictionaries
- (unless (or (null name) (not cache-threshold))
- (mapc
- (lambda (dic)
- (if (symbolp dic) (setq dic (symbol-value dic)))
- (setf (dictree--meta-dict-list dic)
- (cons dict (dictree--meta-dict-list dic))))
- dictionary-list))
- dict))
-
-(defalias 'dictree-create-meta-dict 'make-dictree-meta-dict)
-
-
-;;;###autoload
-(defun dictree-p (obj)
- "Return t if OBJ is a dictionary tree, nil otherwise."
- (or (dictree--p obj) (dictree--meta-dict-p obj)))
-
-
-(defalias 'dictree-meta-dict-p 'dictree--meta-dict-p
- "Return t if argument is a meta-dictionary, nil otherwise.")
-
-(defun dictree-empty-p (dict)
- "Return t if the dictionary DICT is empty, nil otherwise."
- (if (dictree--meta-dict-p dict)
- (catch 'nonempty
- (mapc (lambda (dic)
- (if (not (dictree-empty-p dic)) (throw 'nonempty t)))
- (dictree--meta-dict-dictlist dict)))
- (trie-empty (dictree--trie dict))))
-
-(defsubst dictree-autosave (dict)
- "Return dictionary's autosave flag."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-autosave dict)
- (dictree--autosave dict)))
-
-(defsetf dictree-autosave (dict) (val)
- ;; setf method for dictionary autosave flag
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-autosave ,dict) ,val)
- (setf (dictree--autosave ,dict) ,val)))
-
-(defsubst dictree-modified (dict)
- "Return dictionary's modified flag."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-modified dict)
- (dictree--modified dict)))
-
-(defsetf dictree-modified (dict) (val)
- ;; setf method for dictionary modified flag
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-modified ,dict) ,val)
- (setf (dictree--modified ,dict) ,val)))
-
-(defsubst dictree-name (dict)
- "Return dictionary DICT's name."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-name dict)
- (dictree--name dict)))
-
-(defsetf dictree-name (dict) (name)
- ;; setf method for dictionary name
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-name ,dict) ,name)
- (setf (dictree--name ,dict) ,name)))
-
-(defsubst dictree-filename (dict)
- "Return dictionary DICT's associated file name."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-filename dict)
- (dictree--filename dict)))
-
-(defsetf dictree-filename (dict) (filename)
- ;; setf method for dictionary filename
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-filename ,dict) ,filename)
- (setf (dictree--filename ,dict) ,filename)))
-
-(defun dictree-comparison-function (dict)
- "Return dictionary DICT's comparison function."
- (if (dictree--meta-dict-p dict)
- (dictree-comparison-function
- (car (dictree--meta-dict-dictlist dict)))
- (dictree--comparison-function dict)))
-
-(defalias 'dictree-insert-function 'dictree--insert-function
- "Return the insertion function for dictionary DICT.")
-
-(defun dictree-rank-function (dict)
- "Return the rank function for dictionary DICT"
- (if (dictree--meta-dict-p dict)
- (dictree-rank-function (car (dictree--meta-dict-dictlist dict)))
- (dictree--rank-function dict)))
-
-(defalias 'dictree-meta-dict-combine-function
- 'dictree--meta-dict-combine-function
- "Return the combine function for meta-dictionary DICT.")
-
-(defalias 'dictree-meta-dict-dictlist
- 'dictree--meta-dict-dictlist
- "Return the list of constituent dictionaries
-for meta-dictionary DICT.")
-
-(defsubst dictree-cache-policy (dict)
- "Return the cache policy for dictionary DICT."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-cache-policy dict)
- (dictree--cache-policy dict)))
-
-(defsubst dictree-cache-update-policy (dict)
- "Return the cache update policy for dictionary DICT."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-cache-update-policy dict)
- (dictree--cache-update-policy dict)))
-
-(defsubst dictree-cache-threshold (dict)
- "Return the cache threshold for dictionary DICT."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-cache-threshold dict)
- (dictree--cache-threshold dict)))
-
-(defsetf dictree-cache-threshold (dict) (param)
- ;; setf method for cache threshold
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-cache-threshold ,dict)
- ,param)
- (setf (dictree--cache-threshold ,dict)
- ,param)))
-
-
-(defun dictree-lookup-cache (dict)
- ;; Return the lookup cache for dictionary DICT.
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-lookup-cache dict)
- (dictree--lookup-cache dict)))
-
-(defsetf dictree-lookup-cache (dict) (param)
- ;; setf method for lookup cache
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-lookup-cache ,dict)
- ,param)
- (setf (dictree--lookup-cache ,dict)
- ,param)))
-
-(defun dictree-create-lookup-cache (dict)
- ;; Create DICT's lookup cache if it doesn't already exist.
- (unless (dictree-lookup-cache dict)
- (setf (dictree-lookup-cache dict)
- (make-hash-table :test 'equal))))
-
-
-(defun dictree-complete-cache (dict)
- ;; Return the completion cache for dictionary DICT.
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-complete-cache dict)
- (dictree--complete-cache dict)))
-
-(defsetf dictree-complete-cache (dict) (param)
- ;; setf method for complete cache
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-complete-cache ,dict)
- ,param)
- (setf (dictree--complete-cache ,dict)
- ,param)))
-
-(defun dictree-create-complete-cache (dict)
- ;; Create DICT's completion cache if it doesn't already exist.
- (unless (dictree-complete-cache dict)
- (setf (dictree-complete-cache dict)
- (make-hash-table :test 'equal))))
-
-
-(defun dictree-regexp-cache (dict)
- ;; Return the regexp cache for dictionary DICT.
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-regexp-cache dict)
- (dictree--regexp-cache dict)))
-
-(defsetf dictree-regexp-cache (dict) (param)
- ;; setf method for regexp cache
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-regexp-cache ,dict)
- ,param)
- (setf (dictree--regexp-cache ,dict)
- ,param)))
-
-(defun dictree-create-regexp-cache (dict)
- ;; Create DICT's regexp cache if it doesn't already exist.
- (unless (dictree-regexp-cache dict)
- (setf (dictree-regexp-cache dict)
- (make-hash-table :test 'equal))))
-
-
-(defun dictree-fuzzy-match-cache (dict)
- ;; Return the fuzzy match cache for dictionary DICT.
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-fuzzy-match-cache dict)
- (dictree--fuzzy-match-cache dict)))
-
-(defsetf dictree-fuzzy-match-cache (dict) (param)
- ;; setf method for fuzzy match cache
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-fuzzy-match-cache ,dict)
- ,param)
- (setf (dictree--fuzzy-match-cache ,dict)
- ,param)))
-
-(defun dictree-create-fuzzy-match-cache (dict)
- ;; Create DICT's fuzzy match cache if it doesn't already exist.
- (unless (dictree-fuzzy-match-cache dict)
- (setf (dictree-fuzzy-match-cache dict)
- (make-hash-table :test 'equal))))
-
-
-(defun dictree-fuzzy-complete-cache (dict)
- ;; Return the regexp cache for dictionary DICT.
- (if (dictree--meta-dict-p dict)
- (dictree--meta-dict-fuzzy-complete-cache dict)
- (dictree--fuzzy-complete-cache dict)))
-
-(defsetf dictree-fuzzy-complete-cache (dict) (param)
- ;; setf method for fuzzy completion cache
- `(if (dictree--meta-dict-p ,dict)
- (setf (dictree--meta-dict-fuzzy-complete-cache ,dict)
- ,param)
- (setf (dictree--fuzzy-complete-cache ,dict)
- ,param)))
-
-(defun dictree-create-fuzzy-complete-cache (dict)
- ;; Create DICT's fuzzy completion cache if it doesn't already exist.
- (unless (dictree-fuzzy-complete-cache dict)
- (setf (dictree-fuzzy-complete-cache dict)
- (make-hash-table :test 'equal))))
-
-
-
-
-
-;; ----------------------------------------------------------------
-;; Inserting and deleting data
-
-(defun dictree-insert (dict key &optional data insert-function)
- "Insert KEY and DATA into dictionary DICT.
-If KEY does not already exist, this creates it. How the data is
-inserted depends on the dictionary's insertion function \(see
-`dictree-create'\).
-
-The optional INSERT-FUNCTION over-rides the dictionary's own
-insertion function. If KEY already exists in DICT,
-INSERT-FUNCTION is called with two arguments: the data DATA, and
-the data associated with KEY in the dictionary. Its return value
-becomes the new association for KEY."
-
- ;; if dictionary is a meta-dictionary, insert key into all the
- ;; dictionaries it's based on
- (if (dictree--meta-dict-p dict)
- (mapc (lambda (dic)
- (dictree-insert dic key data insert-function))
- (dictree--meta-dict-dictlist dict))
-
- ;; otherwise...
- (let ((insfun (or (and insert-function
- (dictree--wrap-insfun insert-function))
- (dictree--wrap-insfun (dictree--insert-function dict))))
- olddata newdata)
- ;; set the dictionary's modified flag
- (setf (dictree-modified dict) t)
- ;; insert key in dictionary's ternary search tree
- (setq newdata
- (trie-insert
- (dictree--trie dict) key (dictree--cell-create data nil)
- (lambda (nd od)
- (setq olddata od)
- (funcall insfun nd od))))
- ;; update dictionary's caches
- (dictree--update-cache dict key olddata newdata)
- ;; update cache's of any meta-dictionaries based on dict
- (mapc (lambda (dic) (dictree--update-cache dic key olddata newdata))
- (dictree--meta-dict-list dict))
-
- ;; return the new data
- (dictree--cell-data newdata))))
-
-
-
-(defun dictree-delete (dict key &optional test)
- "Delete KEY from DICT.
-Returns non-nil if KEY was deleted, nil if KEY was not in DICT.
-
-If TEST is supplied, it should be a function that accepts three
-arguments: the key being deleted, its associated data, and its
-associated property list. The key will then only be deleted if
-TEST returns non-nil."
-
- (let ((dictree--delete-test test)
- olddata deleted del)
- (cond
- ;; if DICT is a meta-dictionary, delete KEY from all dictionaries
- ;; it's based on
- ((dictree--meta-dict-p dict)
- (dolist (dic (dictree--meta-dict-dictlist dict))
- (when (setq del (dictree-delete dic key))
- (setq deleted (cons del deleted))))
- (setf (dictree-modified dict) (and deleted t))
- (setq deleted (nreverse deleted)))
-
- ;; otherwise...
- (t
- (setq deleted
- (trie-delete (dictree--trie dict) key
- (lambda (k cell)
- (setq olddata (dictree--cell-data cell))
- (if dictree--delete-test
- (funcall dictree--delete-test
- k (dictree--cell-data cell)
- (dictree--cell-plist cell))
- t))))
- ;; if key was deleted, have to update the caches
- (when deleted
- (dictree--update-cache dict key olddata nil t)
- (setf (dictree-modified dict) t)
- ;; update cache's of any meta-dictionaries based on DICT
- (mapc (lambda (dic)
- (dictree--update-cache dic key olddata nil t))
- (dictree--meta-dict-list dict)))))
-
- ;; return deleted key/data pair
- (when deleted
- (cons (car deleted) (dictree--cell-data (cdr deleted))))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Cache updating
-
-(defun dictree--prefix-p (prefix str)
- "Return t if PREFIX is a prefix of STR, nil otherwise.
-
-PREFIX and STR can be any sequence type (string, vector, or
-list), but they must both be the same type. PREFIX can also be a
-list of sequences, in which case it returns t if any element of
-PREFIX is a prefix of STR."
- ;; wrap prefix in a list if necessary
- ;; FIXME: the test for a list of prefixes, below, will fail if the
- ;; PREFIX sequence is a list, and the elements of PREFIX are
- ;; themselves lists (there might be no easy way to fully fix
- ;; this...)
- (when (or (atom prefix)
- (and (listp prefix) (not (sequencep (car prefix)))))
- (setq prefix (list prefix)))
- (let (len)
- (catch 'is-prefix
- (dolist (pfx prefix)
- (setq len (length pfx))
- (when (and (<= len (length str))
- (equal pfx (dictree--subseq str 0 len)))
- (throw 'is-prefix t))))))
-
-
-(defun dictree--above-cache-threshold-p
- (time length policy threshold &optional cache-long-keys)
- ;; Return t if query taking TIME seconds for a key of length LENGTH
- ;; should be cached according to the cache POLICY and
- ;; THRESHOLD. Otherwise, return nil. Optional argument CACHE-LONG-KEYS
- ;; means that keys of length longer than THRESHOLD are to be
- ;; cached. Default is keys of length shorter than THRESHOLD.
- (and threshold
- (or (eq threshold t)
- (and (eq policy 'time) (>= time threshold))
- (and (eq policy 'length)
- (if cache-long-keys
- (>= length (plist-get threshold :long))
- (<= length (plist-get threshold :short))))
- (and (eq policy 'time-and-length)
- (>= time (plist-get threshold :time))
- (if cache-long-keys
- (>= length (plist-get threshold :long))
- (<= length (plist-get threshold :short))))
- (and (eq policy 'time-or-length)
- (or (>= time (plist-get threshold :time))
- (if cache-long-keys
- (>= length (plist-get threshold :long))
- (<= length (plist-get threshold :short))))))))
-
-
-
-(defun dictree--update-cache (dict key olddata newdata &optional deleted)
- ;; Synchronise dictionary DICT's caches, given that the data associated with
- ;; KEY has been updated from OLDDATA to NEWDATA, or KEY has been deleted if
- ;; DELETED is non-nil (NEWDATA is ignored in that case)."
- (when (dictree-cache-threshold dict)
-
- ;; synchronise lookup cache if dict is a meta-dictionary, since it doesn't
- ;; happen automatically for a meta-dict
- (when (dictree--meta-dict-p dict)
- (cond
- ;; updating dirty cache entries
- ((eq (dictree-cache-update-policy dict) 'synchronize)
- (when (and (dictree--lookup-cache dict)
- (gethash key (dictree--lookup-cache dict)))
- (if deleted
- (remhash key (dictree--lookup-cache dict))
- (puthash key newdata (dictree--lookup-cache dict)))))
- ;; deleting dirty cache entries
- (t (remhash key (dictree--lookup-cache dict)))))
-
- ;; synchronize query caches if something's actually changed
- (when (or deleted (not (equal olddata newdata)))
- (dolist (cachefuns
- '((dictree-complete-cache
- dictree--synchronize-completion-cache
- dictree--prefix-p)
- (dictree-regexp-cache
- dictree--synchronize-regexp-cache
- (lambda (arg key)
- (tNFA-regexp-match
- arg key :test (trie--construct-equality-function
- (dictree--comparison-function dict)))))
- (dictree-fuzzy-match-cache
- dictree--synchronize-fuzzy-match-cache
- (lambda (string dist key)
- (<= (Lewenstein-distance string key) dist)))
- (dictree-fuzzy-complete-cache
- dictree--synchronize-fuzzy-completion-cache
- (lambda (prefix dist key)
- (<= (Lewenstein-distance prefix key) dist)))
- ))
- (when (funcall (nth 0 cachefuns) dict)
- (maphash
- (lambda (cache-key cache-entry)
- (destructuring-bind
- (arg auxargs rank-function reverse filter) cache-key
- (when (apply (nth 2 cachefuns)
- (append (list arg) auxargs (list key)))
- (cond
- ;; updating dirty cache entries
- ((eq (dictree-cache-update-policy dict) 'synchronize)
- (funcall (nth 1 cachefuns)
- dict key olddata newdata deleted cache-entry
- arg auxargs rank-function reverse filter))
- ;; deleting dirty cache entries
- (t (remhash (list arg auxargs rank-function reverse filter)
- (funcall (nth 0 cachefuns) dict)))))))
- (funcall (nth 0 cachefuns) dict)))
- ))))
-
-
-
-(defun dictree--synchronize-completion-cache
- (dict key olddata newdata deleted cache-entry
- arg auxargs rank-function reverse filter)
- ;; Synchronize DICT's completion CACHE-ENTRY for a query with arguments ARG,
- ;; AUXARGS, RANK-FUNCTION, REVERSE and FILTER, where KEY's data was either
- ;; updated from OLDDATA to NEWDATA or DELETED,
-
- (let* ((completions (dictree--cache-results cache-entry))
- (maxnum (dictree--cache-maxnum cache-entry))
- (cmpl (assoc key completions))
- (rankfun (cond ((eq rank-function t)
- (dictree--wrap-rankfun
- (dictree--rank-function dict)))
- (rank-function
- (dictree--wrap-rankfun rank-function)))))
- ;; for meta-dict, get old data from cache instead of OLDDATA
- (when (dictree--meta-dict-p dict) (setq olddata (cdr cmpl)))
- ;; skip cache update if key/data pair doesn't pass FILTER
- (when (or (null filter)
- (funcall filter key olddata)
- (funcall filter key newdata))
- ;; if key was...
- (cond
-
- ;; deleted and in cached result: remove cache entry and re-run the
- ;; same completion to update the cache
- ((and deleted cmpl)
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-complete-cache dict))
- (dictree-complete dict arg rank-function maxnum reverse filter))
-
- ;; modified and not in cached result: merge it into the completion
- ;; list, retaining only the first maxnum
- ((and (not deleted) (not cmpl))
- (when (or (null filter) (funcall filter key newdata))
- (setf (dictree--cache-results cache-entry)
- (dictree--merge
- (list (cons key newdata)) completions
- (or rankfun
- `(lambda (a b)
- (,(trie-construct-sortfun
- (dictree-comparison-function dict))
- (car a) (car b))))
- (when (dictree--meta-dict-p dict)
- (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- maxnum))))
-
- ;; modified and in the cached result
- ((and (not deleted) cmpl)
- ;; update the associated data if dict is a meta-dictionary (this
- ;; happens automatically for a normal dict)
- (when (dictree--meta-dict-p dict) (setcdr cmpl newdata))
- ;; if updated entry gets filtered, or gets sorted at end of list,
- ;; re-run the same query to update the cache
- (when (or (and filter (not (funcall filter key newdata)))
- (and rankfun
- (setf (dictree--cache-results cache-entry)
- (sort completions rankfun))
- (equal key (car (last (dictree--cache-results
- cache-entry))))))
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-complete-cache dict))
- (dictree-complete dict arg rank-function maxnum reverse filter)))
-
- ;; deleted and not in cached result: requires no action
- ))))
-
-
-(defun dictree--synchronize-regexp-cache
- (dict key olddata newdata deleted cache-entry
- arg auxargs rank-function reverse filter)
- ;; Synchronize DICT's regexp CACHE-ENTRY for a query with arguments ARG,
- ;; AUXARGS, RANK-FUNCTION, REVERSE and FILTER, where KEY's data was either
- ;; updated from OLDDATA to NEWDATA or DELETED,
-
- (let* ((completions (dictree--cache-results cache-entry))
- (maxnum (dictree--cache-maxnum cache-entry))
- group-data
- (cmpl (catch 'found
- (dolist (c completions)
- (if (and (listp (car c))
- (or (stringp (caar c))
- (vectorp (caar c))
- (listp (caar c))))
- (when (equal key (caar c)) (throw 'found c))
- (when (equal key (car c)) (throw 'found c))))))
- (rankfun (cond ((eq rank-function t)
- (dictree--wrap-regexp-rankfun
- (dictree-rank-function dict)))
- (rank-function
- (dictree--wrap-regexp-rankfun rank-function)))))
- ;; for meta-dict, get old data from cache instead of OLDDATA
- (when (dictree--meta-dict-p dict) (setq olddata (cdr cmpl)))
- ;; skip cache update if key/data pair doesn't pass FILTER
- (when (or (null filter)
- (funcall filter key olddata)
- (funcall filter key newdata))
- ;; if key was...
- (cond
-
- ;; deleted and in cached result: remove cache entry and re-run the
- ;; same completion to update the cache
- ((and deleted cmpl)
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-regexp-cache dict))
- (dictree-regexp-search dict arg rank-function maxnum reverse filter))
-
- ;; modified and not in cached result: merge it into the completion
- ;; list, retaining only the first maxnum
- ((and (not deleted) (not cmpl))
- (when (or (null filter) (funcall filter key newdata))
- (save-match-data
- (set-match-data nil)
- (tNFA-regexp-match arg key
- :test (trie--construct-equality-function
- (dictree--comparison-function dict)))
- (when (setq group-data (nthcdr 2 (match-data)))
- (setq key (cons key group-data))))
- (setf (dictree--cache-results cache-entry)
- (dictree--merge
- (list (cons key newdata)) completions
- (or rankfun
- `(lambda (a b)
- (,(trie-construct-sortfun
- (dictree-comparison-function dict))
- ,(if group-data '(caar a) '(car a))
- ,(if group-data '(caar b) '(car b)))))
- (when (dictree--meta-dict-p dict)
- (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- maxnum))))
-
- ;; modified and in the cached result
- ((and (not deleted) cmpl)
- ;; update the associated data if dict is a meta-dictionary (this
- ;; happens automatically for a normal dict)
- (when (dictree--meta-dict-p dict) (setcdr cmpl newdata))
- ;; if updated entry gets filtered, or gets sorted at end of list,
- ;; re-run the same query to update the cache
- (when (or (and filter (not (funcall filter key newdata)))
- (and rankfun
- (setf (dictree--cache-results cache-entry)
- (sort completions rankfun))
- (equal key (car (last (dictree--cache-results
- cache-entry))))))
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-regexp-cache dict))
- (dictree-regexp-search dict arg rank-function maxnum reverse filter)
- ))
-
- ;; deleted and not in cached result: requires no action
- ))))
-
-
-(defun dictree--synchronize-fuzzy-match-cache
- (dict key olddata newdata deleted cache-entry
- arg auxargs rank-function reverse filter)
- ;; Synchronize DICT's fuzzy match CACHE-ENTRY for a query with arguments
- ;; ARG, AUXARGS, RANK-FUNCTION, REVERSE and FILTER, where KEY's data was
- ;; either updated from OLDDATA to NEWDATA or DELETED,
-
- (let* ((completions (dictree--cache-results cache-entry))
- (maxnum (dictree--cache-maxnum cache-entry))
- (cmpl (catch 'found
- (dolist (c completions)
- (when (equal key (caar c)) (throw 'found c)))))
- (distance (Lewenstein-distance key arg))
- (rankfun (cond ((eq rank-function t)
- (dictree--wrap-fuzzy-rankfun
- (dictree-rank-function dict)))
- ((eq rank-function 'distance)
- (dictree--wrap-fuzzy-rankfun
- (trie--construct-Lewenstein-rankfun
- (dictree-comparison-function dict))))
- (rank-function
- (dictree--wrap-fuzzy-rankfun rank-function)))))
- ;; for meta-dict, get old data from cache instead of OLDDATA
- (when (dictree--meta-dict-p dict) (setq olddata (cdr cmpl)))
- ;; skip cache update if key/data pair doesn't pass FILTER
- (when (or (null filter)
- (funcall filter key olddata)
- (funcall filter key newdata))
- ;; if key was...
- (cond
-
- ;; deleted and in cached result: remove cache entry and re-run the
- ;; same completion to update the cache
- ((and deleted cmpl)
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-fuzzy-match-cache dict))
- (dictree-fuzzy-match dict arg (car auxargs)
- rank-function maxnum reverse filter))
-
- ;; modified and not in cached result: merge it into the completion
- ;; list, retaining only the first maxnum
- ((and (not deleted) (not cmpl))
- (when (or (null filter) (funcall filter key newdata))
- (setf (dictree--cache-results cache-entry)
- (dictree--merge
- (list (cons (cons key distance) newdata)) completions
- (or rankfun
- `(lambda (a b)
- (,(trie-construct-sortfun
- (dictree-comparison-function dict))
- (caar a) (caar b))))
- (when (dictree--meta-dict-p dict)
- (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- maxnum))))
-
- ;; modified and in the cached result
- ((and (not deleted) cmpl)
- ;; update the associated data if dict is a meta-dictionary (this
- ;; happens automatically for a normal dict)
- (when (dictree--meta-dict-p dict) (setcdr cmpl newdata))
- ;; if updated entry gets filtered, or gets sorted at end of list,
- ;; re-run the same query to update the cache
- (when (or (and filter (not (funcall filter key newdata)))
- (and rankfun
- (setf (dictree--cache-results cache-entry)
- (sort completions rankfun))
- (equal key (car (last (dictree--cache-results
- cache-entry))))))
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-fuzzy-match-cache dict))
- (dictree-fuzzy-match dict arg (car auxargs)
- rank-function maxnum reverse filter)))
-
- ;; deleted and not in cached result: requires no action
- ))))
-
-
-(defun dictree--synchronize-fuzzy-complete-cache
- (dict key olddata newdata deleted cache-entry
- arg auxargs rank-function reverse filter)
- ;; Synchronize DICT's fuzzy completion CACHE-ENTRY for a query with
- ;; arguments ARG, AUXARGS, RANK-FUNCTION, REVERSE and FILTER, where KEY's
- ;; data was either updated from OLDDATA to NEWDATA or DELETED,
-
- (let* ((completions (dictree--cache-results cache-entry))
- (maxnum (dictree--cache-maxnum cache-entry))
- (cmpl (catch 'found
- (dolist (c completions)
- (when (equal key (caar c)) (throw 'found c)))))
- (distance (Lewenstein-distance key arg))
- (rankfun (cond ((eq rank-function t)
- (dictree--wrap-fuzzy-rankfun
- (dictree-rank-function dict)))
- ((eq rank-function 'distance)
- (dictree--wrap-fuzzy-rankfun
- (trie--construct-Lewenstein-rankfun
- (dictree-comparison-function dict))))
- (rank-function
- (dictree--wrap-fuzzy-rankfun rank-function)))))
- ;; for meta-dict, get old data from cache instead of OLDDATA
- (when (dictree--meta-dict-p dict) (setq olddata (cdr cmpl)))
- ;; skip cache update if key/data pair doesn't pass FILTER
- (when (or (null filter)
- (funcall filter key olddata)
- (funcall filter key newdata))
- ;; if key was...
- (cond
-
- ;; deleted and in cached result: remove cache entry and re-run the
- ;; same completion to update the cache
- ((and deleted cmpl)
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-fuzzy-complete-cache dict))
- (dictree-fuzzy-complete dict arg (car auxargs)
- rank-function maxnum reverse filter))
-
- ;; modified and not in cached result: merge it into the completion
- ;; list, retaining only the first maxnum
- ((and (not deleted) (not cmpl))
- (when (or (null filter) (funcall filter key newdata))
- (setf (dictree--cache-results cache-entry)
- (dictree--merge
- (list (cons key (cons distance newdata))) completions
- (or rankfun
- `(lambda (a b)
- (,(trie-construct-sortfun
- (dictree-comparison-function dict))
- (car a) (car b))))
- (when (dictree--meta-dict-p dict)
- (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- maxnum))))
-
- ;; modified and in the cached result
- ((and (not deleted) cmpl)
- ;; update the associated data if dict is a meta-dictionary (this
- ;; happens automatically for a normal dict)
- (when (dictree--meta-dict-p dict) (setcdr cmpl newdata))
- ;; if updated entry gets filtered, or gets sorted at end of list,
- ;; re-run the same query to update the cache
- (when (or (and filter (not (funcall filter key newdata)))
- (and rankfun
- (setf (dictree--cache-results cache-entry)
- (sort completions rankfun))
- (equal key (car (last (dictree--cache-results
- cache-entry))))))
- (remhash (list arg auxargs rank-function reverse filter)
- (dictree-fuzzy-complete-cache dict))
- (dictree-fuzzy-complete dict arg (car auxargs)
- rank-function maxnum reverse filter)))
-
- ;; deleted and not in cached result: requires no action
- ))))
-
-
-(defun dictree-clear-caches (dict)
- "Clear all DICT's query caches."
- (interactive (list (read-dict "Dictionary: ")))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
- (dolist (cachefun '(dictree-lookup-cache
- dictree-complete-cache
- dictree-regexp-cache
- dictree-fuzzy-match-cache
- dictree-fuzzy-complete-cache))
- (when (funcall cachefun dict)
- (clrhash (funcall cachefun dict))))
- (when (called-interactively-p 'interactive)
- (message "Cleared caches for dictionary %s" (dictree-name dict))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Retrieving data
-
-(defun dictree-member (dict key &optional nilflag)
- "Return the data associated with KEY in dictionary DICT,
-or nil if KEY is not in the dictionary.
-
-Optional argument NILFLAG specifies a value to return instead of
-nil if KEY does not exist in TREE. This allows a non-existent KEY
-to be distinguished from an element with a null association. (See
-also `dictree-member-p' for testing existence alone.)"
- (let* ((data (dictree--lookup dict key nilflag)))
- (if (eq data nilflag)
- nilflag
- (dictree--cell-data data))))
-
-(defalias 'dictree-lookup 'dictree-member)
-
-(defun dictree-member-p (dict key)
- "Return t if KEY exists in DICT, nil otherwise."
- (let ((flag '(nil)))
- (not (eq flag (dictree-member dict key flag)))))
-
-
-(defun dictree--lookup (dict key nilflag)
- ;; Return association of KEY in DICT, or NILFLAG if KEY does not
- ;; exist. Does not do any data/meta-data unwrapping
-
- (let* ((flag '(nil))
- (data flag)
- time)
- ;; if KEY is in the cache, then we're done
- (unless (and (dictree-lookup-cache dict)
- (setq data (gethash key (dictree--lookup-cache dict))))
-
- ;; otherwise, we have to look in the dictionary itself...
- (cond
- ;; if DICT is a meta-dict, look in its constituent dictionaries
- ((dictree--meta-dict-p dict)
- (let (newdata (newflag '(nil)))
- ;; time the lookup for caching
- (setq time (float-time))
- ;; look in each constituent dictionary in turn
- (dolist (dic (dictree--meta-dict-dictlist dict))
- (setq newdata (dictree--lookup dic key newflag))
- ;; skip dictionary if it doesn't contain KEY
- (unless (eq newdata newflag)
- ;; if we haven't found KEY before, we have now!
- (if (eq data flag) (setq data newdata)
- ;; otherwise, combine the previous data with the new data
- (setq data
- (funcall (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict))
- data newdata)))))
- (setq time (- (float-time) time))))
-
- ;; otherwise, DICT is a normal dictionary, so look in it's trie
- (t
- ;; time the lookup for caching
- (setq time (float-time))
- (setq data (trie-member (dictree--trie dict) key flag))
- (setq time (- (float-time) time))))
-
- ;; if lookup found something, and we're above the cache-threshold, cache
- ;; the result
- (when (and (not (eq data flag))
- (dictree--above-cache-threshold-p
- time (length key) (dictree-cache-policy dict)
- (dictree-cache-threshold dict) 'long-keys))
- (setf (dictree-modified dict) t)
- ;; create lookup cache if it doesn't already exist
- (dictree-create-lookup-cache dict)
- (puthash key data (dictree-lookup-cache dict))))
-
- ;; return the desired data
- (if (eq data flag) nilflag data)))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Getting and setting meta-data
-
-(defun dictree-put-property (dict key property value)
- "Set PROPERTY for KEY in dictionary DICT.
-PROPERTY should be a symbol. Returns VALUE if successful, nil if
-KEY was not found in DICT.
-
-Note that if DICT is a meta-dictionary, then this will set KEY's
-PROPERTY to VALUE in *all* its constituent dictionaries.
-
-Unlike the data associated with a key (cf. `dictree-insert'),
-properties are not included in the results of queries on the
-dictionary \(`dictree-lookup', `dictree-complete',
-`dictree-complete-ordered'\), nor do they affect the outcome of
-any of the queries. They merely serves to tag a key with some
-additional information, and can only be retrieved using
-`dictree-get-property'."
-
- ;; sort out arguments
- (and (symbolp dict) (setq dict (symbol-value dict)))
- (cond
- ;; set PROPERTY for KEY in all constituent dicts of a meta-dict
- ((dictree--meta-dict-p dict)
- (warn "Setting %s property for key %s in all constituent\
- dictionaries of meta-dictionary %s" property key (dictree-name dict))
- (setf (dictree-modified dict) t)
- (let (dictree--put-property-ret)
- (mapc (lambda (dic k p v)
- (setq dictree--put-property-ret
- (or dictree--put-property-ret
- (dictree-put-property dic k p v))))
- (dictree--meta-dict-dictlist dict))
- ;; return VALUE if KEY was found in at least one constituent dict
- dictree--put-property-ret))
- (t ;; set PROPERTY for KEY in normal dict
- (let ((cell (trie-member (dictree--trie dict) key)))
- (when cell
- (setf (dictree-modified dict) t)
- (setf (dictree--cell-plist cell)
- (plist-put (dictree--cell-plist cell) property value))
- value))) ; return VALUE
- ))
-
-
-
-(defun dictree-delete-property (dict key property)
- "Delete PROPERTY from KEY in dictionary DICT.
-Returns the new property list for KEY, with PROPERTY deleted.
-
-Setting PROPERTY to nil using `dictree-put-property' is not quite
-the same thing as deleting it, since null property values can
-still be detected by supplying the optional argument to
-`dictree-get-propery' (which see).
-
-Note that if DICT is a meta-dictionary, then this will delete
-KEY's PROPERTY in *all* its constituent dictionaries."
- ;; sort out arguments
- (and (symbolp dict) (setq dict (symbol-value dict)))
- (cond
- ;; delete PROPERTY from KEY in all constituent dicts of a meta-dict
- ((dictree--meta-dict-p dict)
- (warn "Deleting %s property from key %s in all constituent\
- dictionaries of meta-dicttionary %s" property key (dictree-name dict))
- (setf (dictree-modified dict) t)
- (mapcar (lambda (dic k p) (dictree-delete-property dic k p))
- (dictree--meta-dict-dictlist dict)))
- (t ;; delete PROPERTY from KEY in normal dict
- (let* ((cell (trie-member (dictree--trie dict) key))
- plist tail)
- (when (and cell
- (setq tail
- (plist-member
- (setq plist (dictree--cell-plist cell))
- property)))
- (setf (dictree-modified dict) t)
- ;; delete property and value from plist
- (setcdr tail (cddr tail))
- (setq plist (delq property plist))
- (setf (dictree--cell-plist cell) plist))))
- ))
-
-
-
-(defun dictree-get-property (dict key property &optional nilflag)
- "Get the value of PROPERTY for KEY in dictionary DICT,
-or return nil if KEY is not in the dictionary.
-
-Optional argument NILFLAG specifies a value to return instead of
-nil if KEY does not exist in TREE. This allows a non-existent KEY
-to be distinguished from a key for which PROPERTY is not
-set. (See also `dictree-member-p' for testing existence alone.)"
- (let ((cell (dictree--lookup dict key nilflag)))
- (unless (eq cell nilflag)
- (plist-get (dictree--cell-plist cell) property))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Mapping functions
-
-(defun dictree-mapc (function dict &optional type reverse)
- "Apply FUNCTION to all entries in dictionary DICT,
-for side-effects only.
-
-FUNCTION will be passed two arguments: a key of type
-TYPE (`string', `vector', or `list', defaulting to `vector') from the
-dictionary, and the data associated with that key. The dictionary
-entries will be traversed in \"lexicographic\" order, i.e. the
-order defined by the dictionary's comparison function (cf.
-`dictree-create').
-
-If TYPE is string, it must be possible to apply the function
-`string' to the elements of sequences stored in DICT.
-
-FUNCTION is applied in ascending order, or descending order if
-REVERSE is non-nil."
-
- ;; "rename" FUNCTION to something hopefully unique to lessen the
- ;; likelihood of dynamic scoping bugs caused by a supplied function
- ;; binding a variable with the same name as one of the arguments
- (let ((--dictree-mapc--function function))
- (dictree--mapc
- (lambda (key data _plist)
- (funcall --dictree-mapc--function key data))
- dict type reverse)))
-
-
-
-(defun dictree--mapc (function dict &optional type reverse)
- ;; Like `dictree-mapc', but FUNCTION is passed three arguments: the
- ;; key, the data, and the property list, instead of just key and data.
-
- ;; try to avoid dynamic binding bugs
- (let ((--dictree--mapc--function function))
- (if (dictree--meta-dict-p dict)
- ;; for a meta-dict, use a dictree-stack
- (let ((stack (dictree-stack dict))
- entry)
- (while (setq entry (dictree--stack-pop stack))
- (funcall --dictree--mapc--function
- (car entry)
- (dictree--cell-data (cdr entry))
- (dictree--cell-plist (cdr entry)))))
- ;; for a normal dictionary, map the function over its trie
- (trie-mapc
- (lambda (key cell)
- (funcall --dictree--mapc--function
- key
- (dictree--cell-data cell)
- (dictree--cell-plist cell)))
- (dictree--trie dict)
- type reverse)
- )))
-
-
-
-(defun dictree-mapf (function combinator dict &optional type reverse)
- "Apply FUNCTION to all entries in dictionary DICT,
-and combine the results using COMBINATOR.
-
-FUNCTION should take two arguments: a key sequence from the
-dictionary and its associated data.
-
-Optional argument TYPE (one of the symbols `vector', `lisp' or
-`string'; defaults to `vector') sets the type of sequence passed to
-FUNCTION. If TYPE is `string', it must be possible to apply the
-function `string' to the individual elements of key sequences
-stored in DICT.
-
-The FUNCTION will be applied and the results combined in
-asscending \"lexicographic\" order (i.e. the order defined by the
-dictionary's comparison function; cf. `dictree-create'), or
-descending order if REVERSE is non-nil."
-
- ;; try to avoid dynamic scoping bugs
- (let ((--dictree-mapf--function function)
- (--dictree-mapf--combinator combinator))
-
- ;; for a normal dictionary, map the function over its trie
- (if (not (dictree--meta-dict-p dict))
- (trie-mapf
- `(lambda (key data)
- (,--dictree-mapf--function key (dictree--cell-data data)))
- --dictree-mapf--combinator (dictree--trie dict) type reverse)
-
- ;; for a meta-dict, use a dictree-stack
- (let ((--dictree-mapf--stack (dictree-stack dict))
- --dictree-mapf--entry
- --dictree-mapf--accumulate)
- (while (setq --dictree-mapf--entry
- (dictree-stack-pop --dictree-mapf--stack))
- (setq --dictree-mapf--accumulate
- (funcall --dictree-mapf--combinator
- (funcall --dictree-mapf--function
- (car --dictree-mapf--entry)
- (cdr --dictree-mapf--entry))
- --dictree-mapf--accumulate)))
- --dictree-mapf--accumulate))))
-
-
-
-(defun dictree-mapcar (function dict &optional type reverse)
- "Apply FUNCTION to all entries in dictionary DICT,
-and make a list of the results.
-
-FUNCTION should take two arguments: a key sequence from the
-dictionary and its associated data.
-
-Optional argument TYPE (one of the symbols `vector', `list' or
-`string'; defaults to `vector') sets the type of sequence passed
-to FUNCTION. If TYPE is string, it must be possible to apply the
-function `string' to the individual elements of key sequences
-stored in DICT.
-
-The FUNCTION will be applied and the results combined in
-asscending \"lexicographic\" order \(i.e. the order defined by
-the dictionary's comparison function; cf. `dictree-create'\), or
-descending order if REVERSE is non-nil.
-
-Note that if you don't care about the order in which FUNCTION is
-applied, just that the resulting list is in the correct order,
-then
-
- (dictree-mapf function #\\='cons dict type (not reverse))
-
-is more efficient."
- (nreverse (dictree-mapf function #'cons dict type reverse)))
-
-
-
-(defun dictree-size (dict)
- "Return the number of entries in dictionary DICT.
-Interactively, DICT is read from the mini-buffer."
- (interactive (list (read-dict "Dictionary: ")))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
- (let ((count 0))
- (dictree-mapc (lambda (&rest _dummy) (incf count)) dict)
- (when (called-interactively-p 'interactive)
- (message "Dictionary %s contains %d entries"
- (dictree--name dict) count))
- count))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Using dictrees as stacks
-
-;; A dictree--meta-stack is the meta-dict version of a dictree-stack (the
-;; ordinary version is just a single trie-stack). It consists of a heap of
-;; trie-stacks for its constituent tries, where the heap order is the usual
-;; lexicographic order over the keys at the top of the trie-stacks.
-
-(defstruct
- (dictree--meta-stack
- (:constructor nil)
- (:constructor dictree--meta-stack-create
- (dict &optional (type 'vector) reverse
- &aux
- (combfun (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- (sortfun (trie-construct-sortfun
- (dictree-comparison-function dict)))
- (heap (heap-create
- (dictree--construct-meta-stack-heapfun sortfun)
- (length (dictree--trielist dict))))
- (pushed '())
- (_dummy (mapc
- (lambda (dic)
- (heap-add
- heap (trie-stack dic type reverse)))
- (dictree--trielist dict)))))
- (:constructor dictree--complete-meta-stack-create
- (dict prefix &optional reverse
- &aux
- (combfun (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- (sortfun (trie-construct-sortfun
- (dictree-comparison-function dict)))
- (heap (heap-create
- (dictree--construct-meta-stack-heapfun
- sortfun reverse)
- (length (dictree--trielist dict))))
- (pushed '())
- (_dummy (mapc
- (lambda (trie)
- (let ((stack (trie-complete-stack
- trie prefix reverse)))
- (unless (trie-stack-empty-p stack)
- (heap-add heap stack))))
- (dictree--trielist dict)))))
- (:constructor dictree--regexp-meta-stack-create
- (dict regexp &optional reverse
- &aux
- (combfun (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- (sortfun (dictree--wrap-regexp-sortfun
- (dictree-comparison-function dict) 'reverse))
- (heap (heap-create
- (dictree--construct-meta-stack-heapfun
- sortfun reverse)
- (length (dictree--trielist dict))))
- (pushed '())
- (_dummy (mapc
- (lambda (trie)
- (let ((stack (trie-regexp-stack
- trie regexp reverse)))
- (unless (trie-stack-empty-p stack)
- (heap-add heap stack))))
- (dictree--trielist dict)))))
- (:constructor dictree--fuzzy-match-meta-stack-create
- (dict string distance &optional reverse
- &aux
- (combfun (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- (sortfun (dictree--wrap-fuzzy-sortfun
- (dictree-comparison-function dict)))
- (heap (heap-create
- (dictree--construct-meta-stack-heapfun
- sortfun reverse)
- (length (dictree--trielist dict))))
- (pushed '())
- (_dummy (mapc
- (lambda (trie)
- (let ((stack (trie-fuzzy-match-stack
- trie string distance reverse)))
- (unless (trie-stack-empty-p stack)
- (heap-add heap stack))))
- (dictree--trielist dict)))))
- (:constructor dictree--fuzzy-complete-meta-stack-create
- (dict prefix distance &optional reverse
- &aux
- (combfun (dictree--wrap-combfun
- (dictree--meta-dict-combine-function dict)))
- (sortfun (dictree--wrap-fuzzy-sortfun
- (dictree-comparison-function dict)))
- (heap (heap-create
- (dictree--construct-meta-stack-heapfun
- sortfun reverse)
- (length (dictree--trielist dict))))
- (pushed '())
- (_dummy (mapc
- (lambda (trie)
- (let ((stack (trie-fuzzy-complete-stack
- trie prefix distance reverse)))
- (unless (trie-stack-empty-p stack)
- (heap-add heap stack))))
- (dictree--trielist dict)))))
- (:copier nil))
- combfun sortfun heap pushed)
-
-
-
-(defun dictree--construct-meta-stack-heapfun (sortfun &optional reverse)
- ;; Wrap SORTFUN, which sorts keys, so it can act on
- ;; dictree--meta-stack elements.
- (if reverse
- `(lambda (b a) (,sortfun (car (dictree-stack-first a))
- (car (dictree-stack-first b))))
- `(lambda (a b) (,sortfun (car (dictree-stack-first a))
- (car (dictree-stack-first b))))))
-
-
-(defun dictree-stack (dict &optional type reverse)
- "Create an object that allows DICT to be accessed as a stack.
-
-The stack is sorted in \"lexicographic\" order, i.e. the order
-defined by the DICT's comparison function, or in reverse order if
-REVERSE is non-nil. Calling `dictree-stack-pop' pops the top
-element (a key and its associated data) from the stack.
-
-Optional argument TYPE (one of the symbols `vector', `list' or
-`string') sets the type of sequence used for the keys.
-
-Note that any modification to DICT *immediately* invalidates all
-dictree-stacks created before the modification (in particular,
-calling `dictree-stack-pop' will give unpredictable results).
-
-Operations on dictree-stacks are significantly more efficient
-than constructing a real stack from the dictionary and using
-standard stack functions. As such, they can be useful in
-implementing efficient algorithms on dictionaries. However, in
-cases where mapping functions `dictree-mapc', `dictree-mapcar' or
-`dictree-mapf' would be sufficient, it is better to use one of
-those instead."
- (if (dictree--meta-dict-p dict)
- (dictree--meta-stack-create dict type reverse)
- (trie-stack (dictree--trie dict) type reverse)))
-
-
-(defun dictree-complete-stack (dict prefix &optional reverse)
- "Return an object that allows completions of PREFIX to be accessed
-as if they were a stack.
-
-The stack is sorted in \"lexicographic\" order, i.e. the order
-defined by DICT's comparison function, or in reverse order if
-REVERSE is non-nil. Calling `dictree-stack-pop' pops the top
-element (a key and its associated data) from the stack.
-
-PREFIX must be a sequence (vector, list or string) that forms the
-initial part of a DICT key. (If PREFIX is a string, it must be
-possible to apply `string' to individual elements of DICT keys.)
-The returned keys will be sequences of the same type as
-PREFIX. If PREFIX is a list of sequences, completions of all
-sequences in the list are included in the stack. All sequences in
-the list must be of the same type.
-
-Note that any modification to DICT *immediately* invalidates all
-dictree-stacks created before the modification (in particular,
-calling `dictree-stack-pop' will give unpredictable results).
-
-Operations on dictree-stacks are significantly more efficient
-than constructing a real stack from completions of PREFIX in DICT
-and using standard stack functions. As such, they can be useful
-in implementing efficient algorithms on dict-trees. However, in
-cases where `dictree-complete' is sufficient, it is better to use
-that instead."
- (if (dictree--meta-dict-p dict)
- (dictree--complete-meta-stack-create dict prefix reverse)
- (trie-complete-stack (dictree--trie dict) prefix reverse)))
-
-
-(defun dictree-regexp-stack (dict regexp &optional reverse)
- "Return an object that allows REGEXP matches to be accessed
-as if they were a stack.
-
-The stack is sorted in \"lexicographic\" order, i.e. the order
-defined by DICT's comparison function, or in reverse order if
-REVERSE is non-nil. Calling `dictree-stack-pop' pops the top
-element (a key and its associated data) from the stack.
-
-REGEXP is a regular expression, but it need not necessarily be a
-string. It must be a sequence (vector, list of string) whose
-elements are either elements of the same type as elements of the
-keys in DICT (which behave as literals in the regexp), or any of
-the usual regexp special characters and backslash constructs. If
-REGEXP is a string, it must be possible to apply `string' to
-individual elements of the keys stored in DICT. The matches
-returned in the alist will be sequences of the same type as KEY.
-
-Back-references and non-greedy postfix operators are *not*
-supported, and the matches are always anchored, so `$' and `^'
-lose their special meanings.
-
-If the regexp contains any non-shy grouping constructs, subgroup
-match data is included in the results. In this case, the car of
-each match is no longer just a key. Instead, it is a list whose
-first element is the matching key, and whose remaining elements
-are cons cells whose cars and cdrs give the start and end indices
-of the elements that matched the corresponding groups, in order.
-
-Note that any modification to DICT *immediately* invalidates all
-dictree-stacks created before the modification (in particular,
-calling `dictree-stack-pop' will give unpredictable results).
-
-Operations on dictree-stacks are significantly more efficient
-than constructing a real stack from completions of PREFIX in DICT
-and using standard stack functions. As such, they can be useful
-in implementing efficient algorithms on dict-trees. However, in
-cases where `dictree-regexp-search' is sufficient, it is better
-to use that instead."
- (if (dictree--meta-dict-p dict)
- (dictree--regexp-meta-stack-create dict regexp reverse)
- (trie-regexp-stack (dictree--trie dict) regexp reverse)))
-
-
-(defun dictree-fuzzy-match-stack (dict string distance &optional reverse)
- "Return an object that allows fuzzy matches to be accessed
-as if they were a stack.
-
-The stack is sorted in \"lexicographic\" order, i.e. the order
-defined by DICT's comparison function, or in reverse order if
-REVERSE is non-nil. Calling `dictree-stack-pop' pops the top
-element (a key and its associated data) from the stack.
-
-STRING must be a sequence (vector, list or string), and DISTANCE
-must be an integer. (If STRING is a string, it must be possible
-to apply `string' to individual elements of DICT keys.) The
-matches returned in the alist will be sequences of the same type
-as STRING that are within Lewenstein distance DISTANCE of
-STRING. If STRING is a list of sequences, keys withing DISTANCE
-of any sequences in the list are included in the stack. All
-sequences in the list must be of the same type.
-
-Note that any modification to DICT *immediately* invalidates all
-dictree-stacks created before the modification (in particular,
-calling `dictree-stack-pop' will give unpredictable results).
-
-Operations on dictree-stacks are significantly more efficient
-than constructing a real stack from fuzzy matches within DISTANCE
-of STRING in DICT and using standard stack functions. As such,
-they can be useful in implementing efficient algorithms on
-dict-trees. However, in cases where `dictree-fuzzy-match' is
-sufficient, it is better to use that instead."
- (if (dictree--meta-dict-p dict)
- (dictree--fuzzy-match-meta-stack-create dict string distance reverse)
- (trie-fuzzy-match-stack (dictree--trie dict) string distance reverse)))
-
-
-(defun dictree-fuzzy-complete-stack (dict prefix distance &optional reverse)
- "Return an object that allows fuzzy completions to be accessed
-as if they were a stack.
-
-The stack is sorted in \"lexicographic\" order, i.e. the order
-defined by DICT's comparison function, or in reverse order if
-REVERSE is non-nil. Calling `dictree-stack-pop' pops the top
-element (a key and its associated data) from the stack.
-
-PREFIX must be a sequence (vector, list or string), and DISTANCE
-must be an integer. (If PREFIX is a string, it must be possible
-to apply `string' to individual elements of DICT keys.) The
-completions returned in the alist will be sequences of the same
-type as STRING that are completions of prefixes within Lewenstein
-distance DISTANCE of PREFIX. If PREFIX is a list of sequences,
-completions within DISTANCE of any prefix in the list are
-included in the stack. All sequences in the list must be of the
-same type.
-
-Note that any modification to DICT *immediately* invalidates all
-dictree-stacks created before the modification (in particular,
-calling `dictree-stack-pop' will give unpredictable results).
-
-Operations on dictree-stacks are significantly more efficient
-than constructing a real stack from fuzzy matches within DISTANCE
-of STRING in DICT and using standard stack functions. As such,
-they can be useful in implementing efficient algorithms on
-dict-trees. However, in cases where `dictree-fuzzy-complete' is
-sufficient, it is better to use that instead."
- (if (dictree--meta-dict-p dict)
- (dictree--fuzzy-complete-meta-stack-create dict prefix distance reverse)
- (trie-fuzzy-complete-stack (dictree--trie dict) prefix distance reverse)))
-
-
-(defun dictree-stack-pop (dictree-stack)
- "Pop the first element from the DICTREE-STACK.
-Returns nil if the stack is empty."
- (cond
- ;; if elements have been pushed onto a dict stack, pop those first
- ;; FIXME: shouldn't be using internal trie functions!
- ((and (trie-stack-p dictree-stack)
- (trie--stack-pushed dictree-stack))
- (trie-stack-pop dictree-stack))
- ;; if elements have been pushed onto a meta-dict stack, pop those
- ;; first
- ((and (dictree--meta-stack-p dictree-stack)
- (dictree--meta-stack-pushed dictree-stack))
- (pop (dictree--meta-stack-pushed dictree-stack)))
- ;; otherwise, pop first element from dictree-stack
- (t (let ((popped (dictree--stack-pop dictree-stack)))
- (when popped
- (cons (car popped) (dictree--cell-data (cdr popped))))))
- ))
-
-
-(defun dictree-stack-push (element dictree-stack)
- "Push ELEMENT onto DICTREE-STACK."
- (if (trie-stack-p dictree-stack)
- ;; normal dict
- (trie-stack-push element dictree-stack)
- ;; meta-dict
- (push element (dictree--meta-stack-pushed dictree-stack))))
-
-
-(defun dictree-stack-first (dictree-stack)
- "Return the first element from DICTREE-STACK, without removing it.
-Returns nil if the stack is empty."
- ;; if elements have been pushed onto the stack, return first of those
- (if (and (dictree--meta-stack-p dictree-stack)
- (dictree--meta-stack-pushed dictree-stack))
- (car (dictree--meta-stack-pushed dictree-stack))
- ;; otherwise, return first element from dictree-stack
- (let ((first (dictree--stack-first dictree-stack)))
- (cons (car first) (dictree--cell-data (cdr first))))))
-
-
-(defun dictree-stack-empty-p (dictree-stack)
- "Return t if DICTREE-STACK is empty, nil otherwise."
- (if (trie-stack-p dictree-stack)
- ;; normal dict
- (trie-stack-empty-p dictree-stack)
- ;; meta-dict
- (and (heap-empty (dictree--meta-stack-heap dictree-stack))
- (null (dictree--meta-stack-pushed dictree-stack)))))
-
-
-(defun dictree--stack-first (dictree-stack)
- "Return the first element from DICTREE-STACK, without removing it.
-Returns nil if the stack is empty."
- (if (trie-stack-p dictree-stack)
- ;; normal dict
- (trie-stack-first dictree-stack)
- ;; meta-dict
- (if (dictree--meta-stack-pushed dictree-stack)
- ;; pushed element
- (car (dictree--meta-stack-pushed dictree-stack))
- ;; dictree-stack element
- (dictree--stack-first
- (heap-root (dictree--meta-stack-heap dictree-stack))))))
-
-
-(defun dictree--stack-pop (dictree-stack)
- ;; Pop the raw first element from DICTREE-STACK. Returns nil if the
- ;; stack is empty.
-
- ;; dictree-stack for normal dictionaries is a trie-stack
- (if (trie-stack-p dictree-stack)
- (trie-stack-pop dictree-stack)
-
- ;; meta-dictionary dictree-stack...more work!
- ;; if elements have been pushed onto meta-dict stack, pop those
- ;; first
- (if (dictree--meta-stack-pushed dictree-stack)
- (pop (dictree--meta-stack-pushed dictree-stack))
- ;; otherwise...
- (let ((heap (dictree--meta-stack-heap dictree-stack))
- (sortfun (dictree--meta-stack-sortfun dictree-stack))
- stack curr next)
- (unless (heap-empty heap)
- ;; remove the first dictree-stack from the heap, pop it's
- ;; first element, and add it back to the heap (note that it
- ;; will almost certainly not end up at the root again)
- (setq stack (heap-delete-root heap))
- (setq curr (dictree--stack-pop stack))
- (unless (dictree-stack-empty-p stack) (heap-add heap stack))
- ;; peek at the first element of the stack now at the root of
- ;; the heap
- (unless (heap-empty heap)
- (setq next (dictree--stack-first (heap-root heap)))
- ;; repeat this as long as we keep finding elements with the
- ;; same key, combining them together as we go
- (when (dictree--meta-stack-combfun dictree-stack)
- (while (and (null (funcall sortfun
- (car curr) (car next)))
- (null (funcall sortfun
- (car next) (car curr))))
- (setq stack (heap-delete-root heap))
- (setq next (dictree--stack-pop stack))
- (setq curr (cons (car curr)
- (funcall
- (dictree--meta-stack-combfun dictree-stack)
- (cdr curr) (cdr next))))
- (heap-add heap stack)
- (setq next (dictree--stack-first (heap-root heap))))))
- ;; return the combined dictionary element
- curr)))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; dictree iterator generators
-
-;; dictree-stacks *are* iterators (with additional push and
-;; inspect-first-element operations). If we're running on a modern Emacs that
-;; includes the `generator' library, we can trivially define dictree iterator
-;; generators in terms of dictree-stacks.
-
-(heap--when-generators
- (iter-defun dictree-iter (dict &optional type reverse)
- "Return a dictree iterator object.
-
-Calling `iter-next' on this object will retrieve the next
-element (a cons cell containing a key and its associated data)
-from DICT in \"lexicographic\" order, i.e. the order defined by
-the DICT's comparison function, or in reverse order if REVERSE is
-non-nil.
-
-Optional argument TYPE (one of the symbols `vector', `list' or
-`string') sets the type of sequence used for the keys.
-
-Note that any modification to DICT *immediately* invalidates all
-iterators created from DICT before the modification (in
-particular, calling `iter-next' will give unpredictable
-results). If DICT is a meta-dict, this includes any modifications
-to its constituent dicts."
- (let ((stack (dictree-stack dict type reverse)))
- (while (not (dictree-stack-empty-p stack))
- (iter-yield (dictree-stack-pop stack))))))
-
-
-(heap--when-generators
- (iter-defun dictree-complete-iter (dict prefix &optional reverse)
- "Return an iterator object for completions of PREFIX in DICT.
-
-Calling `iter-next' on this object will retrieve the next
-completion of PREFIX (a cons cell containing a key and its
-associated data) from DICT in \"lexicographic\" order, i.e. the
-order defined by DICT's comparison function, or in reverse order
-if REVERSE is non-nil.
-
-PREFIX must be a sequence (vector, list or string) that forms the
-initial part of a DICT key. (If PREFIX is a string, it must be
-possible to apply `string' to individual elements of DICT keys.)
-The returned keys will be sequences of the same type as
-PREFIX. If PREFIX is a list of sequences, completions of all
-sequences in the list are included in the stack. All sequences in
-the list must be of the same type.
-
-Note that any modification to DICT *immediately* invalidates all
-iterators created from DICT before the modification (in
-particular, calling `iter-next' will give unpredictable
-results). If DICT is a meta-dict, this includes any modifications
-to its constituent dicts."
- (let ((stack (dictree-complete-stack dict prefix reverse)))
- (while (not (dictree-stack-empty-p stack))
- (iter-yield (dictree-stack-pop stack))))))
-
-
-(heap--when-generators
- (iter-defun dictree-regexp-iter (dict regexp &optional reverse)
- "Return an iterator object for REGEXP matches in DICT.
-
-Calling `iter-next' on this object will retrieve the next match
-\(a cons cell containing a key and its associated data\) in
-\"lexicographic\" order, i.e. the order defined by DICT's
-comparison function, or in reverse order if REVERSE is non-nil.
-
-REGEXP is a regular expression, but it need not necessarily be a
-string. It must be a sequence (vector, list of string) whose
-elements are either elements of the same type as elements of the
-keys in DICT (which behave as literals in the regexp), or any of
-the usual regexp special characters and backslash constructs. If
-REGEXP is a string, it must be possible to apply `string' to
-individual elements of the keys stored in DICT. The matches
-returned in the alist will be sequences of the same type as KEY.
-
-Back-references and non-greedy postfix operators are *not*
-supported, and the matches are always anchored, so `$' and `^'
-lose their special meanings.
-
-If the regexp contains any non-shy grouping constructs, subgroup
-match data is included in the results. In this case, the car of
-each match is no longer just a key. Instead, it is a list whose
-first element is the matching key, and whose remaining elements
-are cons cells whose cars and cdrs give the start and end indices
-of the elements that matched the corresponding groups, in order.
-
-Note that any modification to DICT *immediately* invalidates all
-iterators created from DICT before the modification (in
-particular, calling `iter-next' will give unpredictable
-results). If DICT is a meta-dict, this includes any modifications
-to its constituent dicts."
- (let ((stack (dictree-regexp-stack dict regexp reverse)))
- (while (not (dictree-stack-empty-p stack))
- (iter-yield (dictree-stack-pop stack))))))
-
-(heap--when-generators
- (iter-defun dictree-fuzzy-match-iter (dict string distance &optional reverse)
- "Return an iterator object for fuzzy matches to STRING in DICT.
-
-Calling `iter-next' on this object will retrieve the next match
-\(a cons cell containing a key and its associated data\) in
-\"lexicographic\" order, i.e. the order defined by DICT's
-comparison function, or in reverse order if REVERSE is non-nil.
-
-STRING must be a sequence (vector, list or string), and DISTANCE
-must be an integer. (If STRING is a string, it must be possible
-to apply `string' to individual elements of DICT keys.) The
-returned keys will be sequences of the same type as STRING that
-are within Lewenstein distance DISTANCE of STRING. If STRING is a
-list of sequences, keys withing DISTANCE of any sequences in the
-list are included in the stack. All sequences in the list must be
-of the same type.
-
-Note that any modification to DICT *immediately* invalidates all
-iterators created from DICT before the modification (in
-particular, calling `iter-next' will give unpredictable
-results). If DICT is a meta-dict, this includes any modifications
-to its constituent dicts."
- (let ((stack (dictree-fuzzy-match-stack dict string distance reverse)))
- (while (not (dictree-stack-empty-p stack))
- (iter-yield (dictree-stack-pop stack))))))
-
-
-(heap--when-generators
- (iter-defun dictree-fuzzy-complete-iter (dict prefix distance &optional
reverse)
- "Return an iterator object for fuzzy completions of PREFIX in DICT.
-
-Calling `iter-next' on this object will retrieve the next fuzzy
-completion in \"lexicographic\" order, i.e. the order defined by
-DICT's comparison function, or in reverse order if REVERSE is
-non-nil. Each returned element has the form:
-
- ((KEY . DIST) . DATA)
-
-PREFIX must be a sequence (vector, list or string), and DISTANCE
-must be an integer. (If PREFIX is a string, it must be possible
-to apply `string' to individual elements of DICT keys.) The
-returned keys will be sequences of the same type as STRING that
-are completions of prefixes within Lewenstein distance DISTANCE
-of PREFIX. If PREFIX is a list of sequences, completions within
-DISTANCE of any prefix in the list are included in the stack. All
-sequences in the list must be of the same type.
-
-Note that any modification to DICT *immediately* invalidates all
-iterators created from DICT before the modification (in
-particular, calling `iter-next' will give unpredictable
-results). If DICT is a meta-dict, this includes any modifications
-to its constituent dicts."
- (let ((stack (dictree-fuzzy-complete-stack dict prefix distance reverse)))
- (while (not (dictree-stack-empty-p stack))
- (iter-yield (dictree-stack-pop stack))))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Functions for building advanced queries
-
-(defun dictree--query
- (dict triefun stackfun cachefun cachecreatefun cache-long no-cache arg
- &optional auxargs rank-function rankfun maxnum reverse filter resultfun)
- ;; Return results of querying DICT with argument ARG (and AUXARGS list, if
- ;; any) using TRIEFUN or STACKFUN. If DICT's cache-threshold is non-nil,
- ;; look first for cached result in cache returned by calling CACHEFUN on
- ;; DICT, and cache result if query fulfils caching conditions. Non-nil
- ;; CACHE-LONG indicates long ARGs should be cached, rather than short
- ;; ARGs. If RANK-FUNCTION is non-nil, return results ordered
- ;; accordingly. RANKFUN should be the appropriately wrapped version of
- ;; RANK-FUNCTION. If MAXNUM is an integer, only the first MAXNUM results
- ;; will be returned. If REVERSE is non-nil, results are in reverse order. A
- ;; non-nil NO-CACHE prevents caching of results, irrespective of DICT's
- ;; cache settings. If FILTER is supplied, only results that pass FILTER are
- ;; included. A non-nil RESULTFUN is applied to results before adding them to
- ;; final results list. Otherwise, an alist of key-data associations is
- ;; returned.
-
- ;; map over all dictionaries in list
- (when (dictree-p dict) (setq dict (list dict)))
- (let ((sort-function (dictree--construct-sortfun (car dict)))
- cache results res cache-entry)
- (dolist (dic dict)
- (when cachefun (setq cache (funcall cachefun dic)))
- (cond
-
- ;; if there's a cache entry with enough results, use it
- ((and (symbolp rank-function) (symbolp filter)
- (setq cache-entry
- (when cache
- (gethash (list arg auxargs rank-function reverse filter)
- cache)))
- (or (null (dictree--cache-maxnum cache-entry))
- (and maxnum
- (<= maxnum (dictree--cache-maxnum cache-entry)))))
- (setq res (dictree--cache-results cache-entry))
- ;; drop any excess results
- (when (and maxnum
- (or (null (dictree--cache-maxnum cache-entry))
- (> (dictree--cache-maxnum cache-entry) maxnum)))
- (setcdr (nthcdr (1- maxnum) results) nil)))
-
- (t ;; if there was nothing useful in the cache, do query and time it
- (let (time)
- (setq time (float-time))
- (setq res
- (dictree--do-query
- dic triefun stackfun arg auxargs rankfun maxnum reverse
- (when filter (dictree--wrap-filter filter))))
- (setq time (- (float-time) time))
- ;; if we're above the dictionary's cache threshold, cache the result
- (when (and cachefun (not no-cache)
- (dictree--above-cache-threshold-p
- time (length arg) (dictree-cache-policy dic)
- (dictree-cache-threshold dic) cache-long))
- (setf (dictree-modified dic) t)
- ;; create query cache if it doesn't already exist
- (funcall cachecreatefun dic)
- (puthash (list arg auxargs rank-function reverse filter)
- (dictree--cache-create res maxnum)
- (funcall cachefun dic))))))
-
- ;; merge new result into results list
- (setq results
- (dictree--merge results res (or rankfun sort-function)
- nil maxnum)))
-
-
- ;; return results list, applying RESULTFUN if specified, otherwise just
- ;; stripping meta-data
- (mapcar (if resultfun
- (dictree--wrap-resultfun resultfun)
- (lambda (el) (cons (car el) (dictree--cell-data (cdr el)))))
- results)))
-
-
-
-(defun dictree--do-query
- (dict triefun stackfun arg &optional auxargs rankfun maxnum reverse filter)
- ;; Return first MAXNUM results of querying DICT with argument ARG (and
- ;; AUXARGS list, if any) using TRIEFUN or STACKFUN that satisfy FILTER,
- ;; ordered according to RANKFUN (defaulting to "lexicographic" order).
-
- ;; for a meta-dict, use a dictree-stack
- (if (dictree--meta-dict-p dict)
- (let ((stack (apply stackfun
- (append (list dict arg) auxargs (list reverse))))
- (heap (when rankfun
- (heap-create ; heap order is inverse of rank order
- (if reverse
- rankfun
- (lambda (a b)
- (not (funcall rankfun a b))))
- (1+ maxnum))))
- (i 0) res results)
- ;; pop MAXNUM results from the stack
- (while (and (or (null maxnum) (< i maxnum))
- (setq res (dictree--stack-pop stack)))
- ;; check result passes FILTER
- (when (or (null filter) (funcall filter res))
- (if rankfun
- (heap-add heap res) ; for ranked query, add to heap
- (push res results)) ; for lexicographic query, add to list
- (incf i)))
- (if (null rankfun)
- ;; for lexicographic query, reverse and return result list (we
- ;; built it backwards)
- (nreverse results)
- ;; for ranked query, pass rest of results through heap
- (while (setq res (dictree--stack-pop stack))
- (heap-add heap res)
- (heap-delete-root heap))
- ;; extract results from heap
- (while (setq res (heap-delete-root heap))
- (push res results))
- results)) ; return result list
-
- ;; for a normal dict, call corresponding trie function on dict's
- ;; trie. Note: could use a dictree-stack here too - would it be more
- ;; efficient?
- (apply triefun
- (append (list (dictree--trie dict) arg) auxargs
- (list rankfun maxnum reverse filter)))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Completing
-
-(defun dictree-complete
- (dict prefix
- &optional rank-function maxnum reverse filter resultfun no-cache)
- "Return an alist containing all completions of PREFIX in DICT
-along with their associated data, sorted according to
-RANK-FUNCTION (defaulting to \"lexicographic\" order, i.e. the
-order defined by the dictionary's comparison function,
-cf. `dictree-create'). Return nil if no completions are found.
-
-PREFIX can also be a list of sequences, in which case completions
-of all elements in the list are returned, merged together in a
-single sorted alist.
-
-DICT can also be a list of dictionaries, in which case
-completions are sought in all dictionaries in the list. (Note
-that if the same key appears in multiple dictionaries, the alist
-may contain the same key multiple times, each copy associated
-with the data from a different dictionary. If you want to combine
-identical keys, use a meta-dictionary; see
-`dictree-create-meta-dict'.)
-
-If optional argument RANK-FUNCTION is t, the completions are
-sorted according to the dictionary's rank-function (see
-`dictree-create'). Any non-nil value that *is* a function
-over-rides this. In that case, RANK-FUNCTION should accept two
-arguments, both cons cells. The car of each contains a completion
-from DICT (of the same type as PREFIX), the cdr contains its
-associated data. The RANK-FUNCTION should return non-nil if first
-argument is ranked strictly higher than the second, nil
-otherwise.
-
-The optional integer argument MAXNUM limits the results to the
-first MAXNUM completions. The default is to return all matches.
-
-If the optional argument NO-CACHE is non-nil, it prevents caching
-of the result. Ignored for dictionaries that do not have
-completion caching enabled.
-
-The FILTER argument sets a filter function for the
-completions. For each potential completion, it is passed two
-arguments: the completion, and its associated data. If the filter
-function returns nil, the completion is not included in the
-results, and doesn't count towards MAXNUM.
-
-RESULTFUN defines a function used to process results before
-adding them to the final result list. If specified, it should
-accept two arguments: a key and its associated data. Its return
-value is what gets added to the final result list, instead of the
-default key-data cons cell."
- ;; run completion query
- (dictree--query
- dict #'trie-complete #'dictree-complete-stack
- #'dictree-complete-cache #'dictree-create-complete-cache
- nil no-cache ; cache short PREFIXes
- prefix nil
- rank-function
- (when rank-function
- (if (functionp rank-function)
- (dictree--wrap-rankfun rank-function)
- (dictree--wrap-rankfun
- (dictree--rank-function (if (listp dict) (car dict) dict)))))
- maxnum reverse filter resultfun))
-
-
-(defun dictree-collection-function (dict string predicate all)
- "Function for use in `try-completion', `all-completions',
-and `completing-read'. To complete from dictionary DICT, use the
-following as the COLLECTION argument of any of those functions:
-
- (lambda (string predicate all)
- (dictree-collection-function dict string predicate all))
-
-Note that PREDICATE will be called with two arguments: the
-completion, and its associated data."
- (let ((completions
- (dictree-complete dict string nil nil nil predicate
- (lambda (key _data) key))))
- (if all completions (try-completion "" completions))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Regexp search
-
-(defun dictree-regexp-search
- (dict regexp
- &optional rank-function maxnum reverse filter resultfun no-cache)
- "Return an alist containing all matches for REGEXP in DICT
-along with their associated data, in the order defined by
-RANKFUN, defauling to \"lexicographic\" order. If REVERSE is
-non-nil, the completions are sorted in the reverse order. Returns
-nil if no completions are found.
-
-DICT can also be a list of dictionaries, in which case matches
-are sought in all dictionaries in the list. (Note that if the
-same key appears in multiple dictionaries, the alist may contain
-the same key multiple times, each copy associated with the data
-from a different dictionary. If you want to combine identical
-keys, use a meta-dictionary; see `dictree-create-meta-dict'.)
-
-REGEXP is a regular expression, but it need not necessarily be a
-string. It must be a sequence (vector, list of string) whose
-elements are either of the same type as elements of DICT
-keys (these behave as literals in the regexp), or any of the
-usual regexp special characters and backslash constructs. If
-REGEXP is a string, it must be possible to apply `string' to
-individual elements of the keys stored in DICT. The matches
-returned in the alist will be sequences of the same type as
-REGEXP.
-
-Only a subset of the full Emacs regular expression syntax is
-supported. There is no support for regexp constructs that are
-only meaningful for strings (character ranges and character
-classes inside character alternatives, and syntax-related
-backslash constructs). Back-references and non-greedy postfix
-operators are not supported, so `?' after a postfix operator
-loses its special meaning. Also, matches are always anchored, so
-`$' and `^' lose their special meanings (use `.*' at the
-beginning and end of the regexp to get an unanchored match).
-
-If the regexp contains any non-shy grouping constructs, subgroup
-match data is included in the results. In this case, the car of
-each match is no longer just a key. Instead, each element of the
-results list has the form
-
- ((KEY (START1 . END1) (START2 . END2) ...) . DATA)
-
-where the (START . END) cons cells give the start and end indices
-of the elements that matched the corresponding groups, in order.
-
-
-The optional integer argument MAXNUM limits the results to the
-first MAXNUM matches. The default is to return all matches.
-
-If the optional argument NO-CACHE is non-nil, it prevents caching
-of the result. Ignored for dictionaries that do not have wildcard
-caching enabled.
-
-
-If optional argument RANK-FUNCTION is t, the matches are sorted
-according to the dictionary's rank-function (see
-`dictree-create').
-
-Any other non-nil value of RANK-FUNCTION should be a function
-which accepts two arguments. If the regexp does not contain any
-non-shy grouping constructs, both arguments are (KEY . DATA) cons
-cells, where the car is a sequence of the same type as REGEXP. If
-the regexp does contain non-shy grouping constructs, both
-arguments are of the form
-
- ((KEY (START1 . END1) (START2 . END2) ...) . DATA)
-
-RANKFUN should return non-nil if first argument is ranked
-strictly higher than the second, nil otherwise.
-
-
-The FILTER argument sets a filter function for the matches. If
-supplied, it is called for each possible match with two
-arguments: a key and its associated data. If the regexp contains
-non-shy grouping constructs, the first argument is of the form
-
- (KEY (START1 . END1) (START2 . END2) ...)
-
-If the FILTER function returns nil, the match is not included in
-the results, and does not count towards MAXNUM.
-
-
-RESULTFUN defines a function used to process results before
-adding them to the final result list. If specified, it should
-accept two arguments, of the same form as those for FILTER (see
-above). Its return value is what gets added to the final result
-list, instead of the default key-data cons cell."
-
- ;; run regexp query
- (dictree--query
- dict #'trie-regexp-search #'dictree-regexp-stack
- #'dictree-regexp-cache #'dictree-create-regexp-cache
- (if (and (eq (elt regexp (- (length regexp) 2)) ?.)
- (eq (elt regexp (- (length regexp) 1)) ?*))
- nil ; cache short REGEXP if it ends in .*
- t) ; cache long REGEXPs otherwise
- no-cache
- regexp nil
- rank-function
- (when rank-function
- (if (functionp rank-function)
- (dictree--wrap-regexp-rankfun rank-function)
- (dictree--wrap-regexp-rankfun
- (dictree-rank-function (if (listp dict) (car dict) dict)))))
- maxnum reverse filter resultfun))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Fuzzy queries
-
-(defun dictree-fuzzy-match
- (dict string distance
- &optional rank-function maxnum reverse filter resultfun no-cache)
- "Return matches for STRING in DICT within Lewenstein DISTANCE
-\(edit distance\) of STRING along with their associated data, in
-the order defined by RANKFUN, defauling to \"lexicographic\"
-order. If REVERSE is non-nil, the matches are sorted in the
-reverse order. Returns nil if no completions are found.
-
-Returns a list of matches, with elements of the form:
-
- ((KEY . DIST) . DATA)
-
-where KEY is a matching key from the trie, DATA its associated
-data, and DIST is its Lewenstein distance \(edit distance\) from
-STRING.
-
-DICT can also be a list of dictionaries, in which case matches
-are sought in all dictionaries in the list. (Note that if the
-same key appears in multiple dictionaries, the alist may contain
-the same key multiple times, each copy associated with the data
-from a different dictionary. If you want to combine identical
-keys, use a meta-dictionary; see `dictree-create-meta-dict'.)
-
-STRING is a sequence (vector, list or string), whose elements
-must be of the same type as elements of the keys stored in
-DICT. If STRING is a string, it must be possible to apply
-`string' to individual elements of DICT keys. The KEYs returned
-in the list will be sequences of the same type as STRING.
-
-DISTANCE must be an integer, and specifies the maximum Lewenstein
-distance \(edit distances\) of matches from STRING.
-
-
-If optional argument RANK-FUNCTION is the symbol `distance', the
-matches are sorted according to their Lewenstein distance from
-STRING. If it is t, the matches are sorted according to the
-dictionary's rank-function (see `dictree-create').
-
-Any other non-nil value of RANK-FUNCTION should be a function
-which accepts two arguments, both of the form
-
- ((KEY . DIST) . DATA)
-
-where KEY is a sequence from the dictionary (of the same type as
-STRING), DIST is its Lewenstein distance from STRING, and DATA is
-its associated data. The RANK-FUNCTION should return non-nil if
-the first argument is ranked strictly higher than the second, nil
-otherwise.
-
-
-The optional integer argument MAXNUM limits the results to the
-first MAXNUM matches. The default is to return all matches.
-
-If the optional argument NO-CACHE is non-nil, it disables any
-caching of the result.
-
-The FILTER argument sets a filter function for the matches. If
-supplied, it is called for each possible match with two
-arguments: a (KEY . DIST) cons cell, and DATA. If the filter
-function returns nil, the match is not included in the results,
-and does not count towards MAXNUM.
-
-RESULTFUN defines a function used to process results before
-adding them to the final result list. If specified, it should
-accept two arguments: a (KEY . DIST) cons cell, and DATA. Its
-return value is what gets added to the final result list, instead
-of the default key-dist-data list."
-
- ;; run fuzzy-match query
- (dictree--query
- dict #'trie-fuzzy-match #'dictree-fuzzy-match-stack
- #'dictree-fuzzy-match-cache #'dictree-create-fuzzy-match-cache
- t no-cache ; cache long STRINGs
- string (list distance)
- rank-function
- (when rank-function
- (cond
- ((eq rank-function 'distance) t)
- ((functionp rank-function) (dictree--wrap-fuzzy-rankfun rank-function))
- ((eq rank-function t)
- (dictree--wrap-fuzzy-rankfun
- (dictree-rank-function (if (listp dict) (car dict) dict))))))
- maxnum reverse filter resultfun))
-
-
-(defun dictree-fuzzy-complete
- (dict prefix distance
- &optional rank-function maxnum reverse filter resultfun no-cache)
- "Return completion of prefixes in DICT within Lewenstein DISTANCE
-\(edit distance\) of PREFIX along with their associated data, in
-the order defined by RANKFUN, defauling to \"lexicographic\"
-order. If REVERSE is non-nil, the matches are sorted in the
-reverse order. Returns nil if no completions are found.
-
-Returns a list of completions, with elements of the form:
-
- ((KEY DIST PFXLEN) . DATA)
-
-where KEY is a matching completion from the trie, DATA its
-associated data, PFXLEN is the length of the prefix part of KEY,
-and DIST is its Lewenstein distance \(edit distance\) from
-PREFIX.
-
-DICT can also be a list of dictionaries, in which case matches
-are sought in all dictionaries in the list. (Note that if the
-same key appears in multiple dictionaries, the alist may contain
-the same key multiple times, each copy associated with the data
-from a different dictionary. If you want to combine identical
-keys, use a meta-dictionary; see `dictree-create-meta-dict'.)
-
-PREFIX is a sequence (vector, list or string), whose elements
-must be of the same type as elements of the keys stored in
-DICT. If PREFIX is a string, it must be possible to apply
-`string' to individual elements of DICT keys. The KEYs returned
-in the list will be sequences of the same type as PREFIX.
-
-DISTANCE must be an integer, and specifies the maximum Lewenstein
-distance \(edit distances\) of prefixes from PREFIX.
-
-
-If optional argument RANK-FUNCTION is the symbol `distance', the
-matches are sorted by increasing Lewenstein distance of their
-prefix \(with same-distance prefixes ordered
-lexicographically\). If it is t, the matches are sorted according
-to the dictionary's rank-function (see `dictree-create').
-
-Any other non-nil value of RANK-FUNCTION should be a function
-that accepts two arguments, both of the form:
-
- ((KEY DIST PFXLEN) . DATA)
-
-where KEY is a completion (of the same type as PREFIX), DIST is
-its Lewenstein distances from PREFIX, and DATA is its associated
-data. RANKFUN should return non-nil if first argument is ranked
-strictly higher than the second, nil otherwise.
-
-
-The optional integer argument MAXNUM limits the results to the
-first MAXNUM matches. The default is to return all matches.
-
-If the optional argument NO-CACHE is non-nil, it prevents caching
-of the result. Ignored for dictionaries that do not have
-fuzzy-match caching enabled.
-
-
-The FILTER argument sets a filter function for the matches. If
-supplied, it is called for each possible match with two
-arguments: a (KEY DIST PFXLEN) list, and DATA. If the filter
-function returns nil, the match is not included in the results,
-and does not count towards MAXNUM.
-
-RESULTFUN defines a function used to process results before
-adding them to the final result list. If specified, it should
-accept two arguments: a (KEY DIST PFXLEN) list, and DATA. Its
-return value is what gets added to the final result list, instead
-of the default key-dist-data list."
-
- ;; run fuzzy-complete query
- (dictree--query
- dict #'trie-fuzzy-complete #'dictree-fuzzy-complete-stack
- #'dictree-fuzzy-complete-cache #'dictree-create-fuzzy-complete-cache
- nil no-cache ; cache short PREFIXes
- prefix (list distance)
- rank-function
- (when rank-function
- (cond
- ((eq rank-function 'distance) t)
- ((functionp rank-function) (dictree--wrap-fuzzy-rankfun rank-function))
- ((eq rank-function t)
- (dictree--wrap-fuzzy-rankfun
- (dictree-rank-function (if (listp dict) (car dict) dict))))))
- maxnum reverse filter resultfun))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Persistent storage
-
-(defun dictree-save (dict &optional compilation)
- "Save dictionary DICT to its associated file.
-Use `dictree-write' to save to a different file.
-
-Optional argument COMPILATION determines whether to save the
-dictionary in compiled or uncompiled form. The default is to save
-both forms. See `dictree-write'.
-
-Interactively, DICT is read from the mini-buffer."
- (interactive (list (read-dict "Dictionary: ")))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
-
- (let ((filename (dictree-filename dict)))
- ;; if dictionary has no associated file, prompt for one
- (unless (and filename (> (length filename) 0))
- (setq filename
- (read-file-name
- (format "Save dictionary %s to file\
- (leave blank to NOT save): "
- (dictree-name dict))
- nil "")))
-
- ;; if filename is blank, don't save
- (if (string= filename "")
- (message "Dictionary %s NOT saved" (dictree-name dict))
- ;; otherwise write dictionary to file
- (setf (dictree-filename dict) filename)
- (dictree-write dict filename t compilation))))
-
-
-
-(defun dictree-write (dict &optional filename overwrite compilation)
- "Write dictionary DICT to file FILENAME.
-Defaults to dictionary's current filename if FILENAME is not
-specified (like `dictree-save').
-
-If optional argument OVERWRITE is non-nil, no confirmation will
-be asked for before overwriting an existing file.
-
-The default is to create both compiled and uncompiled versions of
-the dictionary, with extensions .elc and .el respectively (if
-FILENAME has either of these extensions, they are stripped off
-before proceeding). The compiled version is always used in
-preference to the uncomplied version, as it loads
-faster. However, only the uncompiled version is portable between
-different Emacs versions.
-
-If optional argument COMPILATION is the symbol `compiled', only
-the compiled version will be created, whereas if it is the symbol
-`uncompiled', only the uncompiled version will be created.
-
-Interactively, DICT and FILENAME are read from the mini-buffer,
-and OVERWRITE is the prefix argument."
- (interactive (list (read-dict "Dictionary: ")
- (read-file-name "Write dictionary to file: "
- nil "")
- current-prefix-arg))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
- ;; default to DICT's current file, if any
- (when (or (null filename)
- (and (called-interactively-p 'any) (string= filename "")))
- (setq filename (dictree-filename dict)))
- (if (null filename)
- (progn
- (message "Dictionary %s NOT written" (dictree-name dict))
- nil) ; indicate dictionary wasn't written
-
- (let (dictname buff tmpfile)
- ;; remove any .el(c) extension from filename
- (cond
- ((and (> (length filename) 3)
- (string= (substring filename -3) ".el"))
- (setq filename (substring filename 0 -3)))
- ((and (> (length filename) 4)
- (string= (substring filename -4) ".elc"))
- (setq filename (substring filename 0 -4))))
- ;; create saved dictionary name from filename
- (setq dictname (file-name-nondirectory filename))
-
- (save-excursion
- ;; create a temporary file
- (setq buff
- (find-file-noselect
- (setq tmpfile (make-temp-file dictname))))
- (set-buffer buff)
- ;; call the appropriate write function to write the dictionary code
- (if (dictree--meta-dict-p dict)
- (dictree--write-meta-dict-code dict dictname filename)
- (dictree--write-dict-code dict dictname filename))
- (save-buffer)
- (kill-buffer buff))
-
- ;; prompt to overwrite if necessary
- (when (or overwrite
- (and
- (or (eq compilation 'compiled)
- (not (file-exists-p (concat filename ".el"))))
- (or (eq compilation 'uncompiled)
- (not (file-exists-p (concat filename ".elc")))))
- (y-or-n-p
- (format "File %s already exists. Overwrite? "
- (concat filename ".el(c)"))))
- (condition-case nil
- (progn
- ;; move the uncompiled version to its final destination
- (unless (eq compilation 'compiled)
- (copy-file tmpfile (concat filename ".el") t))
- ;; byte-compile and move the compiled version to its final
- ;; destination
- (unless (eq compilation 'uncompiled)
- (if (save-window-excursion
- (let ((byte-compile-disable-print-circle t)
- err)
- (setq err (byte-compile-file tmpfile))
- err))
- (rename-file (concat tmpfile ".elc")
- (concat filename ".elc") t)
- (error ""))))
- (error "Error writing dictionary. Dictionary %s NOT saved"
- dictname))
-
- ;; if writing to a different name, unload dictionary under old
- ;; name and reload it under new one
- (setf (dictree-modified dict) nil)
- (setf (dictree-filename dict) filename)
- (unless (string= dictname (dictree-name dict))
- (dictree-unload dict)
- (dictree-load filename)))
-
- (delete-file tmpfile)
- (message "Dictionary %s saved to %s" dictname filename)
- t) ; return t to indicate dictionary was successfully saved
- ))
-
-
-
-(defun dictree-save-modified (&optional dict ask compilation force
- no-fail-query)
- "Save all modified dictionaries that have their autosave flag set.
-Returns t if all dictionaries were successfully saved. Otherwise,
-inform the user about the dictionaries which failed to save
-properly, ask them whether they wish to continue anyway, and
-return t or nil accordingly.
-
-If optional argument DICT is a list of dictionaries or a single
-dictionary, only save those.
-
-If optional argument ASK is non-nil, ask for confirmation before
-saving.
-
-Optional argument COMPILATION determines whether to save the
-dictionaries in compiled or uncompiled form. The default is to
-save both forms. See `dictree-write'.
-
-If optional argument FORCE is non-nil, save modified dictionaries
-irrespective of their autosave flag.
-
-If optional argument NO-FAIL-QUERY is non-nil, the user will not
-be queried if a dictionary fails to save properly, and the return
-value is always nil.
-
-Interactively, FORCE is the prefix argument, and the user will not be
-asked whether they wish to continue after a failed save."
- (interactive "P")
-
- ;; sort out arguments
- (when (and (called-interactively-p 'any) dict) (setq dict nil force t))
- (when (dictree-p dict) (setq dict (list dict)))
-
- ;; For each dictionary in list / each loaded dictionary, check if
- ;; dictionary has been modified. If so, save it if autosave is set or
- ;; FORCE is non-nil.
- (let (save-failures)
- (dolist (dic (if (null dict)
- dictree-loaded-list
- dict))
- (when (and (dictree-modified dic)
- (or force (dictree-autosave dic))
- (or (not ask)
- (y-or-n-p (format "Save modified dictionary %s? "
- (dictree-filename dic)))))
- (condition-case nil
- (progn
- (dictree-save dic compilation)
- (setf (dictree-modified dic) nil))
- (error (push dic save-failures)))))
-
- ;; prompt if dictionary saving failed
- (if save-failures
- (if (or (called-interactively-p 'any) no-fail-query)
- (progn
- (message
- (concat
- "Error: failed to save the following modified "
- "dictionaries: "
- (mapconcat #'dictree--name save-failures ", ")))
- nil)
- (yes-or-no-p
- (concat "Error: failed to save the following modified "
- "dictionaries: "
- (mapconcat #'dictree--name save-failures ", ")
- "; continue anyway? ")))
- t)))
-
-
-;; Add the dictree-save-modified function to the kill-emacs-hook to save
-;; modified dictionaries when exiting emacs
-(add-hook 'kill-emacs-query-functions 'dictree-save-modified)
-
-
-
-;;;###autoload
-(defun dictree-load (file)
- "Load a dictionary object from file FILE.
-Returns the dictionary if successful, nil otherwise.
-
-Interactively, FILE is read from the mini-buffer."
- (interactive (list (read-dict "Load dictionary: " nil nil t t)))
-
- ;; sort out dictionary name and file name
- (if (or (symbolp file) (dictree-p file))
- (message "Dictionary %s already loaded" (dictree-name file))
-
- ;; load the dictionary
- (if (not (load file t))
- ;; if loading failed, throw error interactively, return nil
- ;; non-interactively
- (if (called-interactively-p 'any)
- (error "Cannot open dictionary file: %s" file)
- nil)
-
- (let (dictname dict)
- (setq dictname
- (file-name-nondirectory (file-name-sans-extension file))
- dict (symbol-value (intern-soft dictname)))
- (if (not (dictree-p dict))
- ;; if loading failed, throw error interactively, return nil
- ;; non-interactively
- (if (called-interactively-p 'any)
- (error "Error loading dictionary file: %s" file)
- nil)
-
- ;; ensure the dictionary name and file name associated with
- ;; the dictionary match the file it was loaded from
- (when (and (string= (file-name-nondirectory file) file)
- (setq file
- (locate-file file load-path load-suffixes)))
- (setf (dictree-filename dict) file))
- (setf (dictree-name dict) dictname)
-
- ;; make sure the dictionary is in dictree-loaded-list
- ;; (normally the lisp code in the dictionary itself should do
- ;; this, but just to make sure...)
- (unless (memq dict dictree-loaded-list)
- (push dict dictree-loaded-list))
- (message (format "Loaded dictionary %s" dictname))
-
- ;; return dictionary
- dict)))))
-
-
-
-(defun dictree-unload (dict &optional dont-save)
- "Unload dictionary DICT.
-If optional argument DONT-SAVE is non-nil, the dictionary will
-NOT be saved even if its autosave flag is set.
-
-Interactively, DICT is read from the mini-buffer, and DONT-SAVE
-is the prefix argument."
- (interactive (list (read-dict "Dictionary: ")
- current-prefix-arg))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
-
- ;; if dictionary has been modified, autosave is set and not overidden,
- ;; save it first
- (when (and (dictree-modified dict)
- (null dont-save)
- (or (eq (dictree-autosave dict) t)
- (and (eq (dictree-autosave dict) 'ask)
- (y-or-n-p
- (format
- "Dictionary %s modified.\
- Save before unloading? "
- (dictree-name dict))))))
- (dictree-save dict))
-
- ;; if unloading a meta-dict, remove reference to it from constituent
- ;; dictionaries' meta-dict-list cell
- (when (dictree--meta-dict-p dict)
- (mapc
- (lambda (dic)
- (setf (dictree--meta-dict-list dic)
- (delq dict (dictree--meta-dict-list dic))))
- (dictree--meta-dict-dictlist dict)))
-
- ;; remove dictionary from list of loaded dictionaries and unload it
- (setq dictree-loaded-list (delq dict dictree-loaded-list))
- ;; We used `unintern' here before, but that's too dangerous!
- (makunbound (dictree-name dict))
- (message "Dictionary %s unloaded" (dictree-name dict)))
-
-
-
-(defun dictree--write-dict-code (dict dictname filename)
- ;; Write code for normal dictionary DICT to current buffer, giving it
- ;; the name DICTNAME and file FILENAME.
- (let (hashcode tmpdict tmptrie lookup-alist
- complete-alist regexp-alist fuzzy-match-alist fuzzy-complete-alist)
-
- ;; --- convert trie data ---
- ;; if dictionary doesn't use any custom save functions, write
- ;; dictionary's trie directly as is
- (setq tmptrie (dictree--trie dict))
- ;; otherwise, create a temporary trie and populate it with the
- ;; converted contents of the dictionary's trie
- (when (or (dictree--data-savefun dict)
- (dictree--plist-savefun dict))
- (setq tmptrie
- (trie-create-custom
- (trie-comparison-function tmptrie)
- :createfun (trie--createfun tmptrie)
- :insertfun (trie--insertfun tmptrie)
- :deletefun (trie--deletefun tmptrie)
- :lookupfun (trie--lookupfun tmptrie)
- :mapfun (trie--mapfun tmptrie)
- :emptyfun (trie--emptyfun tmptrie)
- :stack-createfun (trie--stack-createfun tmptrie)
- :stack-popfun (trie--stack-popfun tmptrie)
- :stack-emptyfun (trie--stack-emptyfun tmptrie)))
- (trie-mapc
- (lambda (key cell)
- (trie-insert tmptrie key
- (dictree--cell-create
- (funcall (or (dictree--data-savefun dict)
- #'identity)
- (dictree--cell-data cell))
- (funcall (or (dictree--plist-savefun dict)
- #'identity)
- (dictree--cell-plist cell)))))
- (dictree--trie dict))
-
- ;; generate code to convert contents of trie back to original form
- (setq hashcode
- (concat
- hashcode
- " (trie-map\n"
- " (lambda (key cell)\n"
- " (dictree--cell-create\n"
- (if (dictree--data-loadfun dict)
- (concat
- "(funcall (dictree--data-loadfun " dictname ")\n"
- " (dictree--cell-data cell))\n")
- " (dictree--cell-data cell)\n")
- (if (dictree--plist-loadfun dict)
- (concat
- "(funcall (dictree--plist-loadfun " dictname ")\n"
- " (dictree--cell-plist cell))))\n")
- " (dictree--cell-plist cell)))\n")
- " (dictree--trie " dictname "))\n")))
-
-
- ;; --- convert caches for writing to file ---
- ;; hash tables have no read syntax in older Emacsen, so we convert
- ;; them to alists for writing
- (unless (featurep 'hashtable-print-readable)
- ;; convert lookup cache hash table to alist, if it exists
- (when (dictree--lookup-cache dict)
- (maphash
- (lambda (key val)
- (push
- (cons key
- (cons (mapcar #'car (dictree--cache-results val))
- (dictree--cache-maxnum val)))
- lookup-alist))
- (dictree--lookup-cache dict))
- ;; generate code to reconstruct the lookup hash table
- (setq hashcode
- (concat
- hashcode
- "(let ((lookup-cache (make-hash-table :test #'equal))\n"
- " (trie (dictree--trie " dictname ")))\n"
- " (mapc\n"
- " (lambda (entry)\n"
- " (puthash\n"
- " (car entry)\n"
- " (dictree--cache-create\n"
- " (mapcar\n"
- " (lambda (key)\n"
- " (cons key (trie-member trie key)))\n"
- " (dictree--cache-results (cdr entry)))\n"
- " (dictree--cache-maxnum (cdr entry)))\n"
- " lookup-cache))\n"
- " (dictree--lookup-cache " dictname "))\n"
- " (setf (dictree--lookup-cache " dictname ")\n"
- " lookup-cache))\n")))
-
- ;; convert query caches, if they exist
- (dolist (cache-details
- '((dictree--complete-cache complete-alist)
- (dictree--regexp-cache regexp-alist)
- (dictree--fuzzy-match-cache fuzzy-match-alist)
- (dictree--fuzzy-complete-cache fuzzy-complete-alist)))
- (when (funcall (nth 0 cache-details) dict)
- ;; convert hash table to alist
- (set (nth 1 cache-details)
- (let (alist)
- (maphash
- (lambda (key val)
- (push
- (cons key
- (cons
- (mapcar #'car (dictree--cache-results val))
- (dictree--cache-maxnum val)))
- alist))
- (funcall (nth 0 cache-details) dict))
- alist))
- ;; generate code to reconstruct hash table from alist
- (setq
- hashcode
- (concat
- hashcode
- "(let ((cache (make-hash-table :test #'equal))\n"
- " (trie (dictree--trie " dictname ")))\n"
- " (mapc\n"
- " (lambda (entry)\n"
- " (puthash\n"
- " (car entry)\n"
- " (dictree--cache-create\n"
- " (mapcar\n"
- " (lambda (key)\n"
- " (cons key\n"
- " (trie-member\n"
- " trie (if (stringp key) key (car key)))))\n"
- " (dictree--cache-results (cdr entry)))\n"
- " (dictree--cache-maxnum (cdr entry)))\n"
- " cache))\n"
- " (" (symbol-name (nth 0 cache-details)) " " dictname "))\n"
- " (setf (" (symbol-name (nth 0 cache-details)) " "
- dictname ")\n"
- " cache))\n")))))
-
-
- ;; --- write to file ---
- ;; generate the structure to save
- (setq tmpdict (dictree--copy dict))
- (setf (dictree--trie tmpdict) tmptrie
- (dictree--name tmpdict) dictname
- (dictree--filename tmpdict) filename
- (dictree--modified tmpdict) nil
- (dictree--meta-dict-list tmpdict) nil)
- (unless (featurep 'hashtable-print-readable)
- (setf (dictree--lookup-cache tmpdict) lookup-alist
- (dictree--complete-cache tmpdict) complete-alist
- (dictree--regexp-cache tmpdict) regexp-alist
- (dictree--fuzzy-match-cache tmpdict) fuzzy-match-alist
- (dictree--fuzzy-complete-cache tmpdict) fuzzy-complete-alist))
-
- ;; write lisp code that generates the dictionary object
- (let ((print-circle t) (print-level nil) (print-length nil))
- (insert "(eval-when-compile (require 'cl))\n")
- (insert "(require 'dict-tree)\n")
- (insert "(defvar " dictname " nil \"Dictionary " dictname ".\")\n")
- (unwind-protect
- (progn
- ;; transform trie to print form
- (trie-transform-for-print (dictree--trie tmpdict))
- (insert "(setq " dictname
- " '" (prin1-to-string tmpdict) ")\n"))
- ;; if dictionary doesn't use any custom save functions, tmpdict's trie
- ;; is identical to original dict, so transform it back to usable form
- ;; on write error
- (unless (or (dictree--data-savefun dict)
- (dictree--plist-savefun dict))
- (trie-transform-from-read (dictree--trie tmpdict))))
- (insert "(trie-transform-from-read (dictree--trie "
- dictname "))\n")
- (when hashcode (insert hashcode))
- (insert "(unless (memq " dictname " dictree-loaded-list)\n"
- " (push " dictname " dictree-loaded-list))\n"))))
-
-
-
-(defun dictree--write-meta-dict-code (dict dictname filename)
- ;; Write code for meta-dictionary DICT to current buffer, giving it
- ;; the name DICTNAME and file FILENAME.
- (let (hashcode tmpdict lookup-alist
- complete-alist regexp-alist fuzzy-match-alist fuzzy-complete-alist)
-
- ;; --- convert caches for writing to file ---
- ;; hash tables have no read syntax in older Emacsen, so we convert
- ;; them to alists for writing
- (unless (featurep 'hashtable-print-readable)
- ;; convert lookup cache hash table to an alist, if it exists
- (when (dictree--meta-dict-lookup-cache dict)
- (maphash (lambda (key val)
- (push (cons key (mapcar #'car val)) lookup-alist))
- (dictree--meta-dict-lookup-cache dict))
- ;; generate code to reconstruct the lookup hash table
- (setq hashcode
- (concat
- hashcode
- "(let ((cache (make-hash-table :test #'equal)))\n"
- " (mapc (lambda (entry)\n"
- " (puthash (car entry) (cdr entry) cache))\n"
- " (dictree--meta-dict-lookup-cache " dictname "))\n"
- " (setf (dictree--meta-dict-lookup-cache " dictname ")\n"
- " cache))\n")))
-
- ;; convert query caches, if they exist
- (dolist (cache-details
- '((dictree--meta-dict-complete-cache complete-alist)
- (dictree--meta-dict-regexp-cache regexp-alist)
- (dictree--meta-dict-fuzzy-match-cache fuzzy-match-alist)
- (dictree--meta-dict-fuzzy-complete-cache
fuzzy-complete-alist)))
- (when (funcall (nth 0 cache-details) dict)
- ;; convert hash table to alist
- (set (nth 1 cache-details)
- (let (alist)
- (maphash (lambda (key val) (push (cons key val) alist))
- (funcall (nth 0 cache-details) dict))
- alist))
- ;; generate code to reconstruct hash table from alist
- (setq
- hashcode
- (concat
- hashcode
- "(let ((cache (make-hash-table :test #'equal)))\n"
- " (mapc (lambda (entry)\n"
- " (puthash (car entry) (cdr entry) cache))\n"
- " (" (symbol-name (nth 0 cache-details)) " "
- dictname "))\n"
- " (setf (" (symbol-name (nth 0 cache-details)) " "
- dictname ")\n"
- " cache))\n")))))
-
-
- ;; --- write to file ---
- ;; generate the structure to save
- (setq tmpdict (dictree--meta-dict-copy dict))
- (setf (dictree--meta-dict-name tmpdict) dictname
- (dictree--meta-dict-filename tmpdict) filename
- (dictree--meta-dict-modified tmpdict) nil
- (dictree--meta-dict-meta-dict-list tmpdict) nil
- (dictree--meta-dict-dictlist tmpdict)
- (mapcar (lambda (dic) (intern (dictree-name dic)))
- (dictree--meta-dict-dictlist dict)))
- (unless (featurep 'hashtable-print-readable)
- (setf (dictree--meta-dict-lookup-cache tmpdict)
- lookup-alist
- (dictree--meta-dict-complete-cache tmpdict)
- complete-alist
- (dictree--meta-dict-regexp-cache tmpdict)
- regexp-alist
- (dictree--meta-dict-fuzzy-match-cache tmpdict)
- fuzzy-match-alist
- (dictree--meta-dict-fuzzy-complete-cache tmpdict)
- fuzzy-complete-alist))
-
- ;; write lisp code that generates the dictionary object
- (let ((print-circle t) (print-level nil) (print-length nil))
- (insert "(eval-when-compile (require 'cl))\n"
- "(require 'dict-tree)\n")
- (mapc
- (lambda (dic)
- (insert "(unless (dictree-load \"" (dictree-filename dic) "\")\n"
- " (error \"Failed to load dictionary \\\""
- (dictree-name dic) "\\\" required by meta-dict \\\""
- dictname "\\\"\"))\n"))
- (dictree--meta-dict-dictlist dict))
- (insert "(defvar " dictname " nil \"Dictionary " dictname ".\")\n"
- "(setq " dictname " " (prin1-to-string tmpdict) ")\n"
- "(setf (dictree--meta-dict-dictlist " dictname ")\n"
- " (mapcar #'eval (dictree--meta-dict-dictlist "
- dictname ")))\n")
- (when hashcode (insert hashcode))
- (insert "(unless (memq " dictname " dictree-loaded-list)"
- " (push " dictname " dictree-loaded-list))\n"))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Dumping and restoring contents
-
-(defun dictree-populate-from-file
- (dict file
- &optional insert-function key-loadfun data-loadfun plist-loadfun
- balance)
- "Populate dictionary DICT from the key list in file FILE.
-
-Each line of FILE should contain a key, either a string
-\(delimited by \"\), a vector, or a list. (Use the escape
-sequence \\\" to include a \" in a string.) If a line does not
-contain a key, it is silently ignored.
-
-Each line can optionally include data and a property list (in
-that order) to be associated with the key. If present, these
-should separated from each other and the key by whitespace.
-
-INSERT-FUNCTION, KEY-LOAD-FUNCTION, DATA-LOAD-FUNCTION and
-PLIST-LOAD-FUNCTION override the corresponding default functions
-for DICT (see `dictree-create').
-
-Interactively, DICT and FILE are read from the mini-buffer.
-
-
-Technicalities:
-
-The key, data and property list are read as lisp expressions
-using `read'. The keys will be read from FILE in order, unless
-BALANCE is non-nil, in which case they are read from the median
-element outwards (which can help ensure efficient data structures
-are created when using a trie that is not self-balancing, see
-`dictree-create')."
- (interactive (list (read-dict "Dictionary: ")
- (read-file-name "File to populate from: "
- nil "" t)))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
-
- (if (and (called-interactively-p 'any) (string= file ""))
- (message "No file specified; dictionary %s NOT populated"
- (dictree-name dict))
-
- (unless (dictree--meta-dict-p dict)
- (unless key-loadfun
- (setq key-loadfun (dictree--key-loadfun dict)))
- (unless data-loadfun
- (setq data-loadfun (dictree--data-loadfun dict)))
- (unless plist-loadfun
- (setq plist-loadfun (dictree--plist-loadfun dict))))
-
- (save-excursion
- (let ((buff (find-file-noselect file)))
- (set-buffer buff)
-
- ;; insert the keys starting from the median to ensure a
- ;; reasonably well-balanced tree
- (let* ((lines (count-lines (point-min) (point-max)))
- (midpt (+ (/ lines 2) (mod lines 2)))
- entry)
- (message "Inserting keys in %s...(1 of %d)"
- (dictree-name dict) lines)
- ;; insert the median key and set the dictionary's modified
- ;; flag
- (if balance
- (dictree--goto-line midpt)
- (goto-char (point-min)))
- (when (setq entry
- (condition-case nil
- (dictree--read-line key-loadfun data-loadfun
- plist-loadfun)
- (error (error "Error reading line %d of %s"
- midpt file))))
- (dictree-insert dict (car entry) (nth 1 entry)
- insert-function)
- (setf (dictree--cell-plist
- (dictree--lookup dict (car entry) nil))
- (nth 2 entry)))
- ;; insert keys successively further away from the median in
- ;; both directions
- (dotimes (i (1- (if balance midpt lines)))
- (if balance
- (dictree--goto-line (+ midpt i 1))
- (forward-line 1))
- (when (setq entry
- (condition-case nil
- (dictree--read-line key-loadfun data-loadfun
- plist-loadfun)
- (error (error "Error reading line %d of %s"
- (+ midpt i 1) file))))
- (dictree-insert dict (car entry) (nth 1 entry)
- insert-function)
- (setf (dictree--cell-plist
- (dictree--lookup dict (car entry) nil))
- (nth 2 entry)))
- (when (= 49 (mod i 50))
- (message "Inserting keys in %s...(%d of %d)"
- (dictree-name dict)
- (if balance (+ (* 2 i) 2) i)
- lines))
- (when balance
- (dictree--goto-line (- midpt i 1))
- (when (setq entry
- (condition-case nil
- (dictree--read-line key-loadfun data-loadfun
- plist-loadfun)
- (error (error "Error reading line %d of %s"
- (- midpt i 1) file))))
- (dictree-insert dict (car entry)
- (nth 1 entry) insert-function)
- (setf
- (dictree--cell-plist
- (dictree--lookup dict (car entry) nil))
- (nth 2 entry)))))
-
- ;; if inserting from mid-point out, and file contains an even
- ;; number of keys, we still have to add the last one
- (when (and balance (= 0 (mod lines 2)))
- (dictree--goto-line lines)
- (when (setq entry
- (condition-case nil
- (dictree--read-line key-loadfun data-loadfun
- plist-loadfun)
- (error (error "Error reading line %d of %s"
- lines file))))
- (dictree-insert dict (car entry) (nth 1 entry)
- insert-function)
- (setf (dictree--cell-plist
- (dictree--lookup dict (car entry) nil))
- (nth 2 entry))))
-
- (message "Inserting keys in %s...done" (dictree-name dict)))
- (kill-buffer buff)))))
-
-
-
-(defun dictree--read-line
- (&optional key-loadfun data-loadfun plist-loadfun)
- ;; Return a list containing the key, data (if any, otherwise nil) and
- ;; property list (ditto) at the current line of the current buffer.
- (save-excursion
- (let (key data plist)
- ;; read key
- (beginning-of-line)
- (when (setq key (read (current-buffer)))
- (when key-loadfun (setq key (funcall key-loadfun key)))
- ;; if there's anything after the key, use it as data
- (unless (eq (line-end-position) (point))
- (setq data (read (current-buffer))))
- (when data-loadfun (setq data (funcall data-loadfun data)))
- ;; if there's anything after the data, use it as the property list
- (unless (eq (line-end-position) (point))
- (setq plist (read (current-buffer))))
- (when plist-loadfun (funcall plist-loadfun plist))
- ;; return what we've read
- (list key data plist)))))
-
-
-
-(defun dictree-dump-to-buffer (dict &optional buffer type)
- "Dump keys and their associated data
-from dictionary DICT to BUFFER, in the same format as that used
-by `dictree-populate-from-file'. If BUFFER exists, data will be
-appended to the end of it. Otherwise, a new buffer will be
-created. If BUFFER is omitted, the current buffer is used.
-
-TYPE determines the type of sequence to use to represent the
-keys, and should be one of the symbols `string', `vector' or
-`list'. The default is `vector'.
-
-Note that if the data does not have a read syntax, the dumped
-data can not be used to recreate the dictionary using
-`dictree-populate-from-file'.
-
-Interactively, DICT and BUFFER are read from the mini-buffer,
-TYPE is always `string'."
- (interactive (list (read-dict "Dictionary: ")
- (read-buffer
- "Buffer to dump to (defaults to current): "
- (buffer-name (current-buffer)))
- 'string))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
-
- ;; select the buffer, creating it if necessary
- (if buffer
- (setq buffer (get-buffer-create buffer))
- (setq buffer (current-buffer)))
- (set-buffer buffer)
-
- ;; move point to end of buffer and make sure it's at start of new line
- (goto-char (point-max))
- (unless (= (point) (line-beginning-position))
- (insert "\n"))
-
- ;; dump keys
- (message "Dumping keys from %s to %s..."
- (dictree-name dict) (buffer-name buffer))
- (let ((count 0) (dictsize (dictree-size dict)))
- (message "Dumping keys from %s to %s...(key 1 of %d)"
- (dictree-name dict) (buffer-name buffer) dictsize)
-
- ;; map dump function over dictionary
- (dictree--mapc
- (lambda (key data plist)
- (when (= 99 (mod count 100))
- (message "Dumping keys from %s to %s...(key %d of %d)"
- (dictree-name dict) (buffer-name buffer)
- (1+ count) dictsize))
- (insert (prin1-to-string
- (funcall (or (dictree--key-savefun dict) #'identity)
- key)))
- (when (setq data
- (funcall (or (dictree--data-savefun dict) #'identity)
- data))
- (insert " " (prin1-to-string data)))
- (when (setq plist
- (funcall (or (dictree--plist-savefun dict) #'identity)
- plist))
- (unless data (insert " nil"))
- (insert " " (prin1-to-string plist)))
- (insert "\n")
- (setq count (1+ count)))
- dict type) ; dictree-mapc target
-
- (message "Dumping keys from %s to %s...done"
- (dictree-name dict) (buffer-name buffer)))
- (switch-to-buffer buffer))
-
-
-
-(defun dictree-dump-to-file (dict filename &optional type overwrite)
- "Dump keys and their associated data
-from dictionary DICT to a text file FILENAME, in the same format
-as that used by `dictree-populate-from-file'. Prompts to overwrite
-FILENAME if it already exists, unless OVERWRITE is non-nil.
-
-TYPE determines the type of sequence to use to represent the
-keys, and should be one of the symbols `string', `vector' or
-`list'. The default is `vector'.
-
-Note that if the data does not have a read syntax and no , the dumped
-data can not be used to recreate the dictionary using
-`dictree-populate-from-file'.
-
-Interactively, DICT and FILE are read from the mini-buffer,
-OVERWRITE is the prefix argument, and TYPE is always string."
- (interactive (list (read-dict "Dictionary: ")
- (read-file-name "File to dump to: " nil "")))
- (when (and (called-interactively-p 'any) (symbolp dict))
- (setq dict (symbol-value dict)))
-
- (if (and (called-interactively-p 'any) (string= filename ""))
- (message "Dictionary %s NOT dumped" (dictree-name dict))
-
- ;; check if file exists, and prompt to overwrite it if necessary
- (if (and (file-exists-p filename)
- (not overwrite)
- (not (y-or-n-p
- (format "File %s already exists. Overwrite? "
- filename))))
- (message "Key dump cancelled")
-
- (let (buff)
- ;; create temporary buffer, dump keys to it, and save to
- ;; FILENAME
- (setq buff (generate-new-buffer filename))
- (save-window-excursion
- (dictree-dump-to-buffer dict buff type)
- (write-file filename))
- (kill-buffer buff)))))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Minibuffer completion
-
-(defvar dictree-history nil
- "History list for commands that read a dictionary name.")
-
-(defvar dictree-loaded-history nil
- "History list for commands that read a loaded dictionary name.")
-
-
-;;;###autoload
-(defun read-dict
- (prompt &optional default dictlist allow-unloaded allow-unmatched)
- "Read the name of a dictionary with completion, and return it.
-
-Prompt with PROMPT. By default, return DEFAULT. If DICTLIST is
-supplied, only complete on dictionaries in that list.
-
-If ALLOW-UNLOADED is non-nil, also complete on the names of
-unloaded dictionaries (actually, on any Elisp file in the current
-`load-path' restricted to subdirectories of your home directory
-whose file name starts with \"dict-\"). If an unloaded dictionary
-is read, the name of the Elisp file will be returned, without
-extension, suitable for passing to `load-library'."
-
- (let (dictname paths)
- ;; when allowing unloaded dictionaries...
- (when allow-unloaded
- ;; get paths in load-path that are subdirectories of home
- ;; directory
- (dolist (d load-path)
- (when (eq (aref d 0) ?~) (push d paths)))
- ;; gather names of all Elisp libraries in this restricted
- ;; load-path
- (dolist (f (all-completions
- "" (apply-partially #'locate-file-completion-table
- paths (get-load-suffixes))))
- (when (and (null (file-name-directory f))
- (and (> (length f) 5)
- (string= (substring f 0 5) "dict-"))
- (null (file-name-extension f))
- (not (member (file-name-sans-extension f) dictname)))
- (push (file-name-sans-extension f) dictname))))
- ;; gather names of loaded dictionaries
- (mapc (lambda (dict)
- (unless (or (null (dictree-name dict))
- (member (dictree-name dict) dictname))
- (push (list (dictree-name dict)) dictname)))
- (or dictlist dictree-loaded-list))
- ;; do completing-read
- (setq dictname (completing-read
- prompt
- (if allow-unmatched
- (completion-table-in-turn
- dictname #'read-file-name-internal)
- dictname)
- nil (not allow-unmatched) nil
- (if allow-unloaded
- 'dictree-history
- 'dictree-loaded-history)
- (and (dictree-p default) (dictree-name default))))
- ;; return dictionary
- (cond
- ;; if user typed a file name, return that
- ((and allow-unmatched (file-regular-p dictname)) dictname)
- ;; if user selected a loaded dictionary, return dict itself
- ((condition-case nil
- (dictree-p (symbol-value (intern-soft dictname)))
- (void-variable nil))
- (intern-soft dictname))
- ;; if user selected an unloaded dictionary, return dict name
- ((and allow-unloaded (stringp dictname)) dictname)
- ;; if DEFAULT was specified, return that
- (default default)
- ;; should never get here!
- (t (error "Unknown error reading dictionary")))
- ))
-
-
-
-
-;; ----------------------------------------------------------------
-;; Pretty-print dictionaries during edebug
-
-;; We advise the `edebug-prin1' and `edebug-prin1-to-string' functions
-;; (actually, aliases) so that they print "#<dict-tree NAME>" instead of
-;; the full print form for dictionaries.
-;;
-;; This is because, if left to its own devices, edebug hangs for ages
-;; whilst printing large dictionaries, and you either have to wait for a
-;; *very* long time for it to finish, or kill Emacs entirely. (Even C-g
-;; C-g fails!)
-;;
-;; We do this also for lists of dictionaries, since those occur quite
-;; often, but not for other sequence types or deeper nested structures,
-;; to keep the implementation as simple as possible.
-;;
-;; Since the print form of a dictionary is practically incomprehensible
-;; anyway, we don't lose much by doing this. If you *really* want to
-;; print dictionaries in full whilst edebugging, despite this warning,
-;; disable the advice.
-
-
-(eval-when-compile
- (require 'edebug)
- (require 'advice))
-
-(defun dictree--prin1 (dict stream)
- (princ (concat "#<dict-tree \"" (dictree-name dict) "\""
- (if (dictree--lookup-cache dict)
- (concat " lookup "
- (prin1-to-string
- (hash-table-count
- (dictree--lookup-cache dict))))
- "")
- (if (dictree--complete-cache dict)
- (concat " complete "
- (prin1-to-string
- (hash-table-count
- (dictree--complete-cache dict))))
- "")
- (if (dictree--regexp-cache dict)
- (concat " regexp "
- (prin1-to-string
- (hash-table-count
- (dictree--regexp-cache dict))))
- "")
- (if (dictree--fuzzy-match-cache dict)
- (concat " fuzzy-match "
- (prin1-to-string
- (hash-table-count
- (dictree--fuzzy-match-cache dict))))
- "")
- (if (dictree--fuzzy-complete-cache dict)
- (concat " fuzzy-complete "
- (prin1-to-string
- (hash-table-count
- (dictree--fuzzy-complete-cache dict))))
- "")
- ">")
- stream))
-
-(defun dictree--edebug-pretty-print (object)
- (cond
- ((dictree-p object)
- (concat "#<dict-tree \"" (dictree-name object) "\""
- (if (dictree--lookup-cache object)
- (concat " lookup "
- (prin1-to-string
- (hash-table-count
- (dictree--lookup-cache object))))
- "")
- (if (dictree--complete-cache object)
- (concat " complete "
- (prin1-to-string
- (hash-table-count
- (dictree--complete-cache object))))
- "")
- (if (dictree--regexp-cache object)
- (concat " regexp "
- (prin1-to-string
- (hash-table-count
- (dictree--regexp-cache object))))
- "")
- (if (dictree--fuzzy-match-cache object)
- (concat " fuzzy-match "
- (prin1-to-string
- (hash-table-count
- (dictree--fuzzy-match-cache object))))
- "")
- (if (dictree--fuzzy-complete-cache object)
- (concat " fuzzy-complete "
- (prin1-to-string
- (hash-table-count
- (dictree--fuzzy-complete-cache object))))
- "")
- ">"))
- ((null object) "nil")
- ((let ((dlist object) (test t))
- (while (or (dictree-p (car-safe dlist))
- (and dlist (setq test nil)))
- (setq dlist (cdr dlist)))
- test)
- (concat "(" (mapconcat (lambda (d)
- (concat "#<dict-tree \""
- (dictree-name d) "\">"))
- object " ") ")"))
- ;; ((vectorp object)
- ;; (let ((pretty "[") (len (length object)))
- ;; (dotimes (i (1- len))
- ;; (setq pretty
- ;; (concat pretty
- ;; (if (trie-p (aref object i))
- ;; "#<trie>" (prin1-to-string (aref object i))) " ")))
- ;; (concat pretty
- ;; (if (trie-p (aref object (1- len)))
- ;; "#<trie>" (prin1-to-string (aref object (1- len))))
- ;; "]")))
- ))
-
-(if (fboundp 'cl-print-object)
- (progn
- (cl-defmethod cl-print-object ((object dictree-) stream)
- (dictree--prin1 object stream))
- (cl-defmethod cl-print-object ((object dictree--meta-dict) stream)
- (dictree--prin1 object stream)))
-
- (when (fboundp 'ad-define-subr-args)
- (ad-define-subr-args 'edebug-prin1 '(object &optional printcharfun)))
-
- (defadvice edebug-prin1
- (around dictree activate compile preactivate)
- (let ((pretty (dictree--edebug-pretty-print object)))
- (if pretty
- (progn
- (prin1 pretty printcharfun)
- (setq ad-return-value pretty))
- ad-do-it)))
-
- (when (fboundp 'ad-define-subr-args)
- (ad-define-subr-args 'edebug-prin1-to-string '(object &optional noescape)))
-
- (defadvice edebug-prin1-to-string
- (around dictree activate compile preactivate)
- (let ((pretty (dictree--edebug-pretty-print object)))
- (if pretty
- (setq ad-return-value pretty)
- ad-do-it))))
-
-
-(provide 'dict-tree)
-
-;;; dict-tree.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master a7732cf: * externals-list: Convert `dict-tree` from subtree to external,
Stefan Monnier <=