diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2011-06-20 12:02:31 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2011-06-20 12:02:31 -0400 |
commit | bcd70d976f1035f84f55fa6969b9c0c419b7cc06 (patch) | |
tree | 50dc843ae8030ef911c788a795f3b14d689045a7 | |
parent | aebf69c8b3dc592ea315c187feb5f69b884a850e (diff) | |
download | emacs-bcd70d976f1035f84f55fa6969b9c0c419b7cc06.tar.gz |
Use completion-at-point rather than completion-in-region.
* lisp/wid-edit.el: Use lexical scoping and move towards completion-at-point.
(widget-complete): Use new :completion-function property.
(widget-completions-at-point): New function.
(default): Use :completion-function instead of :complete.
(widget-default-completions): Rename from widget-default-complete, rewrite.
(widget-string-complete, widget-file-complete, widget-color-complete):
Remove functions.
(file, symbol, function, variable, coding-system, color):
* lisp/international/mule-cmds.el (default-input-method, charset)
(language-info-custom-alist):
* lisp/cus-edit.el (face): Use new property :completions.
* lisp/progmodes/pascal.el (pascal-completions-at-point): New function.
(pascal-mode): Use it.
(pascal-mode-map): Use completion-at-point.
(pascal-toggle-completions): Make obsolete.
(pascal-complete-word, pascal-show-completions):
* lisp/progmodes/octave-mod.el (octave-complete-symbol):
Redefine as obsolete alias.
* lisp/progmodes/octave-inf.el (inferior-octave-completion-at-point):
Signal absence of completion info for old Octave,
(inferior-octave-complete): Redefine as obsolete alias.
* lisp/progmodes/meta-mode.el: Use lexical-binding and completion-at-point.
(meta-completions-at-point): Rename from meta-complete-symbol and
adapt it for use on completion-at-point-functions.
(meta-common-mode): Use it.
(meta-looking-at-backward, meta-match-buffer): Remove.
(meta-complete-symbol): Redefine as obsolete alias.
(meta-common-mode-map): Use completion-at-point.
* lisp/progmodes/make-mode.el: Use lexical-binding and completion-at-point.
(makefile-mode-map): Use completion-at-point.
(makefile-completions-at-point): Rename from makefile-complete and
adapt it for use on completion-at-point-functions.
(makefile-mode): Use it.
(makefile-complete): Redefine as obsolete alias.
-rw-r--r-- | lisp/ChangeLog | 62 | ||||
-rw-r--r-- | lisp/cus-edit.el | 5 | ||||
-rw-r--r-- | lisp/international/mule-cmds.el | 30 | ||||
-rw-r--r-- | lisp/mail/mailabbrev.el | 1 | ||||
-rw-r--r-- | lisp/progmodes/make-mode.el | 44 | ||||
-rw-r--r-- | lisp/progmodes/meta-mode.el | 52 | ||||
-rw-r--r-- | lisp/progmodes/octave-inf.el | 23 | ||||
-rw-r--r-- | lisp/progmodes/octave-mod.el | 8 | ||||
-rw-r--r-- | lisp/progmodes/pascal.el | 75 | ||||
-rw-r--r-- | lisp/wid-edit.el | 103 |
10 files changed, 186 insertions, 217 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a7176483152..957c751750b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,41 @@ +2011-06-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * wid-edit.el: Use lexical scoping and move towards completion-at-point. + (widget-complete): Use new :completion-function property. + (widget-completions-at-point): New function. + (default): Use :completion-function instead of :complete. + (widget-default-completions): Rename from widget-default-complete, rewrite. + (widget-string-complete, widget-file-complete, widget-color-complete): + Remove functions. + (file, symbol, function, variable, coding-system, color): + * international/mule-cmds.el (default-input-method, charset) + (language-info-custom-alist): + * cus-edit.el (face): Use new property :completions. + + * progmodes/pascal.el (pascal-completions-at-point): New function. + (pascal-mode): Use it. + (pascal-mode-map): Use completion-at-point. + (pascal-toggle-completions): Make obsolete. + (pascal-complete-word, pascal-show-completions): + * progmodes/octave-mod.el (octave-complete-symbol): + Redefine as obsolete alias. + * progmodes/octave-inf.el (inferior-octave-completion-at-point): + Signal absence of completion info for old Octave, + (inferior-octave-complete): Redefine as obsolete alias. + * progmodes/meta-mode.el: Use lexical-binding and completion-at-point. + (meta-completions-at-point): Rename from meta-complete-symbol and + adapt it for use on completion-at-point-functions. + (meta-common-mode): Use it. + (meta-looking-at-backward, meta-match-buffer): Remove. + (meta-complete-symbol): Redefine as obsolete alias. + (meta-common-mode-map): Use completion-at-point. + * progmodes/make-mode.el: Use lexical-binding and completion-at-point. + (makefile-mode-map): Use completion-at-point. + (makefile-completions-at-point): Rename from makefile-complete and + adapt it for use on completion-at-point-functions. + (makefile-mode): Use it. + (makefile-complete): Redefine as obsolete alias. + 2011-06-20 Deniz Dogan <deniz@dogan.se> * net/rcirc.el: Delete trailing whitespaces once and for all. @@ -31,8 +69,8 @@ display-buffer-normalize-options. (display-buffer-normalize-alist-1): New function. (display-buffer-normalize-specifiers-3): Rename to - display-buffer-normalize-alist. Call - display-buffer-normalize-alist-1. + display-buffer-normalize-alist. + Call display-buffer-normalize-alist-1. (display-buffer-normalize-options-inhibit): New variable. (display-buffer-normalize-specifiers): Rewrite calling display-buffer-normalize-alist, @@ -43,8 +81,8 @@ (window-deletable-p): Use frame-auto-delete. (window-list-no-nils, window-state-ignored-parameters) (window-state-get-1, window-state-get, window-state-put-list) - (window-state-put-1, window-state-put-2, window-state-put): New - functions. + (window-state-put-1, window-state-put-2, window-state-put): + New functions. (display-buffer-normalize-options): Move special-display-p group after pop-up-frame group (Bug#8851) and (Bug#8856). @@ -71,12 +109,12 @@ 2011-06-18 Martin Rudalics <rudalics@gmx.at> - * window.el (display-buffer-default-specifiers): Remove - pop-up-frame. Add pop-up-window-min-height, + * window.el (display-buffer-default-specifiers): + Remove pop-up-frame. Add pop-up-window-min-height, pop-up-window-min-width, and another reuse-window specifier (Bug#8882). Reported by Dan Nicolaescu <dann@gnu.org>. - (display-buffer-normalize-specifiers-2): Handle - split-height-threshold and split-width-threshold also when + (display-buffer-normalize-specifiers-2): + Handle split-height-threshold and split-width-threshold also when pop-up-windows is unset. Add a reuse-window specifier for the case popping up a new window fails. (special-display-popup-frame): Remove double quoting. @@ -112,8 +150,8 @@ (display-buffer-normalize-specifiers-2): Treat other-window case specially. (display-buffer-normalize-specifiers-3): New function. - (display-buffer-normalize-specifiers): Call - display-buffer-normalize-specifiers-3. + (display-buffer-normalize-specifiers): + Call display-buffer-normalize-specifiers-3. 2011-06-17 Martin Rudalics <rudalics@gmx.at> @@ -133,8 +171,8 @@ 2011-06-16 Martin Rudalics <rudalics@gmx.at> - * window.el (display-buffer-normalize-specifiers-1): Respect - current value of pop-up-frames for most reasonable values of + * window.el (display-buffer-normalize-specifiers-1): + Respect current value of pop-up-frames for most reasonable values of second argument of display-buffer (Bug#8865). (switch-to-buffer-same-frame, switch-to-buffer-other-window) (switch-to-buffer-other-window-same-frame) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index f14c055d7a8..7c96b526f41 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3830,9 +3830,8 @@ restoring it to the state of a face that has never been customized." :sample-face-get 'widget-face-sample-face-get :notify 'widget-face-notify :match (lambda (_widget value) (facep value)) - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'facep)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'facep 'strict) :prompt-match 'facep :prompt-history 'widget-face-prompt-value-history :validate (lambda (widget) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 5f4d3ea849e..b3f17bb3fcf 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1308,11 +1308,11 @@ This is the input method activated automatically by the command `toggle-input-method' (\\[toggle-input-method])." :link '(custom-manual "(emacs)Input Methods") :group 'mule - :type '(choice (const nil) (string - :completion-ignore-case t - :complete-function widget-string-complete - :completion-alist input-method-alist - :prompt-history input-method-history)) + :type '(choice (const nil) + (string + :completions (apply-partially + #'completion-table-case-fold input-method-alist) + :prompt-history input-method-history)) :set-after '(current-language-environment)) (put 'input-method-function 'permanent-local t) @@ -1875,10 +1875,10 @@ specifies the character set for the major languages of Western Europe." (define-widget 'charset 'symbol "An Emacs charset." :tag "Charset" - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'charsetp)) - :completion-ignore-case t + :completions (apply-partially #'completion-table-with-predicate + (apply-partially #'completion-table-case-fold + obarray) + #'charsetp 'strict) :value 'ascii :validate (lambda (widget) (unless (charsetp (widget-value widget)) @@ -1912,9 +1912,9 @@ See `set-language-info-alist' for use in programs." (set-language-environment current-language-environment))) :type `(alist :key-type (string :tag "Language environment" - :completion-ignore-case t - :complete-function widget-string-complete - :completion-alist language-info-alist) + :completions + (apply-partially #'completion-table-case-fold + language-info-alist)) :value-type (alist :key-type symbol :options ((documentation string) @@ -1927,9 +1927,9 @@ See `set-language-info-alist' for use in programs." (nonascii-translation charset) (input-method (string - :completion-ignore-case t - :complete-function widget-string-complete - :completion-alist input-method-alist + :completions + (apply-partially #'completion-table-case-fold + input-method-alist) :prompt-history input-method-history)) (features (repeat symbol)) (unibyte-display coding-system))))) diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index b4827cf10ba..901eb002dc1 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -565,7 +565,6 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (defun mail-abbrev-complete-alias () "Perform completion on alias preceding point." - ;; Based on lisp.el:lisp-complete-symbol (interactive) (mail-abbrev-make-syntax-table) (let ((end (point)) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 22e5d2f7c5c..293ba49d4ae 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1,4 +1,4 @@ -;;; make-mode.el --- makefile editing commands for Emacs +;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1994, 1999-2011 Free Software Foundation, Inc. @@ -602,7 +602,7 @@ The function must satisfy this calling convention: (define-key map "\C-c\C-m\C-p" 'makefile-makepp-mode) (define-key map "\M-p" 'makefile-previous-dependency) (define-key map "\M-n" 'makefile-next-dependency) - (define-key map "\e\t" 'makefile-complete) + (define-key map "\e\t" 'completion-at-point) ;; Make menus. (define-key map [menu-bar makefile-mode] @@ -653,7 +653,7 @@ The function must satisfy this calling convention: '(menu-item "Find Targets and Macros" makefile-pickup-everything :help "Notice names of all macros and targets in Makefile")) (define-key map [menu-bar makefile-mode complete] - '(menu-item "Complete Target or Macro" makefile-complete + '(menu-item "Complete Target or Macro" completion-at-point :help "Perform completion on Makefile construct preceding point")) (define-key map [menu-bar makefile-mode backslash] '(menu-item "Backslash Region" makefile-backslash-region @@ -852,6 +852,8 @@ Makefile mode can be configured by modifying the following variables: List of special targets. You will be offered to complete on one of those in the minibuffer whenever you enter a `.'. at the beginning of a line in Makefile mode." + (add-hook 'completion-at-point-functions + #'makefile-completions-at-point nil t) (add-hook 'write-file-functions 'makefile-warn-suspicious-lines nil t) (add-hook 'write-file-functions @@ -1147,11 +1149,7 @@ and adds all qualifying names to the list of known targets." ;;; Completion. -(defun makefile-complete () - "Perform completion on Makefile construct preceding point. -Can complete variable and target names. -The context determines which are considered." - (interactive) +(defun makefile-completions-at-point () (let* ((beg (save-excursion (skip-chars-backward "^$(){}:#= \t\n") (point))) @@ -1168,22 +1166,26 @@ The context determines which are considered." ;; Preceding "$(" or "${" means macros only. ((and (memq pc '(?\{ ?\()) (progn - (setq paren (if (eq paren ?\{) ?\} ?\))) + (setq paren (if (eq pc ?\{) ?\} ?\))) (backward-char) (= (preceding-char) ?$))) t))))) - - (table (apply-partially 'completion-table-with-terminator - (cond - (do-macros (or paren "")) - ((save-excursion (goto-char beg) (bolp)) ":") - (t " ")) - (append (if do-macros - '() - makefile-target-table) - makefile-macro-table)))) - (completion-in-region beg (point) table))) - + (suffix (cond + (do-macros (if paren (string paren))) + ((save-excursion (goto-char beg) (bolp)) ":") + (t " ")))) + (list beg (point) + (append (if do-macros '() makefile-target-table) + makefile-macro-table) + :exit-function + (if suffix + (lambda (_s finished) + (when (memq finished '(sole finished)) + (if (looking-at (regexp-quote suffix)) + (goto-char (match-end 0)) + (insert suffix)))))))) + +(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1") ;; Backslashification. Stolen from cc-mode.el. diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index b36104bf49b..ab640c0e270 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -1,4 +1,4 @@ -;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources +;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*- ;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc. @@ -471,16 +471,13 @@ If the list was changed, sort the list and remove duplicates first." (string-lessp (car a) (car b))) -(defun meta-complete-symbol () - "Perform completion on Metafont or MetaPost symbol preceding point." - ;; FIXME: Use completion-at-point-functions. - (interactive "*") +(defun meta-completions-at-point () (let ((list meta-complete-list) entry) (while list (setq entry (car list) list (cdr list)) - (if (meta-looking-at-backward (car entry) 200) + (if (looking-back (car entry) (max (point-min) (- (point) 200))) (setq list nil))) (if (numberp (nth 1 entry)) (let* ((sub (nth 1 entry)) @@ -488,31 +485,19 @@ If the list was changed, sort the list and remove duplicates first." (begin (match-beginning sub)) (end (match-end sub)) (list (funcall (nth 2 entry)))) - (completion-in-region - begin end - (if (zerop (length close)) list - (apply-partially 'completion-table-with-terminator - close list)))) - (funcall (nth 1 entry))))) - - -(defun meta-looking-at-backward (regexp &optional limit) - ;; utility function used in `meta-complete-symbol' - (let ((pos (point))) - (save-excursion - (and (re-search-backward - regexp (if limit (max (point-min) (- (point) limit))) t) - (eq (match-end 0) pos))))) - -(defun meta-match-buffer (n) - ;; utility function used in `meta-complete-symbol' - (if (match-beginning n) - (let ((str (buffer-substring (match-beginning n) (match-end n)))) - (set-text-properties 0 (length str) nil str) - (copy-sequence str)) - "")) - - + (list + begin end list + :exit-function + (unless (zerop (length close)) + (lambda (_s finished) + (when (memq finished '(sole finished)) + (if (looking-at (regexp-quote close)) + (goto-char (match-end 0)) + (insert close))))))) + (nth 1 entry)))) + +(define-obsolete-function-alias 'meta-complete-symbol + 'completion-at-point "24.1") ;;; Indentation. @@ -906,7 +891,7 @@ The environment marked is the one that contains point or follows point." (define-key map "\C-c;" 'meta-comment-region) (define-key map "\C-c:" 'meta-uncomment-region) ;; Symbol Completion: - (define-key map "\M-\t" 'meta-complete-symbol) + (define-key map "\M-\t" 'completion-at-point) ;; Shell Commands: ;; (define-key map "\C-c\C-c" 'meta-command-file) ;; (define-key map "\C-c\C-k" 'meta-kill-job) @@ -935,7 +920,7 @@ The environment marked is the one that contains point or follows point." ["Uncomment Region" meta-uncomment-region :active (meta-mark-active)] "--" - ["Complete Symbol" meta-complete-symbol t] + ["Complete Symbol" completion-at-point t] ; "--" ; ["Command on Buffer" meta-command-file t] ; ["Kill Job" meta-kill-job t] @@ -994,6 +979,7 @@ The environment marked is the one that contains point or follows point." (set (make-local-variable 'parse-sexp-ignore-comments) t) + (add-hook 'completion-at-point-functions #'meta-completions-at-point nil t) (set (make-local-variable 'comment-indent-function) #'meta-comment-indent) (set (make-local-variable 'indent-line-function) #'meta-indent-line) ;; No need to define a mode-specific 'indent-region-function. diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index 803a542563c..cb64b2436c6 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -267,8 +267,12 @@ startup file, `~/.emacs-octave'." (save-excursion (skip-syntax-backward "w_" (comint-line-beginning-position)) (point)))) - (cond (inferior-octave-complete-impossible nil) - ((eq start end) nil) + (cond ((eq start end) nil) + (inferior-octave-complete-impossible + (message (concat + "Your Octave does not have `completion_matches'. " + "Please upgrade to version 2.X.")) + nil) (t (list start end @@ -279,19 +283,8 @@ startup file, `~/.emacs-octave'." (sort (delete-dups inferior-octave-output-list) 'string-lessp)))))))) -(defun inferior-octave-complete () - "Perform completion on the Octave symbol preceding point. -This is implemented using the Octave command `completion_matches' which -is NOT available with versions of Octave prior to 2.0." - (interactive) - (if inferior-octave-complete-impossible - (error (concat - "Your Octave does not have `completion_matches'. " - "Please upgrade to version 2.X.")) - (let ((data (inferior-octave-completion-at-point))) - (if (null data) - (message "Cannot complete an empty string") - (apply #'completion-in-region data))))) +(define-obsolete-function-alias 'inferior-octave-complete + 'completion-at-point "24.1") (defun inferior-octave-dynamic-list-input-ring () "List the buffer's input history in a help buffer." diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 39d997e1d5e..183347cdeca 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -983,12 +983,8 @@ otherwise." (setq end (point)))) (list beg end octave-completion-alist))) -(defun octave-complete-symbol () - "Perform completion on Octave symbol preceding point. -Compare that symbol against Octave's reserved words and builtin -variables." - (interactive) - (apply 'completion-in-region (octave-completion-at-point-function))) +(define-obsolete-function-alias 'octave-complete-symbol + 'completion-at-point "24.1") ;;; Electric characters && friends diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index e28bb14bb9a..57ed13969b4 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -40,7 +40,6 @@ ;; pascal-tab-always-indent t ;; pascal-auto-endcomments t ;; pascal-auto-lineup '(all) -;; pascal-toggle-completions nil ;; pascal-type-keywords '("array" "file" "packed" "char" ;; "integer" "real" "string" "record") ;; pascal-start-keywords '("begin" "end" "function" "procedure" @@ -79,8 +78,8 @@ ;; These are user preferences, so not to set by default. ;;(define-key map "\r" 'electric-pascal-terminate-line) ;;(define-key map "\t" 'electric-pascal-tab) - (define-key map "\M-\t" 'pascal-complete-word) - (define-key map "\M-?" 'pascal-show-completions) + (define-key map "\M-\t" 'completion-at-point) + (define-key map "\M-?" 'completion-help-at-point) (define-key map "\177" 'backward-delete-char-untabify) (define-key map "\M-\C-h" 'pascal-mark-defun) (define-key map "\C-c\C-b" 'pascal-insert-block) @@ -232,13 +231,13 @@ will do all lineups." (const :tag "Case statements" case)) :group 'pascal) -(defcustom pascal-toggle-completions nil - "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one. -Repeated use of \\[pascal-complete-word] will show you all of them. +(defvar pascal-toggle-completions nil + "*Non-nil meant \\<pascal-mode-map>\\[pascal-complete-word] would try all possible completions one by one. +Repeated use of \\[pascal-complete-word] would show you all of them. Normally, when there is more than one possible completion, -it displays a list of all possible completions." - :type 'boolean - :group 'pascal) +it displays a list of all possible completions.") +(make-obsolete-variable 'pascal-toggle-completions + 'completion-cycle-threshold "24.1") (defcustom pascal-type-keywords '("array" "file" "packed" "char" "integer" "real" "string" "record") @@ -303,9 +302,9 @@ are handled in another way, and should not be added to this list." "Major mode for editing Pascal code. \\<pascal-mode-map> TAB indents for Pascal code. Delete converts tabs to spaces as it moves back. -\\[pascal-complete-word] completes the word around current point with respect \ +\\[completion-at-point] completes the word around current point with respect \ to position in code -\\[pascal-show-completions] shows all possible completions at this point. +\\[completion-help-at-point] shows all possible completions at this point. Other useful functions are: @@ -354,6 +353,7 @@ no args, if that value is non-nil." (set (make-local-variable 'comment-start) "{") (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *") (set (make-local-variable 'comment-end) "}") + (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t) ;; Font lock support (set (make-local-variable 'font-lock-defaults) '(pascal-font-lock-keywords nil t)) @@ -1287,54 +1287,17 @@ indent of the current line in parameterlist." (defvar pascal-last-word-shown nil) (defvar pascal-last-completions nil) -(defun pascal-complete-word () - "Complete word at current point. -\(See also `pascal-toggle-completions', `pascal-type-keywords', -`pascal-start-keywords' and `pascal-separator-keywords'.)" - (interactive) +(defun pascal-completions-at-point () (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))) + (when (> e b) + (list b e #'pascal-completion)))) - ;; Toggle-completions inserts whole labels - (if pascal-toggle-completions - (let* ((pascal-str (buffer-substring b e)) - (allcomp (if (and pascal-toggle-completions - (string= pascal-last-word-shown pascal-str)) - pascal-last-completions - (all-completions pascal-str 'pascal-completion)))) - ;; Update entry number in list - (setq pascal-last-completions allcomp - pascal-last-word-numb - (if (>= pascal-last-word-numb (1- (length allcomp))) - 0 - (1+ pascal-last-word-numb))) - (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb)) - ;; Display next match or same string if no match was found - (if allcomp - (progn - (goto-char e) - (insert-before-markers pascal-last-word-shown) - (delete-region b e)) - (message "(No match)"))) - ;; The other form of completion does not necessarily do that. - (completion-in-region b e 'pascal-completion)))) - -(defun pascal-show-completions () - "Show all possible completions at current point." - (interactive) - (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point))) - (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))) - (pascal-str (buffer-substring b e)) - (allcomp (if (and pascal-toggle-completions - (string= pascal-last-word-shown pascal-str)) - pascal-last-completions - (all-completions pascal-str 'pascal-completion)))) - ;; Show possible completions in a temporary buffer. - (with-output-to-temp-buffer "*Completions*" - (display-completion-list allcomp pascal-str)) - ;; Wait for a keypress. Then delete *Completion* window - (momentary-string-display "" (point)) - (delete-window (get-buffer-window (get-buffer "*Completions*"))))) +(define-obsolete-function-alias 'pascal-complete-word + 'completion-at-point "24.1") + +(define-obsolete-function-alias 'pascal-show-completions + 'completion-help-at-point "24.1") (defun pascal-get-default-symbol () diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 7b7813db94b..b0d00242f2a 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1,4 +1,4 @@ -;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*- +;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*- ;; ;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc. ;; @@ -1161,10 +1161,29 @@ the field." "Complete content of editable field from point. When not inside a field, signal an error." (interactive) + (let ((data (widget-completions-at-point))) + (cond + ((functionp data) (funcall data)) + ((consp data) + (let ((completion-extra-properties (nth 3 data))) + (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) + (plist-get completion-extra-properties + :predicate)))) + ((widget-field-find (point)) + ;; This defaulting used to be performed in widget-default-complete, but + ;; it seems more appropriate here than in widget-default-completions. + (call-interactively 'widget-complete-field)) + (t + (error "Not in an editable field"))))) +;; We may want to use widget completion in buffers where the major mode +;; hasn't added widget-completions-at-point to completion-at-point-functions, +;; so it's not really obsolete (yet). +;; (make-obsolete 'widget-complete 'completion-at-point "24.1") + +(defun widget-completions-at-point () (let ((field (widget-field-find (point)))) - (if field - (widget-apply field :complete) - (error "Not in an editable field")))) + (when field + (widget-apply field :completions-function)))) ;;; Setting up the buffer. @@ -1435,7 +1454,7 @@ The value of the :type attribute should be an unconverted widget type." :value-to-external (lambda (_widget value) value) :button-prefix 'widget-button-prefix :button-suffix 'widget-button-suffix - :complete 'widget-default-complete + :completions-function #'widget-default-completions :create 'widget-default-create :indent nil :offset 0 @@ -1461,13 +1480,20 @@ The value of the :type attribute should be an unconverted widget type." (defvar widget--completing-widget) -(defun widget-default-complete (widget) - "Call the value of the :complete-function property of WIDGET. -If that does not exist, call the value of `widget-complete-field'. -During this call, `widget--completing-widget' is bound to WIDGET." - (let ((widget--completing-widget widget)) - (call-interactively (or (widget-get widget :complete-function) - widget-complete-field)))) +(defun widget-default-completions (widget) + "Return completion data, like `completion-at-point-functions' would." + (let ((completions (widget-get widget :completions))) + (if completions + (list (widget-field-start widget) + (max (point) (widget-field-text-end widget)) + completions) + (if (widget-get widget :complete) + (lambda () (widget-apply widget :complete)) + (if (widget-get widget :complete-function) + (lambda () + (let ((widget--completing-widget widget)) + (call-interactively + (widget-get widget :complete-function))))))))) (defun widget-default-create (widget) "Create WIDGET at point in the current buffer." @@ -3018,20 +3044,6 @@ as the value." :complete-function 'ispell-complete-word :prompt-history 'widget-string-prompt-value-history) -(defun widget-string-complete () - "Complete contents of string field. -Completions are taken from the :completion-alist property of the -widget. If that isn't a list, it's evalled and expected to yield a list." - (interactive) - (let* ((widget widget--completing-widget) - (completion-ignore-case (widget-get widget :completion-ignore-case)) - (alist (widget-get widget :completion-alist)) - (_ (unless (listp alist) - (setq alist (eval alist))))) - (completion-in-region (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - alist))) - (define-widget 'regexp 'string "A regular expression." :match 'widget-regexp-match @@ -3059,21 +3071,13 @@ widget. If that isn't a list, it's evalled and expected to yield a list." (define-widget 'file 'string "A file widget. It reads a file name from an editable text field." - :complete-function 'widget-file-complete + :completions #'completion-file-name-table :prompt-value 'widget-file-prompt-value :format "%{%t%}: %v" ;; Doesn't work well with terminating newline. ;; :value-face 'widget-single-line-field :tag "File") -(defun widget-file-complete () - "Perform completion on file name preceding point." - (interactive) - (let ((widget widget--completing-widget)) - (completion-in-region (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - 'completion-file-name-table))) - (defun widget-file-prompt-value (widget prompt value unbound) ;; Read file from minibuffer. (abbreviate-file-name @@ -3113,7 +3117,7 @@ It reads a directory name from an editable text field." :tag "Symbol" :format "%{%t%}: %v" :match (lambda (_widget value) (symbolp value)) - :complete-function 'lisp-complete-symbol + :completions obarray :prompt-internal 'widget-symbol-prompt-internal :prompt-match 'symbolp :prompt-history 'widget-symbol-prompt-value-history @@ -3141,9 +3145,8 @@ It reads a directory name from an editable text field." (define-widget 'function 'restricted-sexp "A Lisp function." - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'fboundp)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'fboundp 'strict) :prompt-value 'widget-field-prompt-value :prompt-internal 'widget-symbol-prompt-internal :prompt-match 'fboundp @@ -3165,9 +3168,8 @@ It reads a directory name from an editable text field." "A Lisp variable." :prompt-match 'boundp :prompt-history 'widget-variable-prompt-value-history - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'boundp)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'boundp 'strict) :tag "Variable") (define-widget 'coding-system 'symbol @@ -3178,9 +3180,8 @@ It reads a directory name from an editable text field." :prompt-history 'coding-system-value-history :prompt-value 'widget-coding-system-prompt-value :action 'widget-coding-system-action - :complete-function (lambda () - (interactive) - (lisp-complete-symbol 'coding-system-p)) + :completions (apply-partially #'completion-table-with-predicate + obarray #'coding-system-p 'strict) :validate (lambda (widget) (unless (coding-system-p (widget-value widget)) (widget-put widget :error (format "Invalid coding system: %S" @@ -3317,7 +3318,7 @@ It reads a directory name from an editable text field." (insert (widget-apply widget :value-get)) (goto-char (point-min)) (let (err) - (condition-case data + (condition-case data ;Note: We get a spurious byte-compile warning here. (progn ;; Avoid a confusing end-of-file error. (skip-syntax-forward "\\s-") @@ -3685,7 +3686,7 @@ example: :size 10 :tag "Color" :value "black" - :complete 'widget-color-complete + :completions (or facemenu-color-alist (defined-colors)) :sample-face-get 'widget-color-sample-face-get :notify 'widget-color-notify :action 'widget-color-action) @@ -3711,14 +3712,6 @@ example: (delete-window win))) (pop-to-buffer ,(current-buffer)))))) -(defun widget-color-complete (widget) - "Complete the color in WIDGET." - (require 'facemenu) ; for facemenu-color-alist - (completion-in-region (widget-field-start widget) - (max (point) (widget-field-text-end widget)) - (or facemenu-color-alist - (sort (defined-colors) 'string-lessp)))) - (defun widget-color-sample-face-get (widget) (let* ((value (condition-case nil (widget-value widget) |