diff options
| author | Stefan Monnier | 2012-10-23 23:18:32 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-10-23 23:18:32 -0400 |
| commit | d92df117f9e0b4768b5d4d48db5261a950f57c0a (patch) | |
| tree | 83e958d5169fd39f31a6400f471b40f9282a2b43 | |
| parent | 9eadb1a9074d93464dfa4d97c22a791c4d76353f (diff) | |
| download | emacs-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/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 107 |
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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca> | 10 | 2012-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 | ||