;;;; Look Ma, no hands!

;;; A package to help Jen Mankoff save keystrokes.

;;; jen-cookie:
;;
;; Well, I suspect this is not too useful yet.  It will only offer to
;; complete if there are 10 or fewer completions available, otherwise
;; it asks you to type some more of the word! :-) However, it's a
;; start.  We can make it tune itself to your word usage, and not
;; offer rarely-used completions (currently it offers everything it
;; finds in /usr/dict/words, since it doesn't know about modes yet).
;; Many features aren't in yet, but it's clear where to hook them in.
;;
;; At the moment, the only difference between this and dynamic abbrevs
;; (M-/) is that this offers all the completions at once in a separate
;; window, and you type a number to choose the one you want.  Probably
;; I'm duplicating a lot of code with Emacs' built-in abbrev package,
;; but it didn't take long to write and we want to be able to
;; customize it later.
;;
;; Search for further `jen-cookie's to learn more.  Oh, you might
;; want to tweak some of the variables below.  I hope their meanings
;; are clear (?)...

(defvar lookma-case-sensitive nil
  "*Ignore case when offering words for completion.")


(defvar lookma-global-word-file "/usr/dict/words"
  "*Where to find a big list of generic words, separated by newlines.")


(defvar lookma-ignore-threshold 5
  "*Don't ever offer a word whose length is not greater than this.")


(defvar lookma-offer-threshold 3
  "*The number of letters remaining in a word before lookma will offer it.
For example, if you have already typed \"fro\", and the value of this
variable is greater than 1, then \"from\" will not appear in the list
of automatically-completeable words, but \"fromage\" might.")


;; todo: if this ever does more than words -- common code skeletons,
;; for example -- then we'll want to rename some of these variables
;; and functions so they don't imply only words.
(defvar lookma-word-list nil
  "The global list of words lookma is using.")

;; todo: think about how lookma will behave when the list has
;; different values in different buffers...
;; (make-variable-buffer-local lookma-word-list)


(defconst lookma-word-list-sources ()
  "An alist mapping mode names onto functions which return lists of words.
It looks like this:

   ((\"foo-mode\" . lookma-build-foo-mode-word-list)
    (\"bar-mode\" . lookma-build-bar-mode-word-list)
    (\"my-mode\"  . custom-word-set-builder-written-by-me))

todo: document the word list API better, note case-insensitivity.

If no match is found for the current mode, then
`lookma-build-default-word-list' is used.")



(defun lookma-build-default-word-list ()
  "Build a list of words from /usr/dict/words (or whatever the value
`lookma-global-word-file' is).
todo: this doesn't even work on non-Unix systems."

  (save-excursion
    (set-buffer (find-file-noselect lookma-global-word-file))
    (goto-char (point-max)) ;; work in reverse
    (let (lst)
      (while (= 0 (forward-line -1))
        (let ((word (buffer-substring 
                     (point)
                     (progn (end-of-line) (point)))))
          (if (<= (length word) lookma-ignore-threshold)
              nil
            ;; todo: this loses case information.  We can recover some
            ;; of it from the working buffer, but not all.  For
            ;; example, "Bhagavad-Gita" is recorded in this list as
            ;; "bhagavad-gita"; if the user types "Bha", lookma will
            ;; complete to "Bhagavad-gita".  Hmmm.
            (unless lookma-case-sensitive (setq word (downcase word)))
            (setq lst (cons word lst))
            (message "Building lookma word set (%s)..." (car lst)))))
      (message "Building lookma word set...done")
      (kill-buffer nil)
      lst)))


(defun lookma-build-word-list ()
  "Build a list of words to possibly complete.
todo: this should really depend on the buffer's mode.  Right now it
just gets a list from /usr/dict/words."
  (let ((lst
         (let ((match (assoc major-mode lookma-word-set-sources)))
           (if match
               (cdr match)
             ;; else fall back to generic generator
             (lookma-build-default-word-list)))))
    (setq lookma-word-list (sort lst 'string-lessp))
    ;; code from this point on assumes the list is sorted.
    ))



;;; jen-cookie:
;;
;; Okay -- completions get cached for better response time.  Here's
;; how it works:
;;
;; `lookma-build-completion-list' returns a list of those elements of
;; `lookma-word-list' who are prefixed by FRAG.  However, finding
;; those elements takes a long time, so once we've discovered the
;; completions for a given FRAG, we cache that information in a hash
;; table (an `obarray' in Emacs Lisp).  Future lookups for that
;; particular FRAG will be much faster.  All this is based on the idea
;; that what you've tried to complete in the past you're likely to try
;; completing in the future too.
;;
;; So what does this imply for the user?
;;
;; It's probably best to get in the habit of completing off the same
;; fragment of a word every time.  That is, if you typed "arac" and
;; auto-completed to "arachnid" before, the next time you need that
;; word you should also type "arac" and complete off that (as opposed
;; to typing, say, "arach" and then completing).
;;
;; There are two reasons why consistency is preferable: the first is
;; that the possible completions will be assigned the same numbers
;; when they're offered to you, so it will be easy to develop a reflex
;; to type (say) "arac3" to get the word "arachnid".  The second
;; reason is that "arac" will already be in the hash table after the
;; first time, so it will complete much faster than "arach" (though
;; future completions of "arach" will of course be just as fast as
;; "arac").


;; todo: if lookma-word-list ever goes buffer-local, so should this.
;; The year of the U.S. Constitution is prime, how nice.
(defvar lookma-fragment-obarray (make-vector 1787 nil))

(defun lookma-build-completion-list (frag)
  "Return a list of completions for FRAG."

  ;;  If we don't have the list yet, just build it.
  (if (null lookma-word-list)
      (lookma-build-word-list))

  (if (intern-soft frag lookma-fragment-obarray)
      (symbol-value (intern frag lookma-fragment-obarray))

    ;; Else
    (let ((master-list lookma-word-list)
          (possibles  nil)
          (re-frag (concat "^" (regexp-quote frag))))
      ;; Accumulate all the possible completions...
      (while master-list
        ;; todo: maybe should be using built-in completion functions
        ;; for this part.
        (if (string-match re-frag (car master-list))
            (setq possibles (cons (car master-list) possibles)))
        (setq master-list (cdr master-list)))
      ;; ... cache them in the obarray ...
      (let ((frag-sym (intern frag lookma-fragment-obarray)))
        (set frag-sym possibles))
      ;; ... and return the list of possible completions:
      possibles)))


;;; jen-cookie: this is the function to bind to a key.  The first time
;;; you run it, it will build the word list, which will take a long
;;; time.  After that it should be okay.

;; This is the main user entry point to lookma.el.
(defun lookma-complete ()
  "Complete a word, displaying choices.
If there are more than 10 completions possible, it will ask you for
more information.  If you hit space instead of a digit, it will just
insert a space instead trying to complete the word."
  (interactive)
  (let* ((pt (point))
         (o-buf (current-buffer))
         (frag (save-excursion
                 (buffer-substring 
                  ;; todo: bulletproof?
                  (progn (forward-word -1) (point))
                  pt))))
    (unless lookma-case-sensitive (setq frag (downcase frag)))
    (let* ((lst (lookma-build-completion-list frag))
           (completion
            (cond 
             ((<= (length lst) 0) 
              "")
             ((= (length lst) 1)
              (car lst))
             ((> (length lst) 10)
                0)
             (t ;; lst length is from 2 to 10, so we can complete on it
              (save-window-excursion
                (let ((buf (get-buffer-create "*lookma completions*"))
                      (them lst)
                      (count 0)
                      (char  0)
                      (full-word nil))
                  
                  ;; Construct the buffer of choices:
                  (save-excursion
                    (set-buffer buf)
                    (delete-region (point-min) (point-max)) ;; clear it
                    (while them
                      (insert (format "%d: %s\n" count (car them)))
                      (setq count (1+ count))
                      (setq them (cdr them))))
                  
                  ;; Offer the user a choice:
                  (display-buffer buf)
                  (set-buffer buf)
                  (message "pleased to enter a single digit: ")
                  (setq char (read-char))
                  (if (= char ? ) ;; there's a space there
                      " "
                    ;; Else
                    (goto-char (point-min))
                    (if (re-search-forward 
                         (concat "^" (char-to-string char) ": ") nil t)
                        (setq full-word (buffer-substring
                                         (point)
                                         (progn (end-of-line) (point))))
                      (error "response should be a digit from 0 to 9"))
                    full-word)))))))
                  
      ;; Now we have all the information we need to
      ;; complete.  This is a very completitive program,
      ;; wouldn't you say?
      (set-buffer o-buf)
      (cond
       ((numberp completion)
        ;; todo: this is a total copout.  Will need to work on the
        ;; displaying of the list quite a bit before the copout can go
        ;; away, though.
        (message
         "\"%s\" has too many completions -- please disambiguate some more."
         frag))
       ((string-equal completion "")
        (message "No completions found for \"%s\"." frag))
       ((string-equal completion " ")
        (insert " "))
       (t
        (let ((idx (length frag)))
          ;; todo: I think inserting a space after the completion is
          ;; the right thing to do... ?
          (insert (substring completion idx) " ")))))))

;;; jen-cookie:
;;
;; It wouldn't be difficult to discard infrequently-completed-to
;; words, so that the cache gets better and better tuned the longer
;; you spend in the buffer.  And also, the cache could be saved to
;; disk so all that real-use information isn't lost between sessions.
;;
;; However, an adverse effect of doing the above would be that the
;; completion `number' of other words would get changed each time a
;; word got discarded (if you toss out word number 3, for example,
;; then all words 4 and above shift down one).
;;
;; So before we try it, which way would you like it to work by
;; default?  And would you sometimes want to turn off discarsion
;; (hmm, I think I just made up a word)?
;;
;; The saving-to-disk part seems unqualifiedly good.  However, since
;; designing the file format is a little bit non-trivial, let's wait
;; until we have a clearer idea of how mode-sensitive lookma should be
;; before we add it.
;;
;; I find the way the completion buffer pops in and out of existence,
;; contracting and expanding the original window with it, a little
;; distracting.  Will try to think of way to display them more
;; unobtrusively.