~rgrjr/rgr-hacks

3d42558bd54b42fe736010059eacc7e5c31f1e00 — Bob Rogers 7 months ago f1acd03 master
Improve abbrev-completion.

   This amounts to a nearly-complete rewrite.
   From the improve-abbrev-completion branch.
* rgr-abbrev-completion.el:
   + (rgr-abbrev-kill):  Renamed from rgr-kill-last-symbol-abbreviation.
   + Content in save files written the same day is now merged.
   + Use lexical binding.
   + The code has also been modernized, and naming has been cleaned up.
* test/test-rgr-abbrev-completion.el:
   + Now with more thorough testing.
2 files changed, 791 insertions(+), 662 deletions(-)

M rgr-abbrev-completion.el
M test/test-rgr-abbrev-completion.el
M rgr-abbrev-completion.el => rgr-abbrev-completion.el +610 -646
@@ 1,37 1,24 @@
;;; -*- lexical-binding: t -*-
;;;*****************************************************************************
;;;
;;;    Self-training completion
;;;;  Self-training completion
;;;
;;;   Really, this is just a different notion of abbrevs.  It is written to be
;;; easily gnu-ified.
;;;   Really, this is just a different notion of abbrevs.  It was originally
;;; written for Zmacs on the Symbolics Lisp Machine and exported to Gnu Emacs 18
;;; via a lisp-to-lisp translator (that no longer exists), but the Emacs version
;;; became the primary version when I lost access to Lisp Machines in the
;;; mid-90's.
;;;
;;;    As you are typing along (or even just moving the cursor), it learns the
;;; words you type.  When you type a prefix and follow it with f4, it supplies
;;; words you type.  When you type a prefix and follow it with f7, it supplies
;;; as much of the completion as it can.  If it finishes the whole word, it
;;; increments the completion count on that word so it can make a better guess
;;; when completing abbreviations.  [oops -- what if a word and an abbreviation
;;; are the same?  -- rgr, 5-May-94.]  If you type f4 after an obvious
;;; are the same?  -- rgr, 5-May-94.]  If you type f7 after an obvious
;;; abbreviation (such as "mvb" for "multiple-value-bind"), it inserts the "most
;;; popular" completion, as determined by completion counts, incrementing it as
;;; well.  If you type f4 again immediately, it cycles through the possibilities
;;; in descending order of popularity, updating the counts as it goes.  At any
;;; point, [(meta f4)] gives a menu of possibilities.  This means the commands
;;; must remember a fair amount of state from one keystroke to the next, though
;;; they try not to cons unless they absolutely have to.
;;;
;;;    Bugs/to do:
;;;
;;;    2.  It would be nice to get rid of trailing "." and "]" (and probably
;;; others) in words.  Also, "words" that are entirely nonalphabetic should
;;; probably be omitted.  The problem is finding a reasonable choke-point for
;;; this.  -- rgr, 27-Jul-95.
;;;
;;;    4.  Should replace fast-string-hash with a simple intern of the first
;;; three letters.  Probably faster, since it will run in C rather than byte
;;; code.
;;;
;;;    7.  ***bug***:  new version considers it OK that a string is a completion
;;; of itself.
;;; well.  If you type f7 again immediately, it cycles through the possibilities
;;; in descending order of popularity, updating the counts as it goes.
;;;
;;;    Modification history:
;;;


@@ 83,64 70,63 @@
;;; rgr-write-completion-file: made this a command.  -- rgr, 2-Sep-02.
;;;

