From a2a25d24350857dda87e28d6b2695cccc41bb32e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 23 May 2011 23:45:50 -0300 Subject: [PATCH] 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. --- etc/NEWS | 29 ++++-- lisp/ChangeLog | 37 +++++++ lisp/comint.el | 27 ++--- lisp/minibuffer.el | 257 +++++++++++++++++++++++++++++------------------ lisp/pcomplete.el | 20 ++-- lisp/shell.el | 38 +++---- lisp/simple.el | 106 ++++++++++--------- lisp/textmodes/bibtex.el | 165 ++++++++++++++---------------- 8 files changed, 399 insertions(+), 280 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 98a66259db0..64313480efb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -68,9 +68,6 @@ and also when HOME is set to C:\ by default. * 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 @@ client frame in parent X window ID, via XEmbed. This works like the *** 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. +** 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. -** `completing-read' can be customized using the new variable +*** 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 @@ sc.el, x-menu.el, rnews.el, rnewspost.el * 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 @@ argument is supplied (see Trash changes, above). ** 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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cb00357c23e..ce0f3e8733b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,40 @@ +2011-05-24 Stefan Monnier + + 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 * .el: Don't quote lambda expressions with `quote'. diff --git a/lisp/comint.el b/lisp/comint.el index 8608c0d31e9..e4bc530f361 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3134,19 +3134,20 @@ in the same way as TABLE completes strings of the form (concat S2 S)." #'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. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 41399f3f141..f3d92b18722 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -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: -;; - (?) style completion for file names. -;; This can't be done identically just by tweaking completion, -;; because partial-completion-mode's behavior is to expand -;; 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 @@ candidates than this number." (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 @@ E = after completion we now have an Exact match. 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 @@ E = after completion we now have an Exact match. (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 @@ E = after completion we now have an Exact match. ;; 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 @@ E = after completion we now have an Exact match. ;; 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 @@ E = after completion we now have an Exact match. ;; 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 @@ scroll the window of possible completions." 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 @@ scroll the window of possible completions." ;; 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 @@ Repeated uses step through the possible completions." ;; ~/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 @@ Repeated uses step through the possible completions." ;; 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 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', (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 @@ Return nil if there is no valid completion, else t." (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 @@ the completions buffer." (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 @@ 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 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 @@ variables.") 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 @@ or a list of the form (START END COLLECTION &rest PROPS) where 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 @@ The completion method is determined by `completion-at-point-functions'." (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 @@ The completion method is determined by `completion-at-point-functions'." (`(,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 @@ from lowercase to uppercase characters).") (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. diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 2f5dcdfb5e8..932436df8c9 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -527,19 +527,19 @@ Same as `pcomplete' but using the standard completion UI." (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. diff --git a/lisp/shell.el b/lisp/shell.el index cba50038bc0..53455944ee6 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1074,12 +1074,15 @@ Returns t if successful." (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 @@ Returns non-nil if successful." (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 () diff --git a/lisp/simple.el b/lisp/simple.el index ac53ce3add1..4cf38178357 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5968,6 +5968,12 @@ Its value is a list of the form (START END) where START is the place 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 @@ With prefix argument N, move N items (negative N means move backward)." ;; 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))))) - - (let ((owindow (selected-window))) + (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))) + + (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 @@ With prefix argument N, move N items (negative N means move backward)." (or (window-dedicated-p (selected-window)) (bury-buffer))) (select-window - (or (and (buffer-live-p buffer) - (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))))))) + (or (get-buffer-window buffer 0) + owindow)) + + (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 @@ the minibuffer; no further functions will be called. 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 @@ BASE-POSITION, says where to insert the completion." ;; 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 @@ BASE-POSITION, says where to insert the completion." ;; 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 @@ Called from `temp-buffer-show-hook'." 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. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index e49d7549776..9d05728ffad 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -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 @@ See also `bibtex-sort-ignore-string-entries'." (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 @@ Set this variable before loading BibTeX mode." (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 @@ Set this variable before loading BibTeX mode." ;; 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 @@ Formats current entry according to variable `bibtex-entry-format'." ;; 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 @@ applied to the content of FIELD. It is an alist with pairs (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 @@ for parsing BibTeX keys. If parsing fails, try to set this variable to nil." (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 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses (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 @@ BOUND limits the search." ;; 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 @@ new entry with the command \\[bibtex-clean-entry]. 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 @@ the name of a field with \\[bibtex-remove-OPT-or-ALT]. \\[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 @@ Entry to BibTeX mode calls the value of `bibtex-mode-hook' 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 @@ if that value is non-nil. (set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[: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 @@ if that value is non-nil. (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 @@ If mark is active count entries in region, if not in whole buffer." (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 @@ of the head of the entry found. Return nil if no entry found." (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 @@ Return t if test was successful, nil otherwise." (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 @@ Return t if test was successful, nil otherwise." "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 mark is active reformat entries in region, if not in whole buffer." (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 @@ entries from minibuffer." (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 @@ An error is signaled if point is outside key or BibTeX field." (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 @@ Return the URL or nil if none can be generated." ;; Make BibTeX a Feature (provide 'bibtex) - ;;; bibtex.el ends here -- 2.11.4.GIT