[Emacs-diffs] /srv/bzr/emacs/trunk r103784: (completion-in-region): Pop down *Completions* automatically.

[Stefan Monnier]

------------------------------------------------------------
revno: 103784
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2011-03-30 18:25:57 -0400
message:
  (completion-in-region): Pop down *Completions* automatically.
  * lisp/minibuffer.el (completion-table-dynamic): Optimize `boundaries'.
  (completion-in-region-mode): New minor mode.
  (completion-in-region): Use it.
  (completion-in-region--data, completion-in-region-mode-map): New vars.
  (completion-in-region--postch): New function.
  (completion--capf-misbehave-funs, completion--capf-safe-funs): New vars.
  (completion--capf-wrapper): New function.
  (completion-at-point): Use it to track well-behavedness of hook functions.
  (completion-help-at-point): New command.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/minibuffer.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-03-28 20:26:35 +0000
+++ b/etc/NEWS  2011-03-30 22:25:57 +0000
@@ -67,6 +67,9 @@
 
 * Changes in Emacs 24.1
 
+** Completion in a non-minibuffer now tries to detect the end of completion
+and pops down the *Completions* buffer accordingly.
+
 ** emacsclient changes
 
 *** New emacsclient argument --parent-id ID can be used to open a

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-03-30 21:56:04 +0000
+++ b/lisp/ChangeLog    2011-03-30 22:25:57 +0000
@@ -1,3 +1,17 @@
+2011-03-30  Stefan Monnier  <address@hidden>
+
+       * minibuffer.el (completion-table-dynamic): Optimize `boundaries'.
+       (completion-in-region-mode): New minor mode.
+       (completion-in-region): Use it.
+       (completion-in-region--data, completion-in-region-mode-map): New vars.
+       (completion-in-region--postch): New function.
+       (completion--capf-misbehave-funs, completion--capf-safe-funs):
+       New vars.
+       (completion--capf-wrapper): New function.
+       (completion-at-point): Use it to track well-behavedness of
+       hook functions.
+       (completion-help-at-point): New command.
+
 2011-03-30  Jason Merrill  <address@hidden>  (tiny change)
 
        * vc/add-log.el (add-change-log-entry): Don't use whitespace

=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el        2011-03-24 22:05:01 +0000
+++ b/lisp/minibuffer.el        2011-03-30 22:25:57 +0000
@@ -173,10 +173,14 @@
 `all-completions'.  See Info node `(elisp)Programmed Completion'."
   (lexical-let ((fun fun))
     (lambda (string pred action)
-      (with-current-buffer (let ((win (minibuffer-selected-window)))
-                             (if (window-live-p win) (window-buffer win)
-                               (current-buffer)))
-        (complete-with-action action (funcall fun string) string pred)))))
+      (if (eq (car-safe action) 'boundaries)
+          ;; `fun' is not supposed to return another function but a plain old
+          ;; completion table, whose boundaries are always trivial.
+          nil
+        (with-current-buffer (let ((win (minibuffer-selected-window)))
+                               (if (window-live-p win) (window-buffer win)
+                                 (current-buffer)))
+          (complete-with-action action (funcall fun string) string pred))))))
 
 (defmacro lazy-completion-table (var fun)
   "Initialize variable VAR as a lazy completion table.
@@ -240,6 +244,10 @@
 number 1 should match TERMINATOR.  This is used when there is a need to
 distinguish occurrences of the TERMINATOR strings which are really terminators
 from others (e.g. escaped)."
+  ;; FIXME: This implementation is not right since it only adds the terminator
+  ;; in try-completion, so any completion-style that builds the completion via
+  ;; all-completions won't get the terminator, and selecting an entry in
+  ;; *Completions* won't get the terminator added either.
   (cond
    ((eq (car-safe action) 'boundaries)
     (let* ((suffix (cdr action))
@@ -716,6 +724,8 @@
                                     (< (or s1 (length c1))
                                        (or s2 (length c2))))))))
           ;; Prefer recently used completions.
+          ;; FIXME: Additional sorting ideas:
+          ;; - for M-x, prefer commands that have no key binding.
           (let ((hist (symbol-value minibuffer-history-variable)))
             (setq all (sort all (lambda (c1 c2)
                                   (> (length (member c1 hist))
@@ -1008,8 +1018,8 @@
                  ;; a space displayed.
                  (set-text-properties (- (point) 1) (point)
                                       ;; We can't just set tab-width, because
-                                      ;; completion-setup-function will kill 
all
-                                      ;; local variables :-(
+                                      ;; completion-setup-function will kill
+                                      ;; all local variables :-(
                                       `(display (space :align-to ,column)))
                  nil))))
             (if (not (consp str))
@@ -1237,6 +1247,8 @@
 are expected to perform completion on START..END using COLLECTION
 and PREDICATE, either by calling NEXT-FUN or by doing it themselves.")
 
+(defvar completion-in-region--data nil)
+
 (defun completion-in-region (start end collection &optional predicate)
   "Complete the text between START and END using COLLECTION.
 Return nil if there is no valid completion, else t.
@@ -1251,15 +1263,78 @@
           (minibuffer-completion-predicate predicate)
           (ol (make-overlay start end nil nil t)))
       (overlay-put ol 'field 'completion)
+      (completion-in-region-mode 1)
+      (setq completion-in-region--data
+            (list (current-buffer) start end collection))
       (unwind-protect
           (call-interactively 'minibuffer-complete)
         (delete-overlay ol)))))
 