(defvar rgr-completion-min-entry-length 6
(require 'cl-lib)

(defvar rgr-abbrev-complete-silently nil
  "If true, silence all messages -- meant only for testing.")
(defvar rgr-abbrev-min-entry-length 6
  ;; [used to be 8; we are now trying a new value, which is in fact the
  ;; "historic" LSP value.  -- rgr, 10-Mar-99.]
  "*Don't bother remembering words shorter than this.")

(defvar rgr-abbrev-completion-save-directory
	(expand-file-name "~/emacs/completions"))
(defvar rgr-abbrev-completion-save-file
	(and rgr-abbrev-completion-save-directory
	     (file-writable-p rgr-abbrev-completion-save-directory)
	     (expand-file-name "completions.text"
			       rgr-abbrev-completion-save-directory))
  "*Default file into which to save completions between sessions, nil to
disable.")
(defvar rgr-completion-auto-save-timer nil
  "A timer object if auto-save is enabled (see rgr-completion-start-auto-save),
else nil.")
	(expand-file-name "~/emacs/completions")
  "Default directory in which to save completions.
This is ~/emacs/completions by default; if this directory does
not exist, then completion saving is disabled.")

(defvar rgr-abbrev-completion-save-file t
  "Name of a file into which to save completions between sessions.
Completions that meet the usage threshold criterion are written
to this file by the rgr-write-completion-file command, and on
exiting Emacs unless disabled.  The value should be a file name
string, the symbol t to take the default of \"completions.text\",
a function of no arguments that is called at save time to compute
the file name, or nil to disable.  The default is t.  If the
name, however specified, is not absolute, it is expanded relative
to the rgr-abbrev-completion-save-directory value.")

(defvar rgr-abbrev-after-save-hook nil
  "*Hook run after saving a completion file.  Mostly this is used as
communication between rgr-install-weekly-completion-cycle and
rgr-completion-do-auto-save so that the file name gets updated to the
next day when both features are in effect.")
  "Hook for functions to run after saving a completion file.")

(defvar rgr-abbrev-completion-append-to-file-p
	'rgr-abbrev-completion-file-newer-than-one-day-p
  "t to always append to an existing file, nil to never append, and the
name of a function that takes the filename as an argument and returns a
boolean otherwise.")

(defconst rgr-string-table-size 311)
(defvar rgr-string-table (make-vector rgr-string-table-size nil))

(defvar rgr-abbreviation-scratch-string (make-string 100 32)
  "See the rgr-abbrev-make-simple-abbreviation function.")
  "Whether to append (include via merging) existing save contents.
Values are t to always append, nil to discard existing contents,
and the name of a function that takes the filename as an argument
and returns a boolean otherwise.  The default is the symbol
rgr-abbrev-completion-file-newer-than-one-day-p, which returns t
only if the passed file is less than a day old.")

(defvar rgr-abbrev-completion-state nil
  "Completion state, cons of (word-start word-end orig-word new-word),
and (current-index . possibilities).")

;; [attempt to dekludgify.  -- rgr, 10-Feb-98.]
(defsubst rgr-abbrev-completion-state-insertion-start (&optional state)
  (car (car (or state rgr-abbrev-completion-state))))
(defsubst rgr-abbrev-completion-state-original-string (&optional state)
  (nth 2 (car (or state rgr-abbrev-completion-state))))
(defsubst rgr-abbrev-completion-state-replacement-string (&optional state)
  (nth 3 (car (or state rgr-abbrev-completion-state))))
  "Internal completion state.
This is an rgr-abbrev-state struct.")

(cl-defstruct (rgr-abbrev-state
		(:conc-name rgr-abbrev--)
		(:constructor make-rgr-abbrev-state))
  "Structure that describes the state of the last completion attempt."
  (insertion-start nil :documentation "Point where the insertion started")
  (insertion-end nil :documentation "Point where the insertion ended")
  (original-string nil :documentation "String replaced by the insertion")
  (replacement-string nil :documentation "Inserted completion string")
  (last-entry nil :documentation "Entry (a cons) for a full completion")
  (current-index 0 :type integer
		 :documentation "Index into possibilities for repeating")
  (possibilities nil :type list :documentation "Other possible completions"))

;;;; Low-level utility definitions.

(defsubst rgr-alphanumericp (char)
  ;; Curiously, this also includes digits in both Lisp and C syntaxes.  -- rgr,
  ;; 29-Nov-96.
  (eq (char-syntax char) ?w))

(defsubst rgr-lower-case-p (char)
  ;; This hack doesn't work in EBCDIC, where the alphabetics aren't dense,
  ;; except that rgr-abbrev-make-simple-abbreviation arranges to give it only
  ;; alphabetics, so it's OK.  (I used to have to care about such things.)
  (and (<= ?a char) (<= char ?z)))

(defsubst rgr-identifier-char-p (char)
  "Return T if legal in an identifier.  Characters that are true for
this test but are not alphabetic are used as break characters when


@@ 150,18 136,22 @@ splitting identifiers up into words."
    (or (eq code ?w)
        (eq code ?_))))

(defun rgr-buffer-word-start (end)
  "Look backward for the beginning of a word, and return the point (but
leave the current point where it is)."
  ;; [formerly a grinder for the with-rgr-word macro, but now used by itself.
  ;; -- rgr, 1-Feb-98.]
(defun rgr-abbrev--word-start (&optional end)
  "Look backward for the beginning of a word, returning point
without moving it."
  (save-excursion
    (goto-char end)
    (when end
      (goto-char end))
    (while (and (not (bolp))
                (rgr-identifier-char-p (char-after (1- (point)))))
      (forward-char -1))
    (point)))

(defun rgr-abbrev--word-before (&optional end)
  "Return the word before point, without moving point."
  (let ((word-start (rgr-abbrev--word-start end)))
    (buffer-substring-no-properties word-start (point))))

(defun rgr-string-case (string)
  "Return a keyword symbol in (:upper :lower :mixed) depending upon the
case of alphabetic characters in string, or NIL if the string has no


@@ 182,37 172,7 @@ alphabetic characters."
          (lower-p ':lower)
          (t nil))))

(defun rgr-fast-string-hash (string)
  (let ((len (length string)))
    (cond ((eq len '0) 0)
          ((eq len '1) (upcase (aref string 0)))
          ((eq len '2)
           (+ (* (upcase (aref string 0)) 29)
              (upcase (aref string 1))))
          (t (+ (upcase (aref string 2))
                (* (+ (* (upcase (aref string 0)) 29)
                      (upcase (aref string 1)))
                   29))))))

(defun rgr-abbrev-intern-string (string initial-value)
  (let ((hash (mod (rgr-fast-string-hash string) rgr-string-table-size)))
    (or (let ((<tail> (aref rgr-string-table hash)))
          (while (and <tail> (not (equal string (car (car <tail>)))))
            (setq <tail> (cdr <tail>)))
          (car <tail>))
        (let ((len (length string)))
	  ;; [don't downcase all-upper things; now that I'm hacking C (sigh),
	  ;; case matters.  -- rgr, 10-Dec-96.]
          '(if (eq (rgr-string-case string) ':upper)
              (let ((i 0))
                (while (< i len)
                  (aset string i (downcase (aref string i)))
                  (setq i (1+ i)))))
          (car (aset rgr-string-table hash
		     (cons (cons string initial-value)
			   (aref rgr-string-table hash))))))))

(defun rgr-abbrev-prefix-equal (prefix string)
(defun rgr-abbrev--prefix-equal (prefix string)
  ;; Case-insensitive prefix comparison without consing.
  (let ((end2 (length prefix)))
    (and (>= (length string) end2)


@@ 225,146 185,281 @@ alphabetic characters."
             (setq i (+ i 1)))
           equal-p))))

(defun rgr-abbrev-map-possibilities (function string &optional abbrevs-too-p)
  ;; Applies function to each entry that is a possible completion or
  ;; abbreviation expansion of string, with the second arg detailing which: t
  ;; for prefix or nil for abbrev.  [was the rgr-map-completions function, now
  ;; subsumes rgr-map-abbreviations as well.  -- rgr, 1-Feb-98.]
  (let ((<tail>
         (aref rgr-string-table
               (mod (rgr-fast-string-hash string) rgr-string-table-size)))
        (entry nil))
    (while <tail>
      (setq entry (car <tail>))
      (if (rgr-abbrev-prefix-equal string (car entry))
          (if (listp (cdr entry))
	      ;; Abbreviations
	      (and abbrevs-too-p
		   (let ((<tail> (cdr entry)))
		     (while <tail>
		       (funcall function (car <tail>) nil)
		       (setq <tail> (cdr <tail>)))))
	      ;; Prefixes
	      (and (not (eq abbrevs-too-p ':abbrevs-only))
		   (funcall function entry t))))
      (setq <tail> (cdr <tail>)))))
(defun rgr-prefix-length (string1 string2 &optional max)
  ;; Return the length of the common prefix of string1 and string2, up to a
  ;; maximum of max, or 0 if they have no common prefix.
  (let* ((lens (min (length string1) (length string2)))
         (max (if max (min max lens) lens))
         (i 0))
    (while (and (< i max)
                (char-equal (aref string1 i) (aref string2 i)))
      (cl-incf i))
    i))

(defun rgr-abbrev--prefix-p (prefix string)
  ;; Return true if prefix is the same as or a prefix of string.
  (= (rgr-prefix-length prefix string) (length prefix)))

(defvar rgr-abbrev--scratch-string (make-string 100 32)
  "See the rgr-abbrev-make-simple-abbreviation function.")

(defun rgr-abbrev-make-simple-abbreviation (string)
  ;; Pick out the first letters of words delimited by non-alphanumerics, or
  ;; uppercase letters that come immediately after lower case, as in
  ;; "reallyStupidNamingConvention" -> "rsnc".
  (let ((last-alpha nil) (last-lc nil)
        (abbrev rgr-abbreviation-scratch-string)
        (abbrev-len 0)
	(to (length string))
	(i 0))
    (while (< i to)
        (abbrev rgr-abbrev--scratch-string)
        (abbrev-len 0))
    (cl-dotimes (i (length string))
      (let* ((char (aref string i))
	     (this-alpha (rgr-alphanumericp char))
	     (this-lc (and this-alpha (rgr-lower-case-p char))))
        (cond ((and this-alpha
		    (or (not last-alpha)
			(and last-lc (not this-lc))))
	        ;; take this char (alphabetic after nonalphabetic, or uppercase
	        ;; after lowercase).
	        (aset abbrev abbrev-len (downcase char))
	        (setq abbrev-len (+ abbrev-len 1))))
	     (this-alpha (eq (char-syntax char) ?w))
	     (this-lc (and this-alpha
			   (and (<= ?a char) (<= char ?z)))))
        (when (and this-alpha
		   (or (not last-alpha)
		       (and last-lc (not this-lc))))
	  ;; take this char (alphabetic after nonalphabetic, or uppercase
	  ;; after lowercase).
	  (setf (aref abbrev abbrev-len) (downcase char))
	  (cl-incf abbrev-len))
	(setq last-alpha this-alpha)
	(setq last-lc this-lc)
	(setq i (1+ i))))
	(cl-incf i)))
    (substring abbrev 0 abbrev-len)))

(defun rgr-undefine-entry (entry)
;;;; Completion storage

;; This is the part of the code that stores completions and their use counts,
;; and implements searching for completions based on prefixes and abbreviation
;; prefixes.  Entrypoints are rgr-abbrev--intern-string and
;; rgr-abbrev--undefine-entry to add and delete them, and
;; rgr-abbrev--map-all-strings and rgr-abbrev--map-possibilities to discover
;; them.

(defconst rgr-string-table-size 311)
(defvar rgr-string-table (make-vector rgr-string-table-size 0)
  "NB:  This is actually an obarray.  All symbols entered into this table
have exactly three characters the completion/abbreviation prefix,
and we only intern symbols we actually use, so they are always
boundp if present.")

(defmacro with-rgr-abbrev-storage (_ignored &rest body)
  "Introduce a new abbrev database storage scope.
Used for merging save files, and for testing."
  `(let ((rgr-string-table (make-vector rgr-string-table-size 0)))
     ,@body))

(defun rgr-abbrev--intern-string (string initial-value)
  ;; Find the string in the database, returning a cons of (string . value),
  ;; adding it unless initial-value is the symbol :soft, in which case nil is
  ;; returned.  Otherwise, initial-value must be either 0 (a count) for a word
  ;; or nil (an empty alist) for an abbreviation.
  (let* ((found nil)
	 (prefix (downcase (substring string 0 3)))
	 (sym (intern-soft prefix rgr-string-table)))
    (or (let ((tail (and (boundp sym) (symbol-value sym))))
          (while (and tail (not found))
	    (when (equal string (car (car tail)))
	      (setq found (car tail)))
            (setq tail (cdr tail)))
          found)
	(unless (eq initial-value :soft)
	  (unless sym
	    (setq sym (intern prefix rgr-string-table))
	    ;; Initialize the new list bucket head.
	    (set sym nil))
          (car (push (cons string initial-value) (symbol-value sym)))))))

(defun rgr-abbrev--map-all-strings (function)
  ;; Apply the function to all (string . count) pairs.  We don't want to look at
  ;; abbrevs because that would give us duplicates.
  (mapatoms #'(lambda (sym)
		(dolist (entry (symbol-value sym))
		  (when (numberp (cdr entry))
		    (funcall function entry))))
	    rgr-string-table))

(defun rgr-abbrev--map-possibilities (function string &optional abbrevs-too-p)
  ;; Applies function to each entry that is a possible completion or
  ;; abbreviation expansion of string, with the second arg detailing which: t
  ;; for prefix or nil for abbrev.
  (when (< (length string) 3)
    ;; Fixed limitation of the hash/search algorithm.
    (error "Must have at least three characters."))
  (dolist (entry (symbol-value (intern-soft (downcase (substring string 0 3))
					    rgr-string-table)))
    (if (rgr-abbrev--prefix-equal string (car entry))
        (if (listp (cdr entry))
	    ;; Abbreviations
	    (when abbrevs-too-p
	      (dolist (abbrev (cdr entry))
		(funcall function abbrev nil)))
	  ;; Prefixes
	  (funcall function entry t)))))

(defun rgr-abbrev--undefine-entry (entry)
  ;; This does the datastructure part of undefining words, and does not touch
  ;; the buffer.
  (let* ((string (car entry))
         (length (length string))
         (hash (mod (rgr-fast-string-hash string) rgr-string-table-size))
	 (sym (intern-soft (downcase (substring string 0 3)) rgr-string-table))
         (abbreviation (rgr-abbrev-make-simple-abbreviation string)))
    (aset rgr-string-table hash
	  (delete entry (aref rgr-string-table hash)))
    (if (>= (length abbreviation) 3)
        (let ((abbrev-entry (rgr-abbrev-intern-string abbreviation nil)))
          (if (listp (cdr abbrev-entry))
              (rplacd abbrev-entry (delete entry (cdr abbrev-entry))))))))

(defun rgr-abbrev-hash-name (string)
  ;; "Learns" the name, interning it both as a string and as an abbreviation.
  (if (>= (length string) rgr-completion-min-entry-length)
      (let* ((entry (rgr-abbrev-intern-string string 0))
             (abbreviation (rgr-abbrev-make-simple-abbreviation string))
             (len (length abbreviation)))
        (if (>= len 3)
            (let ((abbrev-entry (rgr-abbrev-intern-string abbreviation nil)))
              (if (listp (cdr abbrev-entry))
                  (if (not (member entry (cdr abbrev-entry)))
                      (rplacd abbrev-entry (cons entry (cdr abbrev-entry)))))))
        entry)))

(defun rgr-hash-string-potential-symbols (string)
    ;; Update the string table.
    (when sym
      (setf (symbol-value sym) (delete entry (symbol-value sym))))
    (when (>= (length abbreviation) 3)
      (let ((abbrev-entry (rgr-abbrev--intern-string abbreviation nil)))
        (when (listp (cdr abbrev-entry))
          (setf (cdr abbrev-entry) (delete entry (cdr abbrev-entry))))))
    ;; Update the completion state.
    (when rgr-abbrev-completion-state
      (let ((state rgr-abbrev-completion-state))
	(when (eq (rgr-abbrev--last-entry state) entry)
	  (setf (rgr-abbrev--last-entry state) nil))
	(setf (rgr-abbrev--possibilities state)
	      (delete entry (rgr-abbrev--possibilities state)))))
    (setf (cdr entry) -1)
    entry))

(defun rgr-abbrev-db-stats ()
  "Report statistics for the completion database."
  (interactive)
  (let ((total 0) (occupied 0) (max-chain 0) (max-start nil))
    (mapatoms #'(lambda (sym)
		  (let ((chain (symbol-value sym)))
		    (when chain
		      (cl-incf occupied)
		      (let ((len (length chain)))
			(when (> len max-chain)
			  (setq max-chain len)
			  (setq max-start (car (car chain)))))
		      (dolist (entry chain)
			(when (integerp (cdr entry))
			  (cl-incf total))))))
	      rgr-string-table)
    (let ((starting
	   (if max-start
	       (format " starting with %S" (substring max-start 0 3))
	     "")))
      (message "%d words total, %d/%d slots occupied, max length %d%s"
	       total occupied (length rgr-string-table) max-chain starting))))

;;;; Learning completions and other higher-level access to the completion DB

(defun rgr-abbrev--better-match-p (entry1 entry2)
  ;; Return true if entry1 is a better completion than entry2.
  (if (= (cdr entry1) (cdr entry2))
      (> (length (car entry1)) (length (car entry2)))
      (> (cdr entry1) (cdr entry2))))

(defun rgr-abbrev--generate-possibilities (word)
  ;; Given a word which may be either a prefix or an abbreviation, generate all
  ;; possible things we know how to do with them, and return an rgr-abbrev-state
  ;; structure describing what we found.  The possibilities are sorted in the
  ;; possibilities slot, and if we can extend the word by any characters, the
  ;; extended string is in the replacement-string slot and the entry we used to
  ;; do this is in last-entry.  No buffer or global state is touched.
  (let ((possibilities nil) (best-match nil) (best-len nil))
    (cl-flet ((search-word (word)
		(let ((word-len (length word)))
		  (rgr-abbrev--map-possibilities
		   #'(lambda (entry prefix-p)
		       (let* ((string (car entry))
			      (entry-len (length string)))
			 ;; Keep track of possibilities.
			 (push entry possibilities)
			 ;; Additionally, find the best completion prefix.
			 (cond ((or (not prefix-p)
				    (= entry-len word-len))
				 ;; entry is an abbrev, or we're looking at the
				 ;; word itself.
				 )
			       ((null best-match)
				 (setq best-match entry best-len entry-len))
			       (t
				 (let* ((best (car best-match))
					(new-len (rgr-prefix-length
						   string best best-len)))
				   (setq best-len new-len)
				   (setq best-match entry))))))
		   word t))))
      (search-word word)
      (while (and (not possibilities)
		  (string-match "^\\([^-]+\\)-\\(.+\\)$" word))
	;; Try to find possibilities after dropping hyphen-prefixes.
	(setq word (match-string 2 word))
	(search-word word)))
    ;; Return an rgr-abbrev-state to report what we found.
    (let ((state (make-rgr-abbrev-state
		   :current-index 0
		   :possibilities (sort possibilities
					#'rgr-abbrev--better-match-p))))
      (when best-match
	(setf (rgr-abbrev--original-string state) word)
	(setf (rgr-abbrev--last-entry state) best-match)
	(setf (rgr-abbrev--replacement-string state)
	      (substring (car best-match) 0 best-len)))
      state)))

(defun rgr-abbrev--hash-name (string)
  ;; "Learns" the string and its abbreviation, as appropriate.
  (when (>= (length string) rgr-abbrev-min-entry-length)
    (let* ((entry (rgr-abbrev--intern-string string 0))
           (abbreviation (rgr-abbrev-make-simple-abbreviation string))
           (abbrev-len (length abbreviation)))
      (when (>= abbrev-len 3)
        (let ((abbrev-entry (rgr-abbrev--intern-string abbreviation nil)))
          (when (and (listp (cdr abbrev-entry))
		     (not (member entry (cdr abbrev-entry))))
            (push entry (cdr abbrev-entry)))))
      entry)))

(defun rgr-abbrev--hash-string-potential-names (string)
  ;; Define all names that appear in the string.  The string is expected to
  ;; constitute a complete line, so we can assume that initial and terminal
  ;; words are complete.
  ;; constitute at least one complete line, so we can assume that initial and
  ;; terminal words are whole.
  (let ((length (length string))
        (word-start nil))
    (let ((i 0))
      (while (< i length)
        (let ((char (aref string i)))
          (cond ((not (rgr-identifier-char-p char))
		  (and word-start
		       (rgr-abbrev-hash-name (substring string word-start i)))
		  (setq word-start nil))
                ((not word-start)
		  (setq word-start i))))
        (setq i (1+ i))))
    (if (and word-start
             (rgr-identifier-char-p (aref string (- length 1))))
	;; Look at the terminating word.
        (rgr-abbrev-hash-name (substring string word-start length)))))

(defun rgr-prefix-length (string1 string2 &optional max)
  ;; Return the length of the common prefix of string1 and string2, up to a
  ;; maximum of max, or 0 if they have no common prefix.
  (let* ((lens (min (length string1) (length string2)))
         (max (if max (min max lens) lens))
         (i 0))
    (while (and (< i max)
                (char-equal (aref string1 i) (aref string2 i)))
      (setq i (+ i 1)))
    i))

(defun rgr-prefix-exists-p (string entries)
  ;; Returns T iff string is a proper prefix of any of the entries.
  (let ((len (length string))
        (tail entries)
        (result nil))
    (while tail
      (let ((entry (car (car tail))))
        (if (and (= (rgr-prefix-length string entry) len)
		 (> (length entry) len))
	    (setq result t tail nil)
	    (setq tail (cdr tail)))))
    result))
    (cl-dotimes (i length)
      (let ((char (aref string i)))
        (cond ((not (rgr-identifier-char-p char))
		(when word-start
		  (rgr-abbrev--hash-name (substring string word-start i)))
		(setq word-start nil))
              ((not word-start)
		(setq word-start i)))))
    (when (and word-start
               (rgr-identifier-char-p (aref string (- length 1))))
      ;; Look at the terminating word.
      (rgr-abbrev--hash-name (substring string word-start length)))))

(defun rgr-abbrev--table-strings ()
  ;; Return a sorted list of defined strings.  We don't want to look at initials
  ;; because that would give us duplicates.
  (let ((strings nil))
    (rgr-abbrev--map-all-strings
      #'(lambda (entry) (push (car entry) strings)))
    (sort strings #'string<)))

;;; Learning by watching the user type.

(defun rgr-maybe-learn-new-symbol ()
  (let ((point (point)))
    (if (and (> (- point (point-min)) rgr-completion-min-entry-length)
    (if (and (> (- point (point-min)) rgr-abbrev-min-entry-length)
	     (not (rgr-identifier-char-p (char-after (1- point))))
	     (rgr-identifier-char-p (char-after (- point 2))))
	;; with-rgr-word (line start end) (- point 1)
        (let* ((word (buffer-substring-no-properties
		       (rgr-buffer-word-start (- point 1))
		       (rgr-abbrev--word-start (- point 1))
		       (- point 1)))
	       (len (length word)))
	  (if (and (>= len rgr-completion-min-entry-length)
	  (if (and (>= len rgr-abbrev-min-entry-length)
		   (not (let ((prefix-p nil))
			  (rgr-abbrev-map-possibilities
			    (function (lambda (entry ignore)
			      (if (not (= (length (car entry)) len))
				  (setq prefix-p entry))))
			  (rgr-abbrev--map-possibilities
			    #'(lambda (entry _ignore)
				(unless (= (length (car entry)) len)
				  (setq prefix-p entry)))
			    word)
			  prefix-p)))
	      (rgr-abbrev-hash-name word))))))
	      (rgr-abbrev--hash-name word))))))

;;; Learning definition names.



@@ 392,7 487,7 @@ variable."
			  (setq count (1+ count))
			  (forward-line))
			(point)))))
	  (rgr-hash-string-potential-symbols line))))
	  (rgr-abbrev--hash-string-potential-names line))))
    (or silent-p
	(message "Done -- %d definition lines." count))
    count))


@@ 402,7 497,7 @@ variable."
  "These modes get rgr-relearn-buffer-definition-names done automatically
when the file is found.")

(defun rgr-abbrev-find-file-hook ()
(defun rgr-abbrev--find-file-hook ()
  ;; Conditionally call rgr-relearn-buffer-definition-names.
  (if (and (memq major-mode rgr-abbrev-major-modes-that-have-definitions)
	   ;; [don't uselessly trash "(New file)" message.  -- rgr, 2-Mar-98]


@@ 417,17 512,12 @@ when the file is found.")

;;;; Machinery for inserting and deleting completions.

(defun rgr-abbrev-insert-word-tail
(defun rgr-abbrev--insert-word-tail
       (original-string word-entry &optional length)
  (let* ((new-word (car word-entry))
	 (new-string (if length (substring new-word 0 length) new-word))
         (length (or length (length new-word)))
	 (word-start (- (point) (length original-string))))
    ;; [old state.  these are obsolete.  -- rgr, 3-Feb-98.]
    ;; (setq *rgr-completion-original-string* original-string)
    ;; (setq *rgr-completion-insertion-entry* word-entry)
    ;; (setq *rgr-completion-insertion-length* length)
    ;; (setq rgr-completion-other-abbrevs nil)
    ;; no case-replace in gnu emacs?  -- rgr, 1-Aug-95.  [probably don't want it
    ;; anyway.  -- rgr, 29-Nov-96.]  [there is a case-replace, but it's a
    ;; variable that affects what's passed to replace-match.  but in any (ah)


@@ 435,105 525,71 @@ when the file is found.")
    ;; the first place.  -- rgr, 1-Feb-98.]
    (delete-region word-start (point))
    (insert new-string)
    ;; [new state.  -- rgr, 1-Feb-98.]
    (or rgr-abbrev-completion-state
	(setq rgr-abbrev-completion-state (cons nil nil)))
    (rplaca rgr-abbrev-completion-state
	    (list word-start (point) original-string new-string word-entry))
    ;; update use count.
    (if (= length (length new-word))
        (setcdr word-entry (+ (cdr word-entry) 1)))
    t))

(defun rgr-abbrev-completion-state (&optional word-start)
  ;; Use the variable with the same name to decide whether we are continuing or
  ;; not, and if so, how.  point is assumed to be at the word end.  [word-start
  ;; may soon go away.  -- rgr, 10-Feb-98.]
  (let* ((state (car rgr-abbrev-completion-state))
	 (insertion-start (car state))
	 (insertion-end (car (cdr state)))
	 (replacement-string (rgr-abbrev-completion-state-replacement-string)))
    '(message "point %s insertion-start %s insertion-end %s word-start %s"
	     (point) insertion-start insertion-end word-start)
    '(sit-for 1)
    (cond ((null state) nil)
	  ((and word-start
		(or (not (eq insertion-start word-start))
		    (< (point) insertion-end)
		    (not (equal (buffer-substring-no-properties insertion-start
								insertion-end)
				replacement-string))))
	    ;; [usually not done -- loses if the syntax rules change.  -- rgr,
	    ;; 10-Feb-98.]
	    ;; no completion, completing in a different place, or the initial
	    ;; portion has changed.
	    nil)
	  ((and (not word-start)
		;; The rules are slightly different here.  (point) must be at
		;; insertion-end, and we can't check the start.
		(or (not (= (point) insertion-end))
		    (not (equal (buffer-substring-no-properties insertion-start
								insertion-end)
				replacement-string))))
	    ;; [usually not done -- loses if the syntax rules change.  -- rgr,
	    ;; 10-Feb-98.]
	    ;; no completion, completing in a different place, or the initial
	    ;; portion has changed.
	    nil)
	  ((= (point) insertion-end)
	    ;; repeated invocation at the same point.
	    ':repeat)
	  (t
	    ;; must have supplied a few more characters.
	    ':continue))))

(defun rgr-abbrev-undo-last-insertion-internal (&optional query-p)
  ;; If we're still in the place of the last insertion, undo it & return the
  ;; word entry.  [We used to do this even if the user had typed a few more
  ;; characters.  Probably wasn't a good idea.  -- rgr, 10-Feb-98.]
  (if (rgr-abbrev-completion-state)
      (let* ((state (car rgr-abbrev-completion-state))
	     (word-start (car state))
	     (original-string (nth 2 state))
             (word-entry (nth 4 state))
             (word-length (- (nth 1 state) word-start))) 
	(if (eq query-p t)
	    (setq query-p "Undo"))
	(cond ((or (not query-p)
		   (y-or-n-p (format "%s \"%s\"?" query-p (car word-entry))))
		(delete-region word-start (point))
		(insert original-string)
		(if (= word-length (length (car word-entry)))
		    (setcdr word-entry (- (cdr word-entry) 1)))
		word-entry)))))
    (unless rgr-abbrev-completion-state
      (setq rgr-abbrev-completion-state (make-rgr-abbrev-state)))
    (let ((state rgr-abbrev-completion-state))
      (setf (rgr-abbrev--insertion-start state) word-start)
      (setf (rgr-abbrev--insertion-end state) (point))
      (setf (rgr-abbrev--original-string state) original-string)
      (setf (rgr-abbrev--replacement-string state) new-string)
      (setf (rgr-abbrev--last-entry state) nil))
    ;; Update use count.
    (when (= length (length new-word))
      (setf (rgr-abbrev--last-entry rgr-abbrev-completion-state) word-entry)
      (cl-incf (cdr word-entry)))))

(defun rgr-abbrev--continuing-p ()
  ;; Use rgr-abbrev-completion-state to decide whether we are continuing a
  ;; completion in the same place, and return true if so.  More precisely,
  ;; return true if point is at the end of the last completion, whether partial
  ;; or complete.  (The user may have moved point away and then back again, and
  ;; that's perfectly fine.)
  (when rgr-abbrev-completion-state
    (let* ((state rgr-abbrev-completion-state)
	   (insertion-start (rgr-abbrev--insertion-start state))
	   (insertion-end (rgr-abbrev--insertion-end state)))
      (and insertion-start insertion-end
	   (= (point) insertion-end)
	   (equal (buffer-substring-no-properties insertion-start
						  insertion-end)
		  (rgr-abbrev--replacement-string state))))))

;;; Getting rid of unwanted possibilities.
;;; This is a problem with "watching-the-user-type" learning.

(defun rgr-kill-last-symbol-abbreviation ()
  "Undefine the last abbreviation inserted.
Also undoes the effect if it was done by the immediately preceding command."
(defun rgr-abbrev-kill ()
  "Undefine the last abbreviation, or a current possibility."
  (interactive)
  (let ((chosen-entry (rgr-abbrev-undo-last-insertion-internal "Remove")))
    (or chosen-entry
	;; with-rgr-word (line start end) (point)
	(let ((word (buffer-substring-no-properties
		      (rgr-buffer-word-start (point))
		      (point)))
	      (nothing-found t))
	  (rgr-abbrev-map-possibilities
	   (function (lambda (entry ignore)
	     (setq nothing-found nil)
	     (if (not chosen-entry)
		 (if (y-or-n-p (format "Remove \"%s\"? " (car entry)))
		     (setq chosen-entry entry)))))
	   word t)
	  (if nothing-found
	      (error "No completions for \"%s\"." word))))
    (cond (chosen-entry
	    (message "Undefined \"%s\"." (car chosen-entry))
	    (rplacd chosen-entry -1)
	    (rgr-undefine-entry chosen-entry)))))
  (let* ((chosen-entry nil)
	 (state (and (rgr-abbrev--continuing-p)
		     rgr-abbrev-completion-state))
         (word-entry (and state (rgr-abbrev--last-entry state))))
    ;; Maybe kill the last completion, if any.
    (when (and word-entry
	       (or rgr-abbrev-complete-silently
		   (y-or-n-p (format "Remove %S?" (car word-entry)))))
      (setq chosen-entry word-entry))
    ;; Maybe kill a completion that starts before point.
    (unless chosen-entry
      ;; This will get an error if we don't have any completions.
      (cl-dolist (entry (rgr-abbrev--possibilities
			  (rgr-abbrev--generate-possibilities
			    (rgr-abbrev--word-before))))
	(when (and (not chosen-entry)
		   (or rgr-abbrev-complete-silently
		       (y-or-n-p (format "Remove %S? " (car entry)))))
	  (setq chosen-entry entry))))
    (unless chosen-entry
      (error "Nothing chosen."))
    ;; If killing the last insertion, just undo it.  This may undercount
    ;; completions for the word that is showing.  What we really want is to
    ;; revert the completion state as well, but that would be messier.
    (when (eq chosen-entry word-entry)
      (let ((last-command 'rgr-abbrev-kill))
	(undo)))
    (rgr-abbrev--undefine-entry chosen-entry)
    (unless rgr-abbrev-complete-silently
      (message "Undefined \"%s\"." (car chosen-entry)))))

(defun rgr-abbrev-show-possibilities (possibilities)
  ;; [this would be better replaced by an ispell-style menu.  -- rgr, 1-Feb-98.]


@@ 541,7 597,7 @@ Also undoes the effect if it was done by the immediately preceding command."
	((null (cdr possibilities))
	  (message "The only possibility is %s." (car possibilities)))
	(t
	  (let* ((size 78)
	  (let* ((size (- (window-text-width) 2))
		 (room (- size
			  (length ", and ~D others")
			  (length (car (nth 0 possibilities)))


@@ 562,15 618,11 @@ Also undoes the effect if it was done by the immediately preceding command."
		(princ (format ", and %d others" (length possibilities))))
	    (princ ".")))))

(defun rgr-better-match-p (entry1 entry2)
  (if (= (cdr entry1) (cdr entry2))
      (> (length (car entry1)) (length (car entry2)))
      (> (cdr entry1) (cdr entry2))))

;;;; Commands for inserting completions.

;; [revised design.  -- rgr, 1-Feb-98.]

(defun rgr-abbrev-more-message (n total)
(defun rgr-abbrev--more-message (n total)
  ;; print a message describing the position of this possibility in the set.  n
  ;; is the 0-based index of the possibility we are inserting now; total is the
  ;; count of all possibilities.


@@ 582,197 634,137 @@ Also undoes the effect if it was done by the immediately preceding command."
	    )
	  ((= n 0)
	    ;; first of multiple hits; explain fully.
	    (message "%d more possibilit%s; %s to cycle through them."
		     more
		     (if (= more 1) "y exists" "ies exist")
		     redo))
	    (unless rgr-abbrev-complete-silently
	      (message "%d more possibilit%s; %s to cycle through them."
		       more (if (= more 1) "y exists" "ies exist")
		       redo)))
	  ((> more 0)
	    ;; neither first nor last of more than one (and therefore must be at
	    ;; least three).  just give the numbers.
	    (message "%d more possibilit%s."
		     more
		     (if (= more 1) "y" "ies")))
	    (unless rgr-abbrev-complete-silently
	      (message "%d more possibilit%s."
		       more (if (= more 1) "y" "ies"))))
	  (t
	    ;; last of multiple; remind the user how to get them again.
	    (message "Last of %d possibilities; %s to restart."
		     total redo)))))

(defun rgr-abbrev-insert-next-possibility (word n)
  (let ((possibilities (cdr rgr-abbrev-completion-state))
	(last-entry (nth 4 (car rgr-abbrev-completion-state))))
    (cond ((null (cdr possibilities))
	    (error "No completions for '%s'." word))
          (t
	    (if last-entry
		(setcdr last-entry (- (cdr last-entry) 1)))
	    (rgr-abbrev-more-message n (length (cdr possibilities)))
	    (rgr-abbrev-insert-word-tail word (nth n (cdr possibilities)))
	    (setcar possibilities n)))))

(defun rgr-abbrev-expand-initial-guess (word-start word
					&optional no-abbrev-p no-expand-p)
  ;; no-expand-p means just compute the possibilities.
  (let ((len (length word))
	(possibilities nil) (best-match nil) (best-len nil))
    (rgr-abbrev-map-possibilities
      (function (lambda (entry prefix-p)
	(let* ((string (car entry))
	       (entry-len (length string)))
	  ;; Keep track of possibilities.
	  (or no-abbrev-p
	      (setq possibilities (cons entry possibilities)))
	  ;; Additionally, find the best prefix.
	  (cond ((or (not prefix-p)
		     (= entry-len len)))
		((null best-match)
		  (setq best-match entry best-len entry-len))
		(t
		  (let* ((best (car best-match))
			 (new-len (rgr-prefix-length string best best-len)))
		    (setq best-len new-len)
		    (setq best-match entry)))))))
      word t)
    (setq possibilities (sort possibilities (function rgr-better-match-p)))
    (setq rgr-abbrev-completion-state
	  (cons nil (cons 0 possibilities)))
    (cond (no-expand-p nil)
	  ((null best-match)
	    (rgr-abbrev-insert-next-possibility word 0))
          ((> best-len len)
	    (rgr-abbrev-insert-word-tail word best-match best-len))
	    (unless rgr-abbrev-complete-silently
	      (message "Last of %d possibilities; %s to restart."
		       total redo))))))

(defun rgr-abbrev--insert-next-possibility (word n)
  (let* ((state (or rgr-abbrev-completion-state
		    (error "bug:  no state")))
	 (possibilities (rgr-abbrev--possibilities state))
	 (last-entry (rgr-abbrev--last-entry state)))
    (unless possibilities
      (error "No completions for '%s'." word))
    (when last-entry
      (cl-decf (cdr last-entry)))
    (rgr-abbrev--more-message n (length possibilities))
    (rgr-abbrev--insert-word-tail word (nth n possibilities))
    (setf (rgr-abbrev--current-index state) n)))

(defun rgr-abbrev--expand-initial-guess (word)
  ;; Given the word (which must be of the minimum acceptable length), try to do
  ;; something with it.
  (let* ((state (rgr-abbrev--generate-possibilities word))
	 (possibilities (rgr-abbrev--possibilities state))
	 (original (rgr-abbrev--original-string state))
	 (replacement (rgr-abbrev--replacement-string state)))
    (setq rgr-abbrev-completion-state state)
    (cond ((null replacement)
	    ;; Can't extend the word, so try cycling.
	    (rgr-abbrev--insert-next-possibility word 0))
          ((> (length replacement) (length original))
	    ;; Extend a completion.
	    (rgr-abbrev--insert-word-tail
	      original
	      (rgr-abbrev--last-entry state)
	      (length replacement)))
          (t
	    ;; Can't extend the word, so try cycling.
	    (rgr-abbrev--insert-next-possibility word 0)
	    (rgr-abbrev-show-possibilities possibilities)))))

(defun rgr-complete-word-start (&optional no-abbrev-p no-expand-p)
  ;; Start a new completion.
  (let* ((word-start (rgr-buffer-word-start (point)))
	 (word (buffer-substring-no-properties word-start (point))))
    (if (< (length word) 3)
	;; Fixed limitation of the hash/search algorithm.
	(error "Must have at least three characters."))
    (rgr-abbrev-expand-initial-guess word-start word
				     no-abbrev-p no-expand-p)))

;;;###autoload
(defun rgr-insert-symbol-abbreviation ()
  ;; New UI rgr-insert-symbol-abbreviation pass.  -- rgr, 1-Feb-98.
  "Expand the quasi-abbrev before point."
  (interactive)
  (let ((state (rgr-abbrev-completion-state)))
    (if (not state)
	;; Starting a new completion.
	(rgr-complete-word-start)
	;; Continuing a previous completion attempt.
	(let* ((replacement-string
		 (rgr-abbrev-completion-state-replacement-string))
	       (n-poss (length (cdr (cdr rgr-abbrev-completion-state))))
	       (next-possibility
		 (mod (1+ (car (cdr rgr-abbrev-completion-state))) n-poss)))
	  (cond ((eq state ':continue)
		  ;; adding characters works only if we're doing prefix
		  ;; completion.
		  (rgr-abbrev-expand-initial-guess
		    (rgr-abbrev-completion-state-insertion-start)
		    replacement-string t))
		;; so (eq state ':repeat) must be true.
		((= n-poss 1)
		  (message "Sole completion."))
		(t
		  (rgr-abbrev-insert-next-possibility replacement-string
						      next-possibility)))))
    ;; [debugging.  -- rgr, 1-Feb-98.]
    '(message "Old state is %s, new state is %s"
	     state (rgr-abbrev-completion-state))
    '(sit-for 1)))
  (if (not (rgr-abbrev--continuing-p))
      ;; Starting a new completion.
      (rgr-abbrev--expand-initial-guess (rgr-abbrev--word-before))
      ;; Continuing a previous completion attempt.
      (let* ((state rgr-abbrev-completion-state)
	     (replacement-string (rgr-abbrev--replacement-string state))
	     (n-poss (length (rgr-abbrev--possibilities state)))
	     (next-possibility
	       (mod (1+ (rgr-abbrev--current-index state)) n-poss)))
	(cond ((= n-poss 1)
		(message "Sole completion."))
	      (t
		(rgr-abbrev--insert-next-possibility replacement-string
						    next-possibility))))))

(defun rgr-list-abbreviations ()
  "Lists possibilities for the quasi-abbrev before point."
  (interactive)
  (or (rgr-abbrev-completion-state)
      (rgr-complete-word-start nil t))
  (let* ((tail (cdr (cdr rgr-abbrev-completion-state)))
	 (ptr (car (cdr rgr-abbrev-completion-state)))
	 (i 0)
	 (n-poss (length tail)))
;;;; Other completion utilities.

(defun rgr-abbrev--list-abbrevs-internal (possibilities ptr)
  (let ((n-poss (length possibilities))
	(i 0))
    (with-output-to-temp-buffer "*Completion Possibilities*"
      (princ (if (= n-poss 1)
		 "There is exactly one possibility:\n\n"
		 (format "There are %d possibilities:\n\n" n-poss)))
      (while tail
	(princ (if (= i ptr) " * " "   "))
	(princ (car (car tail)))
	(princ "\n")
	(setq tail (cdr tail))
	(setq i (1+ i)))
      (princ "\nCurrent (or next) is marked with a \"*\".\n"))))

;;;; Other completion utilities.
      (dolist (pair possibilities)
	(let ((word (car pair)))
	  (princ (if (= i ptr) " * " "   "))
	  (princ word)
	  (princ "\n")
	  (cl-incf i)))
      (when (>= ptr 0)
	(princ "\nCurrent (or next) is marked with a \"*\".\n")))))

(defun rgr-clean-symbol-prefixes (verbose-p)
  "Removes all unused 'symbols' that are prefixes of others."
(defun rgr-list-abbreviations ()
  "Lists possibilities for the quasi-abbrev before point."
  (interactive)
  (if (rgr-abbrev--continuing-p)
      (let ((state rgr-abbrev-completion-state))
	(rgr-abbrev--list-abbrevs-internal (rgr-abbrev--possibilities state)
					   (rgr-abbrev--current-index state)))
    ;; This will fail if there are no completions.
    (rgr-abbrev--list-abbrevs-internal
      (rgr-abbrev--possibilities
        (rgr-abbrev--generate-possibilities (rgr-abbrev--word-before)))
      -1)))

(defun rgr-abbrev-clean-prefixes (&optional verbose-p)
  "Removes all unused words that are prefixes of others.
With a numeric argument, identifies the words that are removed."
  (interactive "P")
  (let ((count 0))
    (let ((i 0))
      (while (< i rgr-string-table-size)
	(let ((entries (aref rgr-string-table i)))
	  (let ((<tail> entries)
		(pair nil))
	    (while <tail>
	      (setq pair (car <tail>))
	      (let ((string (car pair)))
		(cond ((eq (rgr-string-case string) ':upper)
			(message "Found uppercase entry %s; fixing." pair)
			(let ((<limit> (length string))
			      (i 0))
			  (while (< i <limit>)
			    (aset string i (downcase (aref string i)))
			    (setq i (1+ i))))))
		(if (numberp (cdr pair))
		    (cond ((or (< (length string)
				  rgr-completion-min-entry-length)
			       (let ((<length> (length string))
				     (<index> 0)
				     (<found> nil))
				 (while (and (< <index> <length>)
					     (not <found>))
				   (if (= 32 (elt string <index>))
				       (setq <found> <index>))
				   (setq <index> (1+ <index>)))
				 <found>)
			       (and (= (cdr pair) 0)
				    (rgr-prefix-exists-p string entries)))
			    (if verbose-p
				(message "Flushing %s." pair))
			    (setq count (+ count 1))
			    (rplacd pair -1)
			    (setq entries (delq pair entries))))))
	      (setq <tail> (cdr <tail>))))
	  (aset rgr-string-table i entries))
	nil
	(setq i (1+ i))))
    (let ((i 0))
      (while (< i rgr-string-table-size)
	(let ((<tail> (aref rgr-string-table i))
	      (pair nil))
	  (while <tail>
	    (setq pair (car <tail>))
	    (cond ((listp (cdr pair))
		    (let ((<tail> (cdr pair))
			  (word nil))
		      (while <tail>
			(setq word (car <tail>))
			(if (= (cdr word) -1)
			    (rplacd pair (delq word (cdr pair))))
			(setq <tail> (cdr <tail>))))
		    (cond ((null (cdr pair))
                            (if verbose-p
				(message "Flushing %s." pair))
                            (aset rgr-string-table i
				  (delq pair (aref rgr-string-table i)))))))
	    (setq <tail> (cdr <tail>))))
	(setq i (1+ i))))
    (message "Removed %d unused prefix%s."
	     count (if (= count 1) "" "es"))))
  (let ((count 0)
	(words (rgr-abbrev--table-strings)))
    ;; The list of words is sorted, so a prefix will appear immediately before
    ;; its containing word.  If the containing word is itself a prefix, that
    ;; won't matter; it will get taken care of on the next iteration, and the
    ;; shorter prefix still needs to go.
    (while (cdr words)
      (let ((this-string (car words))
	    (next-string (car (cdr words))))
	(cond ((rgr-abbrev--prefix-p this-string next-string)
		;; Get rid of this-string.
		(let ((entry (rgr-abbrev--intern-string this-string nil)))
		  (when verbose-p
		    (message "Flushing %s." this-string))
		  (cl-incf count)
		  (rgr-abbrev--undefine-entry entry)))
	      ((eq (rgr-string-case this-string) ':upper)
		(unless rgr-abbrev-complete-silently
		  (message "Found uppercase entry %s; fixing." this-string))
		(let ((entry (rgr-abbrev--intern-string this-string nil)))
		  (setf (car entry) (downcase (car entry))))))
	(setq words (cdr words))))
    (unless rgr-abbrev-complete-silently
      (message "Removed %d unused prefix%s."
	       count (if (= count 1) "" "es")))))

;;;; Completion I/O



@@ 783,45 775,16 @@ the original state if the file isn't already in a buffer."
	(filename (car (cdr buffer-and-filename))))
    `(let ((,buffer (get-file-buffer ,filename))
	   (<delete-p> nil))
       ;; I'm hoping at least some of this is correct.
       (unwind-protect
	    (save-excursion
	      (cond ((not ,buffer)
		     (setq ,buffer (find-file-noselect ,filename))
		     (setq <delete-p> t)))
	      (set-buffer ,buffer)
	      ,@body)
	      (with-current-buffer ,buffer
		,@body))
	 (and ,buffer <delete-p>
	      (kill-buffer ,buffer))))))

(defun rgr-write-completions-internal (stream threshold atrophy-percent)
  ;; just outputs the current completion state to the stream.
  (princ (format ";; Completions written %s\n\n" (current-time-string)) stream)
  (let ((total 0) (written 0)
	(i 0))
    (while (< i rgr-string-table-size)
      (let* ((entries (aref rgr-string-table i))
	     (<tail> entries)
	     (entry nil))
	(while <tail>
	  (setq entry (car <tail>))
	  (if (numberp (cdr entry))
	      (let ((string (car entry))
		    (uses (cdr entry)))
		(setq total (+ total 1))
		;; (message "%S" entry)  (sit-for 1)
		(cond ((>= uses threshold)
			(setq written (+ written 1))
			(princ (format "(%S . %S)\n"
				       string
				       (/ (* uses atrophy-percent) 100))
			       stream)))))
	  (setq <tail> (cdr <tail>))))
      (setq i (1+ i)))
    (princ (format "\n;; %d out of %d completions written.\n"
		   written total)
           stream)))

(defun rgr-abbrev-completion-file-newer-than-one-day-p (filename)
  ;; Return non-nil if the file is less than a day old.
  (let ((file-time (nth 5 (file-attributes filename))))


@@ 838,134 801,142 @@ the original state if the file isn't already in a buffer."
		     (+ (* delta-high 65536) delta-low)))))
	  (< delta-secs (* 24 60 60))))))

