- ;; take care of scrolling if necessary -- completely cribbed from minibuf.c
- (if (not (eq last-command this-command))
- ;; ok?
- (setq minibuffer-scroll-window nil))
- (let ((window minibuffer-scroll-window))
- (if (and (not (null window))
- ;; ok?
- (not (null (window-buffer window))))
- (let (tem)
- (set-buffer (window-buffer window))
- ;; ok?
- (setq tem (pos-visible-in-window-p (point-max) window))
- (if (not (null tem))
- ;; ok?
- (set-window-start window (point-min) nil)
- (scroll-other-window nil))
- ;; reaching here means exiting the function w/ return value of nil
- nil)
-
- (let* (
- ;(crm-end-of-element nil)
- (result (crm-do-completion)))
- (cond
- ((eq 0 result)
- nil)
- ((eq 1 result)
- ;; adapted from Emacs 21
- (if (not (eq (point) crm-end-of-element))
- (goto-char (+ 1 crm-end-of-element)))
- (crm-temp-echo-area-glyphs " [Sole completion]")
- t)
- ((eq 3 result)
- ;; adapted from Emacs 21
- (if (not (eq (point) crm-end-of-element))
- (goto-char (+ 1 crm-end-of-element)))
- (crm-temp-echo-area-glyphs " [Complete, but not unique]")
- t))))))
-
-;; i love traffic lights...but only when they're green
-(defun crm-find-longest-completable-substring (string)
- "Determine the longest completable (left-anchored) substring of STRING.
-The description \"left-anchored\" means the positions of the characters
-in the substring must be the same as those of the corresponding characters
-in STRING. Anchoring is what `^' does in a regular expression.
-
-The table and predicate used for completion are
-`minibuffer-completion-table' and `minibuffer-completion-predicate',
-respectively.
-
-A non-nil return value means that there is some substring which is
-completable. A return value of t means that STRING itself is
-completable. If a string value is returned it is the longest
-completable proper substring of STRING. If nil is returned, STRING
-does not have any non-empty completable substrings.
-
-Remember: \"left-anchored\" substring"
- (let* ((length-of-string (length string))
- (index length-of-string)
- (done (if (> length-of-string 0)
- nil
- t))
- (first t) ; ugh, special handling for first time through...
- goal-string
- result)
- ;; loop through left-anchored substrings in order of descending length,
- ;; find the first substring that is completable
- (while (not done)
- (setq result (try-completion (substring string 0 index)
- minibuffer-completion-table
- minibuffer-completion-predicate))
- (if result
- ;; found completable substring
- (progn
- (setq done t)
- (if (and (eq result t) first)
- ;; exactly matching string first time through
- (setq goal-string t)
- ;; fully-completed proper substring
- (setq goal-string (substring string 0 index)))))
- (setq index (1- index))
- (if first
- (setq first nil))
- (if (<= index 0)
- (setq done t)))
- ;; possible values include: t, nil, some string
- goal-string))
-
-;; TODO: decide whether trailing separator is allowed. current
-;; implementation appears to allow it
-(defun crm-strings-completed-p (separated-string)
- "Verify that strings in SEPARATED-STRING are completed strings.
-A return value of t means that all strings were verified. A number is
-returned if verification was unsuccessful. This number represents the
-position in SEPARATED-STRING up to where completion was successful."
- (let ((strings (split-string separated-string crm-separator))
- ;; buffers start at 1, not 0
- (current-position 1)
- current-string
- result
- done)
- (while (and strings (not done))
- (setq current-string (car strings)
- result (try-completion current-string
- minibuffer-completion-table
- minibuffer-completion-predicate))
- (if (eq result t)
- (setq strings (cdr strings)
- current-position (+ current-position
- (length current-string)
- ;; automatically adding 1 for separator
- ;; character
- 1))
- ;; still one more case of a match
- (if (stringp result)
- (let ((string-list
- (all-completions result
- minibuffer-completion-table
- minibuffer-completion-predicate)))
- (if (member result string-list)
- ;; ho ho, code duplication...
- (setq strings (cdr strings)
- current-position (+ current-position
- (length current-string)
- 1))
- (progn
- (setq done t)
- ;; current-string is a partially-completed string
- (setq current-position (+ current-position
- (length current-string))))))
- ;; current-string cannot be completed
- (let ((completable-substring
- (crm-find-longest-completable-substring current-string)))
- (setq done t)
- (setq current-position (+ current-position
- (length completable-substring)))))))
- ;; return our result
- (if (null strings)
- t
- current-position)))
-
-;; try to complete candidate, then check all separated strings. move
-;; point to problem position if checking fails for some string. if
-;; checking succeeds for all strings, exit.
-(defun crm-minibuffer-complete-and-exit ()