[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r104334: Add an :exit-function for co
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r104334: Add an :exit-function for completion-at-point. |
|
Date: |
Mon, 23 May 2011 23:45:50 -0300 |
|
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 104334
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2011-05-23 23:45:50 -0300
message:
Add an :exit-function for completion-at-point.
* lisp/minibuffer.el (completion--done): New fun.
(completion--do-completion): Use it. New arg `expect-exact'.
(minibuffer-complete, minibuffer-complete-word): Don't output message,
since completion--do-completion does it for us now.
(minibuffer-force-complete): Use completion--done and
completion--replace. Handle sole-completion case with more care.
(minibuffer-complete-and-exit): Use new `expect-exact' arg.
(completion-extra-properties): New var.
(completion-annotate-function): Make obsolete.
(minibuffer-completion-help): Adjust accordingly.
Use completion-list-insert-choice-function.
(completion-at-point, completion-help-at-point):
Bind completion-extra-properties.
(completion-pcm-word-delimiters): Add | (for uniquify, for example).
* lisp/simple.el (completion-list-insert-choice-function): New var.
(completion-setup-function): Preserve it.
(choose-completion): Pay attention to it, shuffle the code a bit.
(choose-completion-string): New arg `insert-function'.
* lisp/textmodes/bibtex.el: Convert to lexical binding.
(bibtex-mode-map): Use completion-at-point.
(bibtex-mode): Use define-derived-mode&completion-at-point-functions.
(bibtex-completion-at-point-function): New fun, from bibtex-complete.
(bibtex-complete): Define as obsolete alias.
(bibtex-complete-internal): Remove.
(bibtex-format-entry): Remove unused sub-group in regexp.
* lisp/shell.el (shell--command-completion-data)
(shell-environment-variable-completion):
* lisp/pcomplete.el (pcomplete-completions-at-point):
* lisp/comint.el (comint--complete-file-name-data): Use :exit-function
instead of completion-table-with-terminator so it also works for
choose-completion.
modified:
etc/NEWS
lisp/ChangeLog
lisp/comint.el
lisp/minibuffer.el
lisp/pcomplete.el
lisp/shell.el
lisp/simple.el
lisp/textmodes/bibtex.el
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2011-05-18 03:39:45 +0000
+++ b/etc/NEWS 2011-05-24 02:45:50 +0000
@@ -68,9 +68,6 @@
* 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
@@ -83,9 +80,18 @@
*** If emacsclient shuts down as a result of Emacs signalling an
error, its exit status is 1.
-** Completion can cycle, depending on completion-cycle-threshold.
-
-** `completing-read' can be customized using the new variable
+** Completion
+*** Many packages have been changed to use completion-at-point rather than
+their own completion code.
+
+*** Completion in a non-minibuffer now tries to detect the end of completion
+and pops down the *Completions* buffer accordingly.
+
+*** Completion can cycle, depending on completion-cycle-threshold.
+
+*** New completion style `substring'.
+
+*** `completing-read' can be customized using the new variable
`completing-read-function'.
** auto-mode-case-fold is now enabled by default.
@@ -833,6 +839,17 @@
* Lisp changes in Emacs 24.1
+** Completion
+*** New variable completion-extra-properties used to specify extra properties
+of the current completion:
+- :annotate-function, same as the old completion-annotate-function.
+- :exit-function, function to call after completion took place.
+
+*** Functions on completion-at-point-functions can return any of the properties
+valid for completion-extra-properties.
+
+*** completion-annotate-function is obsolete.
+
** `glyphless-char-display' can now distinguish between graphical and
text terminal display, via a char-table entry that is a cons cell.
@@ -909,8 +926,6 @@
** buffer-substring-filters is obsoleted by filter-buffer-substring-functions.
-** New completion style `substring'.
-
** `facemenu-read-color' is now an alias for `read-color'.
The command `read-color' now requires a match for a color name or RGB
triplet, instead of signalling an error if the user provides a invalid
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-05-23 17:57:17 +0000
+++ b/lisp/ChangeLog 2011-05-24 02:45:50 +0000
@@ -1,3 +1,40 @@
+2011-05-24 Stefan Monnier <address@hidden>
+
+ Add an :exit-function for completion-at-point.
+
+ * minibuffer.el (completion--done): New fun.
+ (completion--do-completion): Use it. New arg `expect-exact'.
+ (minibuffer-complete, minibuffer-complete-word): Don't output message,
+ since completion--do-completion does it for us now.
+ (minibuffer-force-complete): Use completion--done and
+ completion--replace. Handle sole-completion case with more care.
+ (minibuffer-complete-and-exit): Use new `expect-exact' arg.
+ (completion-extra-properties): New var.
+ (completion-annotate-function): Make obsolete.
+ (minibuffer-completion-help): Adjust accordingly.
+ Use completion-list-insert-choice-function.
+ (completion-at-point, completion-help-at-point):
+ Bind completion-extra-properties.
+ (completion-pcm-word-delimiters): Add | (for uniquify, for example).
+ * simple.el (completion-list-insert-choice-function): New var.
+ (completion-setup-function): Preserve it.
+ (choose-completion): Pay attention to it, shuffle the code a bit.
+ (choose-completion-string): New arg `insert-function'.
+
+ * textmodes/bibtex.el: Convert to lexical binding.
+ (bibtex-mode-map): Use completion-at-point.
+ (bibtex-mode): Use define-derived-mode&completion-at-point-functions.
+ (bibtex-completion-at-point-function): New fun, from bibtex-complete.
+ (bibtex-complete): Define as obsolete alias.
+ (bibtex-complete-internal): Remove.
+ (bibtex-format-entry): Remove unused sub-group in regexp.
+ * shell.el (shell--command-completion-data)
+ (shell-environment-variable-completion):
+ * pcomplete.el (pcomplete-completions-at-point):
+ * comint.el (comint--complete-file-name-data): Use :exit-function
+ instead of completion-table-with-terminator so it also works for
+ choose-completion.
+
2011-05-23 Stefan Monnier <address@hidden>
* <lots-of-files>.el: Don't quote lambda expressions with `quote'.
=== modified file 'lisp/comint.el'
--- a/lisp/comint.el 2011-04-20 22:31:06 +0000
+++ b/lisp/comint.el 2011-05-24 02:45:50 +0000
@@ -3134,19 +3134,20 @@
#'comint--table-subvert
#'completion-file-name-table
(cdr prefixes) (car prefixes)))))
- (list
- filename-beg filename-end
- (lambda (string pred action)
- (let ((completion-ignore-case read-file-name-completion-ignore-case)
- (completion-ignored-extensions comint-completion-fignore))
- (if (zerop (length filesuffix))
- (complete-with-action action table string pred)
- ;; Add a space at the end of completion. Use a terminator-regexp
- ;; that never matches since the terminator cannot appear
- ;; within the completion field anyway.
- (completion-table-with-terminator
- (cons filesuffix "\\`a\\`")
- table string pred action)))))))
+ (nconc
+ (list
+ filename-beg filename-end
+ (lambda (string pred action)
+ (let ((completion-ignore-case read-file-name-completion-ignore-case)
+ (completion-ignored-extensions comint-completion-fignore))
+ (complete-with-action action table string pred))))
+ (unless (zerop (length filesuffix))
+ (list :exit-function
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at (regexp-quote filesuffix))
+ (goto-char (match-end 0))
+ (insert filesuffix)))))))))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
=== modified file 'lisp/minibuffer.el'
--- a/lisp/minibuffer.el 2011-05-04 01:19:32 +0000
+++ b/lisp/minibuffer.el 2011-05-24 02:45:50 +0000
@@ -58,12 +58,9 @@
;;; Todo:
+;; - for M-x, cycle-sort commands that have no key binding first.
;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode.
-;; - completion-insert-complete-hook (called after inserting a complete
-;; completion), typically used for "complete-abbrev" where it would expand
-;; the abbrev. Tho we'd probably want to provide it from the
-;; completion-table.
;; - extend `boundaries' to provide various other meta-data about the
;; output of `all-completions':
;; - preferred sorting order when displayed in *Completions*.
@@ -74,10 +71,6 @@
;; - indicate how to turn all-completion's output into
;; try-completion's output: e.g. completion-ignored-extensions.
;; maybe that could be merged with the "quote" operation above.
-;; - completion hook to run when the completion is
-;; selected/inserted (maybe this should be provided some other
-;; way, e.g. as text-property, so `try-completion can also return it?)
-;; both for when it's inserted via TAB or via choose-completion.
;; - indicate that `all-completions' doesn't do prefix-completion
;; but just returns some list that relates in some other way to
;; the provided string (as is the case in filecache.el), in which
@@ -87,18 +80,6 @@
;; \n into something else, add special boundaries between
;; completions). E.g. when completing from the kill-ring.
-;; - make partial-completion-mode obsolete:
-;; - (?) <foo.h> style completion for file names.
-;; This can't be done identically just by tweaking completion,
-;; because partial-completion-mode's behavior is to expand <string.h>
-;; to /usr/include/string.h only when exiting the minibuffer, at which
-;; point the completion code is actually not involved normally.
-;; Partial-completion-mode does it via a find-file-not-found-function.
-;; - special code for C-x C-f <> to visit the file ref'd at point
-;; via (require 'foo) or #include "foo". ffap seems like a better
-;; place for this feature (supplemented with major-mode-provided
-;; functions to find the file ref'd at point).
-
;; - case-sensitivity currently confuses two issues:
;; - whether or not a particular completion table should be case-sensitive
;; (i.e. whether strings that differ only by case are semantically
@@ -562,7 +543,8 @@
(if completion-show-inline-help
(minibuffer-message msg)))
-(defun completion--do-completion (&optional try-completion-function)
+(defun completion--do-completion (&optional try-completion-function
+ expect-exact)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
@@ -576,7 +558,11 @@
100 4 ??? impossible
101 5 ??? impossible
110 6 some completion happened
- 111 7 completed to an exact completion"
+ 111 7 completed to an exact completion
+
+TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
+EXPECT-EXACT, if non-nil, means that there is no need to tell the user
+when the buffer's text is already an exact match."
(let* ((beg (field-beginning))
(end (field-end))
(string (buffer-substring beg end))
@@ -595,7 +581,9 @@
(minibuffer--bitset nil nil nil))
((eq t comp)
(minibuffer-hide-completions)
- (goto-char (field-end))
+ (goto-char end)
+ (completion--done string 'finished
+ (unless expect-exact "Sole completion"))
(minibuffer--bitset nil nil t)) ;Exact and unique match.
(t
;; `completed' should be t if some completion was done, which doesn't
@@ -619,12 +607,12 @@
;; whether this is a unique completion or not, so try again using
;; the real case (this shouldn't recurse again, because the next
;; time try-completion will return either t or the exact string).
- (completion--do-completion try-completion-function)
+ (completion--do-completion try-completion-function expect-exact)
;; It did find a match. Do we match some possibility exactly now?
(let ((exact (test-completion completion
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
(comps
;; Check to see if we want to do cycling. We do it
;; here, after having performed the normal completion,
@@ -658,7 +646,13 @@
;; We could also decide to refresh the completions,
;; if they're displayed (and assuming there are
;; completions left).
- (minibuffer-hide-completions))
+ (minibuffer-hide-completions)
+ (if exact
+ ;; If completion did not put point at end of field,
+ ;; it's a sign that completion is not finished.
+ (completion--done completion
+ (if (< comp-pos (length completion))
+ 'exact 'unknown))))
;; Show the completion table, if requested.
((not exact)
(if (case completion-auto-help
@@ -669,8 +663,12 @@
;; If the last exact completion and this one were the same, it
;; means we've already given a "Complete, but not unique" message
;; and the user's hit TAB again, so now we give him help.
- ((eq this-command last-command)
- (if completion-auto-help (minibuffer-completion-help))))
+ (t
+ (if (and (eq this-command last-command) completion-auto-help)
+ (minibuffer-completion-help))
+ (completion--done completion 'exact
+ (unless expect-exact
+ "Complete, but not unique"))))
(minibuffer--bitset completed t exact))))))))
@@ -705,10 +703,6 @@
t)
(t (case (completion--do-completion)
(#b000 nil)
- (#b001 (completion--message "Sole completion")
- t)
- (#b011 (completion--message "Complete, but not unique")
- t)
(t t)))))
(defun completion--flush-all-sorted-completions (&rest _ignore)
@@ -742,10 +736,11 @@
;; 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))
- (length (member c2 hist)))))))
+ (when (minibufferp)
+ (let ((hist (symbol-value minibuffer-history-variable)))
+ (setq all (sort all (lambda (c1 c2)
+ (> (length (member c1 hist))
+ (length (member c2 hist))))))))
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
@@ -763,14 +758,21 @@
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
(let* ((start (field-beginning))
(end (field-end))
- (all (completion-all-sorted-completions)))
- (if (not (consp all))
+ (all (completion-all-sorted-completions))
+ (base (+ start (or (cdr (last all)) 0))))
+ (cond
+ ((not (consp all))
(completion--message
- (if all "No more completions" "No completions"))
+ (if all "No more completions" "No completions")))
+ ((not (consp (cdr all)))
+ (let ((mod (equal (car all) (buffer-substring-no-properties base end))))
+ (if mod (completion--replace base end (car all)))
+ (completion--done (buffer-substring-no-properties start (point))
+ 'finished (unless mod "Sole completion"))))
+ (t
(setq completion-cycling t)
- (goto-char end)
- (insert (car all))
- (delete-region (+ start (cdr (last all))) end)
+ (completion--replace base end (car all))
+ (completion--done (buffer-substring-no-properties start (point)) 'sole)
;; If completing file names, (car all) may be a directory, so we'd now
;; have a new set of possible completions and might want to reset
;; completion-all-sorted-completions to nil, but we prefer not to,
@@ -778,7 +780,7 @@
;; through the previous possible completions.
(let ((last (last all)))
(setcdr last (cons (car all) (cdr last)))
- (setq completion-all-sorted-completions (cdr all))))))
+ (setq completion-all-sorted-completions (cdr all)))))))
(defvar minibuffer-confirm-exit-commands
'(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word)
@@ -850,7 +852,7 @@
(t
;; Call do-completion, but ignore errors.
(case (condition-case nil
- (completion--do-completion)
+ (completion--do-completion nil 'expect-exact)
(error 1))
((#b001 #b011) (exit-minibuffer))
(#b111 (if (not minibuffer-completion-confirm)
@@ -954,10 +956,6 @@
(interactive)
(case (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
- (#b001 (completion--message "Sole completion")
- t)
- (#b011 (completion--message "Complete, but not unique")
- t)
(t t)))
(defface completions-annotations '((t :inherit italic))
@@ -1157,6 +1155,21 @@
(run-hooks 'completion-setup-hook)))
nil)
+(defvar completion-extra-properties nil
+ "Property list of extra properties of the current completion job.
+These include:
+`:annotation-function': Function to add annotations in the completions buffer.
+ The function takes a completion and should either return nil, or a string
+ that will be displayed next to the completion. The function can access the
+ completion data via `minibuffer-completion-table' and related variables.
+`:exit-function': Function to run after completion is performed.
+ The function takes at least 2 parameters (STRING and STATUS) where STRING
+ is the text to which the field was completed and STATUS indicates what
+ kind of operation happened: if text is now complete it's `finished', if text
+ cannot be further completed but completion is not finished, it's `sole', if
+ text is a valid completion but may be further completed, it's `exact', and
+ other STATUSes may be added in the future.")
+
(defvar completion-annotate-function
nil
;; Note: there's a lot of scope as for when to add annotations and
@@ -1173,6 +1186,27 @@
will be displayed next to the completion. The function can access the
completion table and predicates via `minibuffer-completion-table' and related
variables.")
+(make-obsolete-variable 'completion-annotate-function
+ 'completion-extra-properties "24.1")
+
+(defun completion--done (string &optional finished message)
+ (let* ((exit-fun (plist-get completion-extra-properties :exit-function))
+ (pre-msg (and exit-fun (current-message))))
+ (assert (memq finished '(exact sole finished unknown)))
+ ;; FIXME: exit-fun should receive `finished' as a parameter.
+ (when exit-fun
+ (when (eq finished 'unknown)
+ (setq finished
+ (if (eq (try-completion string
+ minibuffer-completion-table
+ minibuffer-completion-predicate)
+ t)
+ 'finished 'exact)))
+ (funcall exit-fun string finished))
+ (when (and message
+ ;; Don't output any message if the exit-fun already did so.
+ (equal pre-msg (and exit-fun (current-message))))
+ (completion--message message))))
(defun minibuffer-completion-help ()
"Display a list of possible completions of the current minibuffer contents."
@@ -1187,44 +1221,77 @@
minibuffer-completion-predicate
(- (point) (field-beginning)))))
(message nil)
- (if (and completions
- (or (consp (cdr completions))
- (not (equal (car completions) string))))
- (let* ((last (last completions))
- (base-size (cdr last))
- ;; If the *Completions* buffer is shown in a new
- ;; window, mark it as softly-dedicated, so bury-buffer in
- ;; minibuffer-hide-completions will know whether to
- ;; delete the window or not.
- (display-buffer-mark-dedicated 'soft))
- (with-output-to-temp-buffer "*Completions*"
- ;; Remove the base-size tail because `sort' requires a properly
- ;; nil-terminated list.
- (when last (setcdr last nil))
- (setq completions (sort completions 'string-lessp))
- (when completion-annotate-function
- (setq completions
- (mapcar (lambda (s)
- (let ((ann
- (funcall completion-annotate-function s)))
- (if ann (list s ann) s)))
- completions)))
- (with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
- (list (+ start base-size)
- ;; FIXME: We should pay attention to completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give us the
- ;; necessary information.
- end)))
- (display-completion-list completions)))
-
- ;; If there are no completions, or if the current input is already the
- ;; only possible completion, then hide (previous&stale) completions.
- (minibuffer-hide-completions)
- (ding)
- (minibuffer-message
- (if completions "Sole completion" "No completions")))
+ (if (or (null completions)
+ (and (not (consp (cdr completions)))
+ (equal (car completions) string)))
+ (progn
+ ;; If there are no completions, or if the current input is already
+ ;; the sole completion, then hide (previous&stale) completions.
+ (minibuffer-hide-completions)
+ (ding)
+ (minibuffer-message
+ (if completions "Sole completion" "No completions")))
+
+ (let* ((last (last completions))
+ (base-size (cdr last))
+ (prefix (unless (zerop base-size) (substring string 0 base-size)))
+ (global-af (or (plist-get completion-extra-properties
+ :annotation-function)
+ completion-annotate-function))
+ ;; If the *Completions* buffer is shown in a new
+ ;; window, mark it as softly-dedicated, so bury-buffer in
+ ;; minibuffer-hide-completions will know whether to
+ ;; delete the window or not.
+ (display-buffer-mark-dedicated 'soft))
+ (with-output-to-temp-buffer "*Completions*"
+ ;; Remove the base-size tail because `sort' requires a properly
+ ;; nil-terminated list.
+ (when last (setcdr last nil))
+ (setq completions (sort completions 'string-lessp))
+ (setq completions
+ (cond
+ (global-af
+ (mapcar (lambda (s)
+ (let ((ann (funcall global-af s)))
+ (if ann (list s ann) s)))
+ completions))
+ (t completions)))
+
+ (with-current-buffer standard-output
+ (set (make-local-variable 'completion-base-position)
+ (list (+ start base-size)
+ ;; FIXME: We should pay attention to completion
+ ;; boundaries here, but currently
+ ;; completion-all-completions does not give us the
+ ;; necessary information.
+ end))
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ (let ((ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties))
+ (lambda (start end choice)
+ (unless
+ (or (zerop (length prefix))
+ (equal prefix
+ (buffer-substring-no-properties
+ (max (point-min) (- start (length prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator here.
+ (completion--replace start end choice)
+ (let* ((minibuffer-completion-table ctable)
+ (minibuffer-completion-predicate cpred)
+ (completion-extra-properties cprops)
+ (result (concat prefix choice))
+ (bounds (completion-boundaries
+ result ctable cpred "")))
+ ;; If the completion introduces a new field, then
+ ;; completion is not finished.
+ (completion--done result
+ (if (eq (car bounds) (length result))
+ 'exact 'finished)))))))
+
+ (display-completion-list completions))))
nil))
(defun minibuffer-hide-completions ()
@@ -1364,9 +1431,9 @@
START and END delimit the entity to complete and should include point,
COLLECTION is the completion table to use to complete it, and
PROPS is a property list for additional information.
-Currently supported properties are:
- `:predicate' a predicate that completion candidates need to satisfy.
- `:annotation-function' the value to use for `completion-annotate-function'.")
+Currently supported properties are all the properties that can appear in
+`completion-extra-properties' plus:
+ `:predicate' a predicate that completion candidates need to
satisfy.")
(defvar completion--capf-misbehave-funs nil
"List of functions found on `completion-at-point-functions' that misbehave.")
@@ -1403,9 +1470,7 @@
(pcase res
(`(,_ . ,(and (pred functionp) f)) (funcall f))
(`(,hookfun . (,start ,end ,collection . ,plist))
- (let* ((completion-annotate-function
- (or (plist-get plist :annotation-function)
- completion-annotate-function))
+ (let* ((completion-extra-properties plist)
(completion-in-region-mode-predicate
(lambda ()
;; We're still in the same completion field.
@@ -1428,9 +1493,7 @@
(`(,hookfun . (,start ,end ,collection . ,plist))
(let* ((minibuffer-completion-table collection)
(minibuffer-completion-predicate (plist-get plist :predicate))
- (completion-annotate-function
- (or (plist-get plist :annotation-function)
- completion-annotate-function))
+ (completion-extra-properties plist)
(completion-in-region-mode-predicate
(lambda ()
;; We're still in the same completion field.
@@ -2029,7 +2092,7 @@
(defun completion-pcm--prepare-delim-re (delims)
(setq completion-pcm--delim-wild-regex (concat "[" delims "*]")))
-(defcustom completion-pcm-word-delimiters "-_./: "
+(defcustom completion-pcm-word-delimiters "-_./:| "
"A string of characters treated as word delimiters for completion.
Some arcane rules:
If `]' is in this string, it must come first.
=== modified file 'lisp/pcomplete.el'
--- a/lisp/pcomplete.el 2011-04-29 17:33:30 +0000
+++ b/lisp/pcomplete.el 2011-05-24 02:45:50 +0000
@@ -527,19 +527,19 @@
(funcall pcomplete-norm-func
(directory-file-name f))
pcomplete-seen)))))))
- (unless (zerop (length pcomplete-termination-string))
- ;; Add a space at the end of completion. Use a terminator-regexp
- ;; that never matches since the terminator cannot appear
- ;; within the completion field anyway.
- (setq table
- (apply-partially #'completion-table-with-terminator
- (cons pcomplete-termination-string
- "\\`a\\`")
- table)))
(when pcomplete-ignore-case
(setq table
(apply-partially #'completion-table-case-fold table)))
- (list beg (point) table :predicate pred))))))
+ (list beg (point) table
+ :predicate pred
+ :exit-function
+ (unless (zerop (length pcomplete-termination-string))
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at
+ (regexp-quote pcomplete-termination-string))
+ (goto-char (match-end 0))
+ (insert pcomplete-termination-string)))))))))))
;; I don't think such commands are usable before first setting up buffer-local
;; variables to parse args, so there's no point autoloading it.
=== modified file 'lisp/shell.el'
--- a/lisp/shell.el 2011-05-17 02:38:04 +0000
+++ b/lisp/shell.el 2011-05-24 02:45:50 +0000
@@ -1074,12 +1074,15 @@
(list
start end
(lambda (string pred action)
- (completion-table-with-terminator
- " " (lambda (string pred action)
- (if (string-match "/" string)
- (completion-file-name-table string pred action)
- (complete-with-action action completions string pred)))
- string pred action)))))
+ (if (string-match "/" string)
+ (completion-file-name-table string pred action)
+ (complete-with-action action completions string pred)))
+ :exit-function
+ (lambda (_string finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at " ")
+ (goto-char (match-end 0))
+ (insert " ")))))))
;; (defun shell-dynamic-complete-as-command ()
;; "Dynamically complete at point as a command.
@@ -1150,18 +1153,17 @@
(substring x 0 (string-match "=" x)))
process-environment))
(suffix (case (char-before start) (?\{ "}") (?\( ")") (t ""))))
- (list
- start end
- (apply-partially
- #'completion-table-with-terminator
- (cons (lambda (comp)
- (concat comp
- suffix
- (if (file-directory-p
- (comint-directory (getenv comp)))
- "/")))
- "\\`a\\`")
- variables))))))
+ (list start end variables
+ :exit-function
+ (lambda (s finished)
+ (when (memq finished '(sole finished))
+ (let ((suf (concat suffix
+ (if (file-directory-p
+ (comint-directory (getenv s)))
+ "/"))))
+ (if (looking-at (regexp-quote suf))
+ (goto-char (match-end 0))
+ (insert suf))))))))))
(defun shell-c-a-p-replace-by-expanded-directory ()
=== modified file 'lisp/simple.el'
--- a/lisp/simple.el 2011-05-12 12:55:10 +0000
+++ b/lisp/simple.el 2011-05-24 02:45:50 +0000
@@ -5968,6 +5968,12 @@
where the completion should be inserted and END (if non-nil) is the end
of the text to replace. If END is nil, point is used instead.")
+(defvar completion-list-insert-choice-function #'completion--replace
+ "Function to use to insert the text chosen in *Completions*.
+Called with 3 arguments (BEG END TEXT), it should replace the text
+between BEG and END with TEXT. Expected to be set buffer-locally
+in the *Completions* buffer.")
+
(defvar completion-base-size nil
"Number of chars before point not involved in completion.
This is a local variable in the completion list buffer.
@@ -6031,26 +6037,30 @@
;; In case this is run via the mouse, give temporary modes such as
;; isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
- (let (buffer base-size base-position choice)
- (with-current-buffer (window-buffer (posn-window (event-start event)))
- (setq buffer completion-reference-buffer)
- (setq base-size completion-base-size)
- (setq base-position completion-base-position)
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (let (beg end)
- (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
- (setq end (point) beg (1+ (point))))
- (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg (point)))
- (if (null beg)
- (error "No completion here"))
- (setq beg (previous-single-property-change beg 'mouse-face))
- (setq end (or (next-single-property-change end 'mouse-face)
- (point-max)))
- (setq choice (buffer-substring-no-properties beg end)))))
+ (with-current-buffer (window-buffer (posn-window (event-start event)))
+ (let ((buffer completion-reference-buffer)
+ (base-size completion-base-size)
+ (base-position completion-base-position)
+ (insert-function completion-list-insert-choice-function)
+ (choice
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let (beg end)
+ (cond
+ ((and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ ((and (not (bobp))
+ (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg (point)))
+ (t (error "No completion here")))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face)
+ (point-max)))
+ (buffer-substring-no-properties beg end))))
+ (owindow (selected-window)))
- (let ((owindow (selected-window)))
+ (unless (buffer-live-p buffer)
+ (error "Destination buffer is dead"))
(select-window (posn-window (event-start event)))
(if (and (one-window-p t 'selected-frame)
(window-dedicated-p (selected-window)))
@@ -6059,20 +6069,20 @@
(or (window-dedicated-p (selected-window))
(bury-buffer)))
(select-window
- (or (and (buffer-live-p buffer)
- (get-buffer-window buffer 0))
- owindow)))
+ (or (get-buffer-window buffer 0)
+ owindow))
- (choose-completion-string
- choice buffer
- (or base-position
- (when base-size
- ;; Someone's using old completion code that doesn't know
- ;; about base-position yet.
- (list (+ base-size (with-current-buffer buffer (field-beginning)))))
- ;; If all else fails, just guess.
- (with-current-buffer buffer
- (list (choose-completion-guess-base-position choice)))))))
+ (with-current-buffer buffer
+ (choose-completion-string
+ choice buffer
+ (or base-position
+ (when base-size
+ ;; Someone's using old completion code that doesn't know
+ ;; about base-position yet.
+ (list (+ base-size (field-beginning))))
+ ;; If all else fails, just guess.
+ (list (choose-completion-guess-base-position choice)))
+ insert-function)))))
;; Delete the longest partial match for STRING
;; that can be found before POINT.
@@ -6118,7 +6128,8 @@
If all functions in the list return nil, that means to use
the default method of inserting the completion in BUFFER.")
-(defun choose-completion-string (choice &optional buffer base-position)
+(defun choose-completion-string (choice &optional
+ buffer base-position insert-function)
"Switch to BUFFER and insert the completion choice CHOICE.
BASE-POSITION, says where to insert the completion."
@@ -6138,8 +6149,8 @@
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
(if (and mini-p
- (or (not (active-minibuffer-window))
- (not (equal buffer
+ (not (and (active-minibuffer-window)
+ (equal buffer
(window-buffer (active-minibuffer-window))))))
(error "Minibuffer is not active for completion")
;; Set buffer so buffer-local choose-completion-string-functions works.
@@ -6151,13 +6162,15 @@
;; and indeed unused. The last used to be `base-size', so we
;; keep it to try and avoid breaking old code.
choice buffer base-position nil)
+ ;; This remove-text-properties should be unnecessary since `choice'
+ ;; comes from buffer-substring-no-properties.
+ ;;(remove-text-properties 0 (lenth choice) '(mouse-face nil) choice)
;; Insert the completion into the buffer where it was requested.
- (delete-region (or (car base-position) (point))
- (or (cadr base-position) (point)))
- (insert choice)
- (remove-text-properties (- (point) (length choice)) (point)
- '(mouse-face nil))
- ;; Update point in the window that BUFFER is showing in.
+ (funcall (or insert-function completion-list-insert-choice-function)
+ (or (car base-position) (point))
+ (or (cadr base-position) (point))
+ choice)
+ ;; Update point in the window that BUFFER is showing in.
(let ((window (get-buffer-window buffer t)))
(set-window-point window (point)))
;; If completing for the minibuffer, exit it with this choice.
@@ -6223,10 +6236,13 @@
0 (or completion-base-size 0)))))))
(with-current-buffer standard-output
(let ((base-size completion-base-size) ;Read before killing localvars.
- (base-position completion-base-position))
+ (base-position completion-base-position)
+ (insert-fun completion-list-insert-choice-function))
(completion-list-mode)
(set (make-local-variable 'completion-base-size) base-size)
- (set (make-local-variable 'completion-base-position) base-position))
+ (set (make-local-variable 'completion-base-position) base-position)
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ insert-fun))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
(if base-dir (setq default-directory base-dir))
;; Maybe insert help string.
=== modified file 'lisp/textmodes/bibtex.el'
--- a/lisp/textmodes/bibtex.el 2011-05-03 14:03:48 +0000
+++ b/lisp/textmodes/bibtex.el 2011-05-24 02:45:50 +0000
@@ -1,4 +1,4 @@
-;;; bibtex.el --- BibTeX mode for GNU Emacs
+;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1992, 1994-1999, 2001-2011 Free Software Foundation, Inc.
@@ -204,7 +204,7 @@
(const entry-class)
(const t)))
(put 'bibtex-maintain-sorted-entries 'safe-local-variable
- '(lambda (a) (memq a '(nil t plain crossref entry-class))))
+ (lambda (a) (memq a '(nil t plain crossref entry-class))))
(defcustom bibtex-sort-entry-class
'(("String")
@@ -968,7 +968,7 @@
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?$ "$$ " st)
(modify-syntax-entry ?% "< " st)
- (modify-syntax-entry ?' "w " st)
+ (modify-syntax-entry ?' "w " st) ;FIXME: Not allowed in @string keys.
(modify-syntax-entry ?@ "w " st)
(modify-syntax-entry ?\\ "\\" st)
(modify-syntax-entry ?\f "> " st)
@@ -984,7 +984,7 @@
;; The Key `C-c&' is reserved for reftex.el
(define-key km "\t" 'bibtex-find-text)
(define-key km "\n" 'bibtex-next-field)
- (define-key km "\M-\t" 'bibtex-complete)
+ (define-key km "\M-\t" 'completion-at-point)
(define-key km "\C-c\"" 'bibtex-remove-delimiters)
(define-key km "\C-c{" 'bibtex-remove-delimiters)
(define-key km "\C-c}" 'bibtex-remove-delimiters)
@@ -2018,7 +2018,7 @@
;; remove delimiters from purely numerical fields
(when (and (memq 'numerical-fields format)
(progn (goto-char beg-text)
- (looking-at
"\\(\"[0-9]+\"\\)\\|\\({[0-9]+}\\)")))
+ (looking-at "\"[0-9]+\"\\|{[0-9]+}")))
(goto-char end-text)
(delete-char -1)
(goto-char beg-text)
@@ -2247,10 +2247,11 @@
(content (bibtex-text-in-field field bibtex-autokey-use-crossref))
case-fold-search)
(unless content (setq content ""))
- (dolist (pattern change-list content)
+ (dolist (pattern change-list)
(setq content (replace-regexp-in-string (car pattern)
(cdr pattern)
- content t)))))
+ content t)))
+ content))
(defun bibtex-autokey-get-names ()
"Get contents of the name field of the current entry.
@@ -2521,7 +2522,7 @@
(bibtex-sort-ignore-string-entries t)
bounds)
(bibtex-map-entries
- (lambda (key beg end)
+ (lambda (key _beg end)
(if (and abortable
(input-pending-p))
;; user has aborted by typing a key: return `aborted'
@@ -2714,20 +2715,6 @@
(message "No BibTeX buffers defined")))
buffer-list))
-(defun bibtex-complete-internal (completions)
- "Complete word fragment before point to longest prefix of COMPLETIONS.
-COMPLETIONS is an alist of strings. If point is not after the part
-of a word, all strings are listed. Return completion."
- ;; Return value is used by cleanup functions.
- ;; Code inspired by `lisp-complete-symbol'.
- (let ((beg (save-excursion
- (re-search-backward "[ \t{\"]")
- (forward-char)
- (point)))
- (end (point)))
- (when (completion-in-region beg end completions)
- (buffer-substring beg (point)))))
-
(defun bibtex-complete-string-cleanup (str compl)
"Cleanup after inserting string STR.
Remove enclosing field delimiters for STR. Display message with
@@ -2941,7 +2928,7 @@
;; Interactive Functions:
;;;###autoload
-(defun bibtex-mode ()
+(define-derived-mode bibtex-mode nil "BibTeX"
"Major mode for editing BibTeX files.
General information on working with BibTeX mode:
@@ -2953,7 +2940,7 @@
Some features of BibTeX mode are available only by setting the variable
`bibtex-maintain-sorted-entries' to non-nil. However, then BibTeX mode
-works only with buffers containing valid (syntactical correct) and sorted
+works only with buffers containing valid (syntactically correct) and sorted
entries. This is usually the case, if you have created a buffer completely
with BibTeX mode and finished every new entry with \\[bibtex-clean-entry].
@@ -2975,7 +2962,7 @@
\\[bibtex-remove-delimiters] removes the double-quotes or braces around the
text of the current field.
\\[bibtex-empty-field] replaces the text of the current field with the default
\"\" or {}.
\\[bibtex-find-text] moves point to the end of the current field.
-\\[bibtex-complete] completes word fragment before point according to context.
+\\[completion-at-point] completes word fragment before point according to
context.
The command \\[bibtex-clean-entry] cleans the current entry, i.e. it removes
OPT/ALT
from the names of all non-empty optional or alternative fields, checks that
@@ -2993,12 +2980,8 @@
if that value is non-nil.
\\{bibtex-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map bibtex-mode-map)
- (setq major-mode 'bibtex-mode)
- (setq mode-name "BibTeX")
- (set-syntax-table bibtex-mode-syntax-table)
+ (add-hook 'completion-at-point-functions
+ 'bibtex-completion-at-point-function nil 'local)
(make-local-variable 'bibtex-buffer-last-parsed-tick)
;; Install stealthy parse function if not already installed
(unless bibtex-parse-idle-timer
@@ -3013,9 +2996,8 @@
(set (make-local-variable 'defun-prompt-regexp) "^[
address@hidden:alnum:]]+[ \t]*")
(set (make-local-variable 'outline-regexp) "[ \t]*@")
(set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
- (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset
-
bibtex-contline-indentation)
- ?\s))
+ (set (make-local-variable 'fill-prefix)
+ (make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
(set (make-local-variable 'font-lock-defaults)
'(bibtex-font-lock-keywords
nil t ((?$ . "\"")
@@ -3037,11 +3019,9 @@
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)
- (make-local-variable 'choose-completion-string-functions)
;; XEmacs needs `easy-menu-add', Emacs does not care
(easy-menu-add bibtex-edit-menu)
- (easy-menu-add bibtex-entry-menu)
- (run-mode-hooks 'bibtex-mode-hook))
+ (easy-menu-add bibtex-entry-menu))
(defun bibtex-field-list (entry-type)
"Return list of allowed fields for entry ENTRY-TYPE.
@@ -3383,7 +3363,7 @@
(bibtex-sort-ignore-string-entries (not count-string-entries)))
(save-restriction
(if mark-active (narrow-to-region (region-beginning) (region-end)))
- (bibtex-map-entries (lambda (key beg end) (setq number (1+ number)))))
+ (bibtex-map-entries (lambda (_key _beg _end) (setq number (1+ number)))))
(message "%s contains %d entries."
(if mark-active "Region" "Buffer")
number)))
@@ -3438,12 +3418,13 @@
(unless (local-variable-p 'bibtex-sort-entry-class-alist)
(set (make-local-variable 'bibtex-sort-entry-class-alist)
(let ((i -1) alist)
- (dolist (class bibtex-sort-entry-class alist)
+ (dolist (class bibtex-sort-entry-class)
(setq i (1+ i))
(dolist (entry class)
;; All entry types should be downcase (for ease of comparison).
(push (cons (if (stringp entry) (downcase entry) entry) i)
- alist)))))))
+ alist)))
+ alist))))
(defun bibtex-lessp (index1 index2)
"Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
@@ -3735,7 +3716,7 @@
(let (previous current key-list)
(bibtex-progress-message "Checking for duplicate keys")
(bibtex-map-entries
- (lambda (key beg end)
+ (lambda (key _beg _end)
(bibtex-progress-message)
(setq current (bibtex-entry-index))
(cond ((not previous))
@@ -3773,7 +3754,7 @@
"Checking required fields and month fields")
(let ((bibtex-sort-ignore-string-entries t))
(bibtex-map-entries
- (lambda (key beg end)
+ (lambda (_key beg _end)
(bibtex-progress-message)
(let* ((entry-list (assoc-string (bibtex-type-in-head)
bibtex-entry-field-alist t))
@@ -4440,7 +4421,7 @@
(if (memq 'realign bibtex-entry-format)
(bibtex-realign))
(bibtex-progress-message "Formatting" 1)
- (bibtex-map-entries (lambda (key beg end)
+ (bibtex-map-entries (lambda (_key _beg _end)
(bibtex-progress-message)
(bibtex-clean-entry reformat-reference-keys t)))
(bibtex-progress-message 'done))
@@ -4473,17 +4454,15 @@
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
-(defun bibtex-complete ()
- "Complete word fragment before point according to context.
-If point is inside key or crossref field perform key completion based on
-`bibtex-reference-keys'. Inside a month field perform key completion
-based on `bibtex-predefined-month-strings'. Inside any other field
-\(including a String or Preamble definition) perform string completion
-based on `bibtex-strings'.
-An error is signaled if point is outside key or BibTeX field."
- (interactive)
+(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
+(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
+ (beg (save-excursion
+ (re-search-backward "[ \t{\"]")
+ (forward-char)
+ (point)))
+ (end (point))
bounds name compl)
(save-excursion
(if (and (setq bounds (bibtex-enclosing-field nil t))
@@ -4524,49 +4503,56 @@
(setq compl 'key)))))
(cond ((eq compl 'key)
- ;; key completion: no cleanup needed
- (setq choose-completion-string-functions nil)
- (let (completion-ignore-case)
- (bibtex-complete-internal (bibtex-global-key-alist))))
+ ;; Key completion: no cleanup needed.
+ (list beg end
+ (lambda (s p a)
+ (let (completion-ignore-case)
+ (complete-with-action a (bibtex-global-key-alist) s p)))))
((eq compl 'crossref-key)
- ;; crossref key completion
- ;;
- ;; If we quit the *Completions* buffer without requesting
- ;; a completion, `choose-completion-string-functions' is still
- ;; non-nil. Therefore, `choose-completion-string-functions' is
- ;; always set (either to non-nil or nil) when a new completion
- ;; is requested.
- (let (completion-ignore-case)
- (setq choose-completion-string-functions
- (lambda (choice buffer base-position &rest ignored)
- (setq choose-completion-string-functions nil)
- (choose-completion-string choice buffer base-position)
- (bibtex-complete-crossref-cleanup choice)
- t)) ; needed by choose-completion-string-functions
- (bibtex-complete-crossref-cleanup
- (bibtex-complete-internal (bibtex-global-key-alist)))))
+ ;; Crossref key completion.
+ (let* ((buf (current-buffer)))
+ (list beg end
+ (lambda (s p a)
+ (cond
+ ((eq a 'metadata) `(metadata (category . bibtex-key)))
+ (t (let ((completion-ignore-case nil))
+ (complete-with-action
+ a (bibtex-global-key-alist) s p)))))
+ :exit-function
+ (lambda (string status)
+ (when (memq status '(exact sole finished))
+ (let ((summary
+ (with-current-buffer buf
+ (save-excursion
+ (if (bibtex-search-entry string)
+ (funcall bibtex-summary-function))))))
+ (when summary
+ (message "%s %s" string summary))))))))
((eq compl 'string)
- ;; string key completion: no cleanup needed
- (setq choose-completion-string-functions nil)
- (let ((completion-ignore-case t))
- (bibtex-complete-internal bibtex-strings)))
+ ;; String key completion: no cleanup needed.
+ (list beg end
+ (lambda (s p a)
+ (let ((completion-ignore-case t))
+ (complete-with-action a bibtex-strings s p)))))
(compl
- ;; string completion
- (let ((completion-ignore-case t))
- (setq choose-completion-string-functions
- `(lambda (choice buffer base-position &rest ignored)
- (setq choose-completion-string-functions nil)
- (choose-completion-string choice buffer base-position)
- (bibtex-complete-string-cleanup choice ',compl)
- t)) ; needed by `choose-completion-string-functions'
- (bibtex-complete-string-cleanup (bibtex-complete-internal compl)
- compl)))
-
- (t (setq choose-completion-string-functions nil)
- (error "Point outside key or BibTeX field")))))
+ ;; String completion.
+ (list beg end
+ (lambda (s p a)
+ (cond
+ ((eq a 'metadata) `(metadata (category . bibtex-string)))
+ (t (let ((completion-ignore-case t))
+ (complete-with-action a compl s p)))))
+ :exit-function
+ (lambda (string status)
+ (when (memq status '(exact finished sole))
+ (let ((abbr (cdr (assoc-string string compl t))))
+ (when abbr
+ (message "%s = abbreviation for `%s'" string abbr))))
+ (when (eq status 'finished)
+ (save-excursion (bibtex-remove-delimiters)))))))))
(defun bibtex-Article ()
"Insert a new BibTeX @Article entry; see also `bibtex-entry'."
@@ -4772,5 +4758,4 @@
;; Make BibTeX a Feature
(provide 'bibtex)
-
;;; bibtex.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r104334: Add an :exit-function for completion-at-point.,
Stefan Monnier <=