(defun rgr-abbrev--compute-merged-entries (_buffer entries)
  ;; Given that buffer is a save file, merge its entries with the passed list of
  ;; entries (by taking the max of any common entries), and return a new
  ;; combined list.  We do this by creating a new scope and using the usual read
  ;; in & scan out mechanisms.
  (with-rgr-abbrev-storage ()
    ;; Add the passed entries.
    (dolist (passed-entry entries)
      (rgr-abbrev--intern-string (car passed-entry) (cdr passed-entry)))
    ;; Add the buffer entries.
    (rgr-abbrev--read-completion-buffer)
    ;; Get the merged entries back out.  Since they've already gone through the
    ;; threshold/atrophy process, we don't need that here.
    (let ((new-entries nil))
      (rgr-abbrev--map-all-strings #'(lambda (e) (push e new-entries)))
      new-entries)))

(defun rgr-abbrev--default-save-file ()
  ;; To save indendation space.
  (or (and (stringp rgr-abbrev-completion-save-file)
	   rgr-abbrev-completion-save-file)
      (let ((default-directory
	      (if (and rgr-abbrev-completion-save-directory
		       (file-directory-p rgr-abbrev-completion-save-directory))
		  rgr-abbrev-completion-save-directory
		default-directory)))
	(expand-file-name "completions.text"))))

(defun rgr-write-completion-file (filename &optional threshold atrophy-percent)
  ;; apply threshold first, atrophy-percent afterwards, and write whatever is
  ;; left over to the file.
  (interactive
    (list (let ((default (or rgr-abbrev-completion-save-file
			      (buffer-file-name)
			      (expand-file-name "completions.text"))))
	    (read-file-name (format "Save into (default %s)? "
				    (abbreviate-file-name default))
			    (file-name-directory default)
			    default))))
    (list (let ((default (rgr-abbrev--default-save-file)))
	    (read-file-name "Save into? " (file-name-directory default)
			    default nil (file-name-nondirectory default)))))
  ;; default the file name.
  (cond ((memq filename '(nil t))
	  (setq filename (rgr-abbrev--default-save-file)))
	((functionp filename)
	  (setq filename (funcall filename))))
  (let ((dir (file-name-directory filename)))
    (when (or (null dir)
	      (not (and (file-directory-p dir)
			(file-writable-p dir))))
      ;; Assume this is a relative pathname that should be interpreted with
      ;; respect to the save directory.
      (setq filename
	    (expand-file-name filename rgr-abbrev-completion-save-directory))))
  ;; default the numeric args.
  (or threshold
      (setq threshold 1))
  (or atrophy-percent
      (setq atrophy-percent 80))
  (with-rgr-temp-file-buffer (buffer filename)
    (cond ((if (memq rgr-abbrev-completion-append-to-file-p '(nil t))
	       rgr-abbrev-completion-append-to-file-p
  (unless threshold
    (setq threshold 1))
  (unless atrophy-percent
    (setq atrophy-percent 80))
  (let ((entries nil) (total 0))
    ;; Collect entries to save.
    (rgr-abbrev--map-all-strings
      #'(lambda (entry)
	  (let ((string (car entry))
		(uses (cdr entry)))
	    (cl-incf total)
	    (when (>= uses threshold)
	      (push (cons string (/ (* uses atrophy-percent) 100)) entries)))))
    (with-rgr-temp-file-buffer (buffer filename)
      (cond ((= (point-max) (point-min)))
	    ((buffer-modified-p)
	      ;; If flushing old completions, don't screw the user if the buffer
	      ;; has been edited.  -- rgr, 12-Dec-96.
	      (error "Buffer %s has been edited; %s."
		     (buffer-name) "can't save completions into it"))
	    ((if (memq rgr-abbrev-completion-append-to-file-p '(nil t))
		 rgr-abbrev-completion-append-to-file-p
	       (funcall rgr-abbrev-completion-append-to-file-p filename))
	    ;; Appending; go ahead and save edited changes.
	    (goto-char (point-max)))
	  (t
	    ;; Flushing old completions, so don't screw the user if the buffer
	    ;; has been edited.  -- rgr, 12-Dec-96.
	    (if (buffer-modified-p)
		(error "Buffer %s has been edited; %s."
		       (buffer-name) "can't save completions into it"))
	    (erase-buffer)))
    (rgr-write-completions-internal buffer threshold atrophy-percent)
    (let ((delete-old-versions t))
      (save-buffer))
    (run-hooks 'rgr-abbrev-after-save-hook)))

(defun rgr-completion-do-auto-save ()
  ;; Run indirectly via the rgr-completion-start-auto-save feature.
  (and rgr-abbrev-completion-save-file
       (rgr-write-completion-file rgr-abbrev-completion-save-file)))

(defun rgr-completion-stop-auto-save (&optional no-message-p)
  (cond ((null rgr-completion-auto-save-timer)
	  (or no-message-p
	      (message "Completion auto-save is not enabled."))
	  nil)
	(t
	  (cancel-timer rgr-completion-auto-save-timer)
	  (setq rgr-completion-auto-save-timer nil)
	  (or no-message-p
	      (message "Completion auto-save is now disabled."))
	  t)))

(defun rgr-completion-start-auto-save ()
  "Start auto-save for the abbrev-completion feature.
Filtered completions will be saved normally to the file named by
rgr-abbrev-completion-save-file at a random time between 01:00 and
02:00."
  (interactive)
  (require 'timer)
  (if rgr-completion-auto-save-timer
      (rgr-completion-stop-auto-save t))
  (or rgr-abbrev-completion-save-file
      (error "No save file in %S; set this first."
	     'rgr-abbrev-completion-save-file))
  ;; [this may be broken.  -- rgr, 25-Apr-22.]
  (let* ((desired-hour 1)
	 (now (current-time))
	 (tomorrow (decode-time (timer-relative-time now (* 24 60 60))))
	 (this-hour (nth 2 tomorrow))
	 (time (append (list (random 60) (random 60) desired-hour)
		       (nthcdr 3 (if (< this-hour desired-hour)
				     ;; do it later today.
				     (decode-time now)
				     tomorrow))))
	 (timer (timer-create)))
    (timer-set-time timer (apply 'encode-time time))
    (timer-set-function timer 'rgr-completion-do-auto-save)
    (timer-activate timer)
    (setq rgr-completion-auto-save-timer timer)
    (message "Auto-save set for 0%d:%2d."
	     (car (cdr (cdr time))) (car (cdr time)))
    timer))

(defun rgr-read-completion-file-internal (stream)
  ;; Read and merge with the existing database.  If an entry exists and the
  ;; lengths differ, we set it to the max of the two.
	      (setq entries
		    (rgr-abbrev--compute-merged-entries buffer entries))
	      (goto-char (point-min))
	      (while (and (not (eobp))
			  (looking-at "^;"))
		(forward-line))
	      (delete-region (point) (point-max)))
	    (t
	      (erase-buffer)))
      ;; Write the combined entries.
      (princ (format ";; Completions written %s\n\n" (current-time-string))
	     buffer)
      (let ((written 0))
	(dolist (entry entries)
	  (cl-incf written)
	  (prin1 entry buffer)
	  (princ "\n" buffer))
	(princ (format "\n;; %d out of %d completions written.\n"
		       written total)
	       buffer))
      ;; Save the buffer.
      (let ((delete-old-versions t))
	(save-buffer))))
  (run-hooks 'rgr-abbrev-after-save-hook))

(defun rgr-abbrev--read-completion-buffer ()
  ;; Read the saved completion entries in the current buffer.
  (goto-char (point-min))
  (let ((file-entry nil))
    (while (setq file-entry 
		 (condition-case error
		     (read (current-buffer))
		   (end-of-file nil)))
      (let ((count (cdr file-entry))
	    (entry (rgr-abbrev-hash-name (car file-entry))))
        (if (and entry (< (cdr entry) count))
	    (rplacd entry count))))))
    (condition-case _error
	(while (setq file-entry (read (current-buffer)))
	  (when (consp file-entry)
	    (let ((word (car file-entry))
		  (count (cdr file-entry)))
	      (when (and (stringp word)
			 (integerp count))
		;; Well-formed entry.
		(let ((entry (rgr-abbrev--hash-name word)))
		  (when (< (cdr entry) count)
		    (setf (cdr entry) count)))))))
      (end-of-file nil))))

;;;###autoload
(defun rgr-read-completion-file (filename)
  "Read and merge the saved completions in filename
If an entry exists and the counts differ, we take the maximum."
  (with-rgr-temp-file-buffer (buffer filename)
    (goto-char (point-min))
    (rgr-read-completion-file-internal buffer)))
    (rgr-abbrev--read-completion-buffer)))

(defun rgr-save-completion-hack ()
  ;; Run at C-x C-c time.  Should really have a nicer notion of what the right
  ;; file is, whether it has been modified, etc.  -- rgr, 29-Nov-96.
  ;; Run at C-x C-c time.
  (and rgr-abbrev-completion-save-file
       (rgr-write-completion-file rgr-abbrev-completion-save-file))
  t)

;;;###autoload
(defun rgr-abbrev-generate-weekly-save-file ()
  "Helper function for rgr-install-weekly-completion-cycle -- generates a file
name with the day of the week in it."
  (setq rgr-abbrev-completion-save-file
	(expand-file-name (concat "completions-"
				  (substring (current-time-string) 0 3)
				  ".text")
			  rgr-abbrev-completion-save-directory)))

;;;###autoload
(defun rgr-install-weekly-completion-cycle ()
  (let ((files (directory-files rgr-abbrev-completion-save-directory
				t "^completions.*\\.text$")))
    (while files
      (rgr-read-completion-file (car files))
      (setq files (cdr files)))
    (rgr-abbrev-generate-weekly-save-file)
    (add-hook 'rgr-abbrev-after-save-hook
	      'rgr-abbrev-generate-weekly-save-file)))
  (mapc #'rgr-read-completion-file
	(directory-files rgr-abbrev-completion-save-directory
			 t "^completions.*\\.text$"))
  (setq rgr-abbrev-completion-save-file
	#'(lambda ()
	    (let ((weekday (substring (current-time-string) 0 3)))
	      (concat "completions-" weekday ".text")))))

;;;###autoload
(defun rgr-install-abbrev-completion ()


@@ 973,15 944,8 @@ name with the day of the week in it."
This is meant for calling from a .emacs file, but is also a command so
it can be re-initialized if any of the hooks get stepped on."
  (interactive)
  (add-hook 'find-file-hook 'rgr-abbrev-find-file-hook)
  (add-hook 'find-file-hook 'rgr-abbrev--find-file-hook)
  (add-hook 'kill-emacs-query-functions 'rgr-save-completion-hack)
  (add-hook 'post-command-hook 'rgr-maybe-learn-new-symbol))

(provide 'rgr-abbrev-completion)

;;; Debugging

; escape value (though emacs makes it go away if it gets an error).
;(setq post-command-hook nil)
;(rgr-read-completion-file "~rogers/emacs/completions.text")
;(rgr-write-completion-file "~rogers/emacs/completions.text")

M test/test-rgr-abbrev-completion.el => test/test-rgr-abbrev-completion.el +181 -16
@@ 9,24 9,107 @@
(require 'rgr-abbrev-completion)

(defmacro with-rgr-abbrev-testing (options &rest testing-code)
  `(let ((rgr-string-table (make-vector rgr-string-table-size nil)))
     (with-temp-buffer
       ,@testing-code)))
  ;; Introduces a new word definition scope for testing purposes.
  `(with-rgr-abbrev-storage ()
     (let ((rgr-abbrev-complete-silently t))
       (with-temp-buffer
	 ;; (with-current-buffer (get-buffer-create "*abbrev-test*")
	 (buffer-enable-undo)
	 ,@testing-code))))

(ert-deftest rgr-abbrev-test-simple ()
  (should (equal (rgr-abbrev-make-simple-abbreviation "this-is-a-test") "tiat"))
  (should (equal (rgr-abbrev-make-simple-abbreviation "this is a test") "tiat"))
  (should (equal (rgr-abbrev-make-simple-abbreviation
		   "reallyStupidNamingConvention")
		 "rsnc")))
(ert-deftest rgr-abbrev-test-0 ()
  ;; Simple tests for underlying mechanisms.
  (with-rgr-abbrev-testing ()
    (should (equal (rgr-abbrev-make-simple-abbreviation "this-is-a-test")
		   "tiat"))
    (should (equal (rgr-abbrev-make-simple-abbreviation "this is a test")
		   "tiat"))
    (should (equal (rgr-abbrev-make-simple-abbreviation
		    "reallyStupidNamingConvention")
		   "rsnc"))
    ;; Test hashing.
    (rgr-abbrev--hash-name "complicated")
    (should (equal (rgr-abbrev--table-strings) '("complicated")))
    (rgr-abbrev--hash-name "complicate")
    (should (equal (rgr-abbrev--table-strings)
		   '("complicate" "complicated")))
    (rgr-abbrev--hash-string-potential-names
     ";; Define all names that appear in the string.  The string is EXPECTED")
    (should (equal (rgr-abbrev--table-strings)
		   '("Define" "EXPECTED" "appear" "complicate"
		     "complicated" "string")))
    (rgr-abbrev-clean-prefixes nil)
    (should (equal (rgr-abbrev--table-strings)
		   '("Define" "appear" "complicated" "expected" "string")))))

(defun rgr-abbrev-test-string-present-p (string)
  ;; Like rgr-abbrev-intern-string
  (let ((hash (mod (rgr-fast-string-hash string) rgr-string-table-size)))
    (let ((<tail> (aref rgr-string-table hash)))
      (while (and <tail> (not (equal string (car (car <tail>)))))
        (setq <tail> (cdr <tail>)))
      (car <tail>))))
  (rgr-abbrev--intern-string string :soft))

(defun rgr-word-before ()
  (let ((end (point)))
    (save-excursion
      (backward-word)
      (buffer-substring (point) end))))

(defun rgr-compare-possibilities (expected-possibilities)
  (rgr-list-abbreviations)
  (let ((actual-possibilities
	 (with-current-buffer "*Completion Possibilities*"
	   (buffer-substring (point-min) (point-max)))))
    (should (equal actual-possibilities expected-possibilities))))

(defconst rgr-abbrev-possibilities-1a "There are 3 possibilities:

   consequential
   consecutive
   consecrated
" "Test output")

(defconst rgr-abbrev-possibilities-1b "There are 3 possibilities:

   consequential
 * consecutive
   consecrated

Current (or next) is marked with a \"*\".
" "More test output")

(defconst rgr-abbrev-possibilities-1c "There are 2 possibilities:

   consequential
   consecrated
" "Still more test output")

(defconst rgr-abbrev-possibilities-1d "There are 3 possibilities:

   consequential
   Conservatism
   consecrated
" "Still more test output")

(defconst rgr-abbrev-completion-test-file-name "test/completions.tmp"
  "Filename to test writing of completions.")

(defconst rgr-abbrev-completion-save-output "
(\"concrete\" . 1)

;; 1 out of 4 completions written.
" "More test output, missing the first line, which contains today's date.")

(defconst rgr-abbrev-completion-more-save-output "
(\"concrete\" . 1)
(\"inconsequential\" . 1)

;; 2 out of 6 completions written.
" "Still more test output.")

(defconst rgr-abbrev-completion-save-output-3 "
(\"concrete\" . 1)
(\"appear\" . 1)
(\"inconsequential\" . 1)

;; 3 out of 3 completions written.
" "Third test output.")

(ert-deftest rgr-abbrev-test-1 ()
  (with-rgr-abbrev-testing ()


@@ 41,6 124,88 @@
    (should (equal (buffer-substring (- (point) 8) (point)) "concrete"))
    (should (equal (rgr-abbrev-test-string-present-p "concrete")
		   '("concrete" . 1)))
    ))
    ;; Test the non-learning of a prefix.
    (insert "\n cons")
    (rgr-compare-possibilities rgr-abbrev-possibilities-1a)
    (rgr-maybe-learn-new-symbol)
    (rgr-compare-possibilities rgr-abbrev-possibilities-1a)
    ;; Test cycling.
    (let ((completions nil))
      (cl-dotimes (_i 5)
	(rgr-insert-symbol-abbreviation)
	(undo-boundary)
	(push (rgr-word-before) completions))
      (should (equal completions
		     '("consecutive" "consequential" "consecrated" "consecutive"
		       "conse"))))
    (undo-boundary)
    ;; Test killing.
    (rgr-compare-possibilities rgr-abbrev-possibilities-1b)
    (rgr-abbrev-kill)
    (should (equal (rgr-word-before) "consequential"))
    (insert "\nconse")
    (rgr-compare-possibilities rgr-abbrev-possibilities-1c)
    ;; Test case-insensitivity.
    (insert "\nConservatism ")
    (rgr-maybe-learn-new-symbol)
    (insert "\nconse")
    (rgr-compare-possibilities rgr-abbrev-possibilities-1d)
    ;; Test writing.
    (let ((filename rgr-abbrev-completion-test-file-name))
      (delete-file filename)
      (rgr-write-completion-file filename 1 100)
      (should (file-exists-p filename))
      (with-rgr-temp-file-buffer (buffer filename)
	(goto-char (point-min))
	(should (looking-at ";; Completions written"))
	(forward-line)
	(should (equal (buffer-substring (point) (point-max))
		       rgr-abbrev-completion-save-output))))
    ;; Test reading again (note: not in the scope of the first
    ;; with-rgr-abbrev-testing).
    (with-rgr-abbrev-testing ()
      (let ((filename rgr-abbrev-completion-test-file-name))
	(rgr-read-completion-file filename)
	(should (equal (rgr-abbrev--table-strings) '("concrete")))))
    ;; Learn something new, complete it, and write again.
    (dolist (word '("\nMore " "inconsequential " "unconsecrated " "bits." "\n"))
      (insert word)
      (rgr-maybe-learn-new-symbol))
    (undo-boundary)
    (insert "incons")
    (rgr-insert-symbol-abbreviation)
    (undo-boundary)
    (should (equal (rgr-word-before) "inconsequential"))
    ;; Since the file exists, "inconsequential" should be merged into it.
    (let ((filename rgr-abbrev-completion-test-file-name)
	  ;; This is normally the default.
	  (rgr-abbrev-completion-append-to-file-p
	    'rgr-abbrev-completion-file-newer-than-one-day-p))
      (rgr-write-completion-file filename 1 100)
      (with-rgr-temp-file-buffer (buffer filename)
	(goto-char (point-min))
	(should (= 2 (flush-lines "^;; Completions written")))
	(should (equal (buffer-substring (point-min) (point-max))
		       rgr-abbrev-completion-more-save-output)))))
  ;; Start a completely new scope, to make sure we're really merging.
  (with-rgr-abbrev-testing ()
    (rgr-abbrev--hash-string-potential-names
      ";; Define all names that appear in the string.")
    (insert "\n\n app")
    (rgr-insert-symbol-abbreviation)
    (undo-boundary)
    (should (equal (rgr-abbrev--table-strings) '("Define" "appear" "string")))
    (let ((filename rgr-abbrev-completion-test-file-name)
	  (rgr-abbrev-completion-append-to-file-p t))
      (rgr-write-completion-file filename 1 100)
      (with-rgr-temp-file-buffer (buffer filename)
	(goto-char (point-min))
	(should (= 3 (flush-lines "^;; Completions written")))
	(should (equal (buffer-substring (point-min) (point-max))
		       rgr-abbrev-completion-save-output-3)))
      ;; Merging with the original file contents does not affect the database.
      (should (equal (rgr-abbrev--table-strings) '("Define" "appear" "string")))
      (delete-file filename)
      (should (not (file-exists-p filename))))))

(provide 'test-rgr-abbrev-completion)