diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el')
-rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el | 223 |
1 files changed, 0 insertions, 223 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el deleted file mode 100644 index 1ba6085b9c91..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el +++ /dev/null @@ -1,223 +0,0 @@ -;;; shorten.el --- component-wise string shortener - -;; Copyright (C) 2013 John J Foerch <jjfoerch@earthlink.net> - -;; Keywords: extensions -;; Author: John J Foerch <jjfoerch@earthlink.net> -;; URL: https://github.com/jorgenschaefer/circe/blob/master/shorten.el - -;; This program 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. - -;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This is a component-wise string shortener, meaning that, given a list -;; of strings, it breaks each string into parts, then computes shortest -;; prefix of each part with respect to others of the same 'depth', such -;; that when joined back together, the shortened form of the whole string -;; remains unique within the resulting list. Many styles of shortening -;; are made possible via three functions that the caller may provide: the -;; split function, the join function, and the validate-component function. -;; -;; Strings are broken with the value of `shorten-split-function' (a -;; procedure string->list), and shortened components are rejoined with the -;; value of `shorten-join-function' (a procedure list->string[*]). The -;; default split and join functions break the string on word boundaries, -;; and rejoin on the empty string. Potential shortened forms of -;; components are tested with `shorten-validate-component-function'; its -;; default value passes only if its argument contains at least one -;; word-constituent character (regexp \w), meaning that by default, -;; components consisting entirely of non-word characters will not be -;; shortened, and components that start with non-word characters will only -;; be shortened so much that they have at least one word-constituent -;; character in them. -;; -;; The main entry point is `shorten-strings', which takes a list of strings -;; as its argument and returns an alist ((STRING . SHORTENED-STRING) ...). -;; -;; [*] Also takes a second argument; see docstring of -;; `shorten-join-function'. - -;;; History: - -;; - Version 0.1 (March 7, 2013): initial release - -;;; Code: - -;; Tree utils -;; -(defsubst shorten-make-tree-root () - (cons nil nil)) - -(defsubst shorten-tree-make-entry (token short full) - (list token short full nil)) - -(defsubst shorten-tree-token (entry) - (car entry)) - -(defsubst shorten-tree-fullname (entry) - (nth 2 entry)) - -(defsubst shorten-tree-descendants (entry) - (nthcdr 3 entry)) - -(defsubst shorten-tree-set-shortened (entry short) - (setcar (cdr entry) short)) - -(defsubst shorten-tree-set-fullname (entry full) - (setcar (nthcdr 2 entry) full)) - -(defsubst shorten-tree-insert (node item) - (when (car node) - (setcdr node (cons (car node) (cdr node)))) - (setcar node item)) - - -;; Caller configuration -;; -(defun shorten-split (s) - (split-string s "\\b" t)) - -(defun shorten-join (lst &optional tail-count) - (mapconcat #'identity lst "")) - -(defun shorten-join-sans-tail (lst tail-count) - "A shorten-join that drops unnecessary tail components." - (shorten-join (butlast lst tail-count))) - -(defun shorten-validate-component (str) - (string-match-p "\\w" str)) - -(defvar shorten-split-function #'shorten-split - "Value should be a function of string->list that breaks a -string into components. The default breaks on word-boundaries. -To get simple prefix shortening, bind this to `list'. - -Users should not generally change the global value of this -variable; instead, bind it dynamically around calls to -`shorten-strings'.") - -(defvar shorten-join-function #'shorten-join - "A function that takes a list of components and a tail-count, -and returns a joined string. Tail-count is the number of -components on the end of the list that are not needed to uniquify -the result, and so may be safely dropped if aggressive shortening -is desired. The default preserves tail components, and joins the -list on the empty string. - -Users should not generally change the global value of this -variable; instead, bind it dynamically around calls to -`shorten-strings'.") - -(defvar shorten-validate-component-function #'shorten-validate-component - "Predicate that returns t if a proposed shortened form of a -single component is acceptable, nil if a longer one should be -tried. The default validates only when the candidate contains at -least one word-constituent character, thus strings consisting of -punctuation will not be shortened. For aggressive shortening, -bind to a procedure that always returns t. - -Users should not generally change the global value of this -variable; instead, bind it dynamically around calls to -`shorten-strings'.") - - -;; Main procedures -;; -(defun shorten-one (str others) - "Return shortest unique prefix of STR among OTHERS, or STR if -it cannot be shortened. If STR is a member of OTHERS (tested -with `eq') that entry is ignored. The value of -`shorten-validate-component-function' will be used to validate -any prefix." - (let ((max (length str)) - (len 1)) - (or (catch 'return - (while (< len max) - (let ((prefix (substring str 0 len))) - (when (funcall shorten-validate-component-function prefix) - (when (catch 'return - (dolist (other others t) - (when (and (>= (length other) len) - (string= (substring other 0 len) prefix) - (not (eq other str))) - (throw 'return nil)))) - (throw 'return prefix))) - (setq len (1+ len))))) - str))) - -(defun shorten-walk-internal (node path tail-count result-out) - (let ((others (mapcar #'car node))) - (setq tail-count (if (cdr node) 0 (1+ tail-count))) - (dolist (entry node) - (let* ((token (shorten-tree-token entry)) - (shortened (shorten-one token others)) - (path (cons shortened path)) - (fullname (shorten-tree-fullname entry)) - (descendants (shorten-tree-descendants entry)) - (have-descendants (not (equal '(nil) descendants)))) - (shorten-tree-set-shortened entry shortened) - ;; if this entry has a fullname, add to result-out - (when fullname - (let ((joined (funcall shorten-join-function - (reverse path) - (if have-descendants 0 tail-count)))) - (shorten-tree-insert result-out (cons fullname joined)))) - ;; if this entry has descendants, recurse - (when have-descendants - (shorten-walk-internal descendants path - (if fullname -1 tail-count) - result-out)))))) - -(defun shorten-walk (tree) - "Takes a tree of the type made by `shorten-make-tree' and -returns an alist ((STRING . SHORTENED-STRING) ...). Uses -`shorten-join-function' to join shortened components back -together into SHORTENED-STRING. See also -`shorten-validate-component-function'." - (let ((result-out (shorten-make-tree-root))) - (shorten-walk-internal tree '() -1 result-out) - (if (equal '(nil) result-out) nil result-out))) - -(defun shorten-make-tree (strings) - "Takes a list of strings and returns a tree of the type used by -`shorten-walk' to generate shortened strings. Uses -`shorten-split-function' to split the strings." - (let ((tree (shorten-make-tree-root))) - (dolist (s strings) - (let ((node tree) - (tokens (funcall shorten-split-function s)) - (entry nil)) - ;; create a path in tree for tokens - (dolist (token tokens) - (setq entry (assoc token node)) - (when (not entry) - (setq entry (shorten-tree-make-entry token nil nil)) - (shorten-tree-insert node entry)) - (setq node (shorten-tree-descendants entry))) - ;; for the last token, set 'fullname' - (shorten-tree-set-fullname entry s))) - (if (equal tree '(nil)) nil tree))) - -;;;###autoload -(defun shorten-strings (strings) - "Takes a list of strings and returns an alist ((STRING -. SHORTENED-STRING) ...). Uses `shorten-split-function' to split -the strings, and `shorten-join-function' to join shortened -components back together into SHORTENED-STRING. See also -`shorten-validate-component-function'." - (shorten-walk (shorten-make-tree strings))) - - -(provide 'shorten) -;;; shorten.el ends here |