From bcd70d976f1035f84f55fa6969b9c0c419b7cc06 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 20 Jun 2011 12:02:31 -0400 Subject: [PATCH] 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. --- lisp/ChangeLog | 62 +++++++++++++++---- lisp/cus-edit.el | 5 +- lisp/international/mule-cmds.el | 30 +++++----- lisp/mail/mailabbrev.el | 1 - lisp/progmodes/make-mode.el | 44 +++++++------- lisp/progmodes/meta-mode.el | 52 ++++++---------- lisp/progmodes/octave-inf.el | 23 +++---- lisp/progmodes/octave-mod.el | 8 +-- lisp/progmodes/pascal.el | 75 ++++++----------------- lisp/wid-edit.el | 103 +++++++++++++++----------------- 10 files changed, 186 insertions(+), 217 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a717648315..957c751750 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,41 @@ +2011-06-20 Stefan Monnier + + * 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 * 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 - * 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 . - (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 @@ -133,8 +171,8 @@ 2011-06-16 Martin Rudalics - * 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 f14c055d7a..7c96b526f4 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 5f4d3ea849..b3f17bb3fc 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 b4827cf10b..901eb002dc 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 22e5d2f7c5..293ba49d4a 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 b36104bf49..ab640c0e27 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 803a542563..cb64b2436c 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 39d997e1d5..183347cdec 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 e28bb14bb9..57ed13969b 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-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-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. \\ 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 7b7813db94..b0d00242f2 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) -- 2.20.1