aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-10-23 23:18:32 -0400
committerStefan Monnier2012-10-23 23:18:32 -0400
commitd92df117f9e0b4768b5d4d48db5261a950f57c0a (patch)
tree83e958d5169fd39f31a6400f471b40f9282a2b43
parent9eadb1a9074d93464dfa4d97c22a791c4d76353f (diff)
downloademacs-d92df117f9e0b4768b5d4d48db5261a950f57c0a.tar.gz
emacs-d92df117f9e0b4768b5d4d48db5261a950f57c0a.zip
* lisp/minibuffer.el (completion--all-sorted-completions-location): New var.
(completion--cache-all-sorted-completions) (completion--flush-all-sorted-completions): Use it. (completion-in-region, completion-in-region--postch) (completion-at-point, completion-help-at-point): Use markers in completion-in-region--data. Fixes: debbugs:12619
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/minibuffer.el107
2 files changed, 69 insertions, 47 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index df7420c30a3..c84d0110fc7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
12012-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * minibuffer.el (completion--all-sorted-completions-location): New var.
4 (completion--cache-all-sorted-completions)
5 (completion--flush-all-sorted-completions): Use it.
6 (completion-in-region, completion-in-region--postch)
7 (completion-at-point, completion-help-at-point): Use markers in
8 completion-in-region--data (bug#12619).
9
12012-10-23 Stefan Monnier <monnier@iro.umontreal.ca> 102012-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
2 11
3 * progmodes/compile.el (compilation-start): Try to handle common 12 * progmodes/compile.el (compilation-start): Try to handle common
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f865a0269d4..3f9ec339c78 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -871,6 +871,7 @@ completion candidates than this number."
871 871
872(defvar completion-all-sorted-completions nil) 872(defvar completion-all-sorted-completions nil)
873(make-variable-buffer-local 'completion-all-sorted-completions) 873(make-variable-buffer-local 'completion-all-sorted-completions)
874(defvar-local completion--all-sorted-completions-location nil)
874(defvar completion-cycling nil) 875(defvar completion-cycling nil)
875 876
876(defvar completion-fail-discreetly nil 877(defvar completion-fail-discreetly nil
@@ -1048,14 +1049,19 @@ scroll the window of possible completions."
1048 1049
1049(defun completion--cache-all-sorted-completions (comps) 1050(defun completion--cache-all-sorted-completions (comps)
1050 (add-hook 'after-change-functions 1051 (add-hook 'after-change-functions
1051 'completion--flush-all-sorted-completions nil t) 1052 'completion--flush-all-sorted-completions nil t)
1053 (setq completion--all-sorted-completions-location
1054 (cons (copy-marker (field-beginning)) (copy-marker (field-end))))
1052 (setq completion-all-sorted-completions comps)) 1055 (setq completion-all-sorted-completions comps))
1053 1056
1054(defun completion--flush-all-sorted-completions (&rest _ignore) 1057(defun completion--flush-all-sorted-completions (&rest start end len)
1055 (remove-hook 'after-change-functions 1058 (unless (and start end
1056 'completion--flush-all-sorted-completions t) 1059 (or (> start (cdr completion--all-sorted-completions-location))
1057 (setq completion-cycling nil) 1060 (< end (car completion--all-sorted-completions-location))))
1058 (setq completion-all-sorted-completions nil)) 1061 (remove-hook 'after-change-functions
1062 'completion--flush-all-sorted-completions t)
1063 (setq completion-cycling nil)
1064 (setq completion-all-sorted-completions nil)))
1059 1065
1060(defun completion--metadata (string base md-at-point table pred) 1066(defun completion--metadata (string base md-at-point table pred)
1061 ;; Like completion-metadata, but for the specific case of getting the 1067 ;; Like completion-metadata, but for the specific case of getting the
@@ -1758,7 +1764,10 @@ exit."
1758 (when completion-in-region-mode-predicate 1764 (when completion-in-region-mode-predicate
1759 (completion-in-region-mode 1) 1765 (completion-in-region-mode 1)
1760 (setq completion-in-region--data 1766 (setq completion-in-region--data
1761 (list (current-buffer) start end collection))) 1767 (list (if (markerp start) start (copy-marker start))
1768 (copy-marker end) collection)))
1769 ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
1770 ;; than the other way around!
1762 (unwind-protect 1771 (unwind-protect
1763 (call-interactively 'minibuffer-complete) 1772 (call-interactively 'minibuffer-complete)
1764 (delete-overlay ol))))) 1773 (delete-overlay ol)))))
@@ -1782,12 +1791,12 @@ exit."
1782 (or unread-command-events ;Don't pop down the completions in the middle of 1791 (or unread-command-events ;Don't pop down the completions in the middle of
1783 ;mouse-drag-region/mouse-set-point. 1792 ;mouse-drag-region/mouse-set-point.
1784 (and completion-in-region--data 1793 (and completion-in-region--data
1785 (and (eq (car completion-in-region--data) 1794 (and (eq (marker-buffer (nth 0 completion-in-region--data))
1786 (current-buffer)) 1795 (current-buffer))
1787 (>= (point) (nth 1 completion-in-region--data)) 1796 (>= (point) (nth 0 completion-in-region--data))
1788 (<= (point) 1797 (<= (point)
1789 (save-excursion 1798 (save-excursion
1790 (goto-char (nth 2 completion-in-region--data)) 1799 (goto-char (nth 1 completion-in-region--data))
1791 (line-end-position))) 1800 (line-end-position)))
1792 (funcall completion-in-region-mode--predicate))) 1801 (funcall completion-in-region-mode--predicate)))
1793 (completion-in-region-mode -1))) 1802 (completion-in-region-mode -1)))
@@ -1892,17 +1901,19 @@ The completion method is determined by `completion-at-point-functions'."
1892 (let ((res (run-hook-wrapped 'completion-at-point-functions 1901 (let ((res (run-hook-wrapped 'completion-at-point-functions
1893 #'completion--capf-wrapper 'all))) 1902 #'completion--capf-wrapper 'all)))
1894 (pcase res 1903 (pcase res
1895 (`(,_ . ,(and (pred functionp) f)) (funcall f)) 1904 (`(,_ . ,(and (pred functionp) f)) (funcall f))
1896 (`(,hookfun . (,start ,end ,collection . ,plist)) 1905 (`(,hookfun . (,start ,end ,collection . ,plist))
1897 (let* ((completion-extra-properties plist) 1906 (unless (markerp start) (setq start (copy-marker start)))
1898 (completion-in-region-mode-predicate 1907 (let* ((completion-extra-properties plist)
1899 (lambda () 1908 (completion-in-region-mode-predicate
1900 ;; We're still in the same completion field. 1909 (lambda ()
1901 (eq (car-safe (funcall hookfun)) start)))) 1910 ;; We're still in the same completion field.
1902 (completion-in-region start end collection 1911 (let ((newstart (car-safe (funcall hookfun))))
1903 (plist-get plist :predicate)))) 1912 (and newstart (= newstart start))))))
1904 ;; Maybe completion already happened and the function returned t. 1913 (completion-in-region start end collection
1905 (_ (cdr res))))) 1914 (plist-get plist :predicate))))
1915 ;; Maybe completion already happened and the function returned t.
1916 (_ (cdr res)))))
1906 1917
1907(defun completion-help-at-point () 1918(defun completion-help-at-point ()
1908 "Display the completions on the text around point. 1919 "Display the completions on the text around point.
@@ -1914,32 +1925,34 @@ The completion method is determined by `completion-at-point-functions'."
1914 (pcase res 1925 (pcase res
1915 (`(,_ . ,(and (pred functionp) f)) 1926 (`(,_ . ,(and (pred functionp) f))
1916 (message "Don't know how to show completions for %S" f)) 1927 (message "Don't know how to show completions for %S" f))
1917 (`(,hookfun . (,start ,end ,collection . ,plist)) 1928 (`(,hookfun . (,start ,end ,collection . ,plist))
1918 (let* ((minibuffer-completion-table collection) 1929 (unless (markerp start) (setq start (copy-marker start)))
1919 (minibuffer-completion-predicate (plist-get plist :predicate)) 1930 (let* ((minibuffer-completion-table collection)
1920 (completion-extra-properties plist) 1931 (minibuffer-completion-predicate (plist-get plist :predicate))
1921 (completion-in-region-mode-predicate 1932 (completion-extra-properties plist)
1922 (lambda () 1933 (completion-in-region-mode-predicate
1923 ;; We're still in the same completion field. 1934 (lambda ()
1924 (eq (car-safe (funcall hookfun)) start))) 1935 ;; We're still in the same completion field.
1925 (ol (make-overlay start end nil nil t))) 1936 (let ((newstart (car-safe (funcall hookfun))))
1926 ;; FIXME: We should somehow (ab)use completion-in-region-function or 1937 (and newstart (= newstart start)))))
1927 ;; introduce a corresponding hook (plus another for word-completion, 1938 (ol (make-overlay start end nil nil t)))
1928 ;; and another for force-completion, maybe?). 1939 ;; FIXME: We should somehow (ab)use completion-in-region-function or
1929 (overlay-put ol 'field 'completion) 1940 ;; introduce a corresponding hook (plus another for word-completion,
1930 (overlay-put ol 'priority 100) 1941 ;; and another for force-completion, maybe?).
1931 (completion-in-region-mode 1) 1942 (overlay-put ol 'field 'completion)
1932 (setq completion-in-region--data 1943 (overlay-put ol 'priority 100)
1933 (list (current-buffer) start end collection)) 1944 (completion-in-region-mode 1)
1934 (unwind-protect 1945 (setq completion-in-region--data
1935 (call-interactively 'minibuffer-completion-help) 1946 (list start (copy-marker end) collection))
1936 (delete-overlay ol)))) 1947 (unwind-protect
1937 (`(,hookfun . ,_) 1948 (call-interactively 'minibuffer-completion-help)
1938 ;; The hook function already performed completion :-( 1949 (delete-overlay ol))))
1939 ;; Not much we can do at this point. 1950 (`(,hookfun . ,_)
1940 (message "%s already performed completion!" hookfun) 1951 ;; The hook function already performed completion :-(
1941 nil) 1952 ;; Not much we can do at this point.
1942 (_ (message "Nothing to complete at point"))))) 1953 (message "%s already performed completion!" hookfun)
1954 nil)
1955 (_ (message "Nothing to complete at point")))))
1943 1956
1944;;; Key bindings. 1957;;; Key bindings.
1945 1958