+(defvar completion-in-region-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "?" 'completion-help-at-point)
+    (define-key map "\t" 'completion-at-point)
+    map)
+  "Keymap activated during `completion-in-region'.")
+
+;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
+;; the *Completions*).
+;; - lisp-mode: never.
+;; - comint: only do it if you hit SPC at the right time.
+;; - pcomplete: pop it down on SPC or after some time-delay.
+;; - semantic: use a post-command-hook check similar to this one.
+(defun completion-in-region--postch ()
+  (message "completion-in-region--postch: cmd=%s" this-command)
+  (or unread-command-events ;Don't pop down the completions in the middle of
+                            ;mouse-drag-region/mouse-set-point.
+      (and completion-in-region--data
+           (and (eq (car completion-in-region--data)
+                    (current-buffer))
+                (>= (point) (nth 1 completion-in-region--data))
+                (<= (point)
+                    (save-excursion
+                      (goto-char (nth 2 completion-in-region--data))
+                      (line-end-position)))
+                (let ((comp-data (run-hook-wrapped
+                                  'completion-at-point-functions
+                                  ;; Only use the known-safe functions.
+                                  #'completion--capf-wrapper 'safe)))
+                  (eq (car comp-data)
+                      ;; We're still in the same completion field.
+                      (nth 1 completion-in-region--data)))))
+      (completion-in-region-mode -1)))
+
+;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
+
+(define-minor-mode completion-in-region-mode
+  "Transient minor mode used during `completion-in-region'."
+  :global t
+  (setq completion-in-region--data nil)
+  ;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
+  (remove-hook 'post-command-hook #'completion-in-region--postch)
+  (setq minor-mode-overriding-map-alist
+        (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
+              minor-mode-overriding-map-alist))
+  (if (null completion-in-region-mode)
+      (progn
+        (unless (equal "*Completions*" (buffer-name (window-buffer)))
+          (minibuffer-hide-completions))
+        (message "Leaving completion-in-region-mode"))
+    ;; (add-hook 'pre-command-hook #'completion-in-region--prech)
+    (add-hook 'post-command-hook #'completion-in-region--postch)
+    (push `(completion-in-region-mode . ,completion-in-region-mode-map)
+          minor-mode-overriding-map-alist)))
+
+;; Define-minor-mode added our keymap to minor-mode-map-alist, but we want it
+;; on minor-mode-overriding-map-alist instead.
+(setq minor-mode-map-alist
+      (delq (assq 'completion-in-region-mode minor-mode-map-alist)
+            minor-mode-map-alist))
+
 (defvar completion-at-point-functions '(tags-completion-at-point-function)
   "Special hook to find the completion table for the thing at point.
 Each function on this hook is called in turns without any argument and should
 return either nil to mean that it is not applicable at point,
-or t to mean that it already performed completion (discouraged),
 or a function of no argument to perform completion (discouraged),
 or a list of the form (START END COLLECTION &rest PROPS) where
  START and END delimit the entity to complete and should include point,
@@ -1269,12 +1344,34 @@
  `:predicate'           a predicate that completion candidates need to satisfy.
  `:annotation-function' the value to use for `completion-annotate-function'.")
 
+(defvar completion--capf-misbehave-funs nil
+  "List of functions found on `completion-at-point-functions' that misbehave.")
+(defvar completion--capf-safe-funs nil
+  "List of well-behaved functions found on `completion-at-point-functions'.")
+
+(defun completion--capf-wrapper (fun which)
+  (if (case which
+        (all t)
+        (safe (member fun completion--capf-safe-funs))
+        (optimist (not (member fun completion--capf-misbehave-funs))))
+      (let ((res (funcall fun)))
+        (cond
+         ((consp res)
+          (unless (member fun completion--capf-safe-funs)
+            (push fun completion--capf-safe-funs)))
+         ((not (or (listp res) (functionp res)))
+          (unless (member fun completion--capf-misbehave-funs)
+            (message
+             "Completion function %S uses a deprecated calling convention" fun)
+            (push fun completion--capf-misbehave-funs))))
+        res)))
+
 (defun completion-at-point ()
   "Perform completion on the text around point.
 The completion method is determined by `completion-at-point-functions'."
   (interactive)
-  (let ((res (run-hook-with-args-until-success
-              'completion-at-point-functions)))
+  (let ((res (run-hook-wrapped 'completion-at-point-functions
+                               #'completion--capf-wrapper 'all)))
     (cond
      ((functionp res) (funcall res))
      ((consp res)
@@ -1288,6 +1385,37 @@
                               (plist-get plist :predicate))))
      (res))))  ;Maybe completion already happened and the function returned t.
 
+(defun completion-help-at-point ()
+  "Display the completions on the text around point.
+The completion method is determined by `completion-at-point-functions'."
+  (interactive)
+  (let ((res (run-hook-wrapped 'completion-at-point-functions
+                               ;; Ignore misbehaving functions.
+                               #'completion--capf-wrapper 'optimist)))
+    (cond
+     ((functionp res)
+      (message "Don't know how to show completions for %S" res))
+     ((consp res)
+      (let* ((plist (nthcdr 3 res))
+             (minibuffer-completion-table (nth 2 res))
+             (minibuffer-completion-predicate (plist-get plist :predicate))
+             (completion-annotate-function
+              (or (plist-get plist :annotation-function)
+                  completion-annotate-function))
+             (ol (make-overlay (nth 0 res) (nth 1 res) nil nil t)))
+        ;; FIXME: We should somehow (ab)use completion-in-region-function or
+        ;; introduce a corresponding hook (plus another for word-completion,
+        ;; and another for force-completion, maybe?).
+        (overlay-put ol 'field 'completion)
+        (unwind-protect
+            (call-interactively 'minibuffer-completion-help)
+          (delete-overlay ol))))
+     (res
+      ;; The hook function already performed completion :-(
+      ;; Not much we can do at this point.
+      nil)
+     (t (message "Nothing to complete at point")))))
+
 ;;; Key bindings.
 
 (define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
@@ -1910,9 +2038,9 @@
         (append (completion-pcm--string->pattern prefix)
                 '(point)
                 (completion-pcm--string->pattern suffix)))
-    (let ((pattern nil)
-          (p 0)
-          (p0 0))
+    (let* ((pattern nil)
+           (p 0)
+           (p0 p))
 
       (while (and (setq p (string-match completion-pcm--delim-wild-regex
                                         string p))