aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2009-11-19 03:12:51 +0000
committerStefan Monnier2009-11-19 03:12:51 +0000
commita185548b1cd687da0f31c0556c003e7a544b35d7 (patch)
treeac50feb064aef7c1dd14729fc9980e797473f51a
parent87e32266f0fc8467bc8280c9b73b7c5ab9d5f951 (diff)
downloademacs-a185548b1cd687da0f31c0556c003e7a544b35d7.tar.gz
emacs-a185548b1cd687da0f31c0556c003e7a544b35d7.zip
* abbrev.el (abbrev-with-wrapper-hook): (re)move...
* simple.el (with-wrapper-hook): ...to here. Add argument `args'. * minibuffer.el (completion-in-region-functions): New hook. (completion-in-region): New function. * emacs-lisp/lisp.el (lisp-complete-symbol): * pcomplete.el (pcomplete-std-complete): Use it.
-rw-r--r--etc/NEWS3
-rw-r--r--lisp/abbrev.el39
-rw-r--r--lisp/emacs-lisp/lisp.el12
-rw-r--r--lisp/minibuffer.el31
-rw-r--r--lisp/pcomplete.el28
-rw-r--r--lisp/simple.el47
6 files changed, 93 insertions, 67 deletions
diff --git a/etc/NEWS b/etc/NEWS
index aad0d2a3375..ebc4f516608 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -299,6 +299,9 @@ the variable `byte-compile-compatibility') has been removed.
299 299
300* Lisp changes in Emacs 23.2 300* Lisp changes in Emacs 23.2
301 301
302** New function `completion-in-region' to use the standard completion
303facilities on a particular region of text.
304
302** The 4th arg to all-completions (aka hide-spaces) is declared obsolete. 305** The 4th arg to all-completions (aka hide-spaces) is declared obsolete.
303 306
304** read-file-name-predicate is obsolete. It was used to pass the predicate 307** read-file-name-predicate is obsolete. It was used to pass the predicate
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index f45f4c1860c..88c87dafa77 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -392,43 +392,6 @@ See `define-abbrev' for the effect of some special properties.
392 392
393\(fn ABBREV PROP VAL)") 393\(fn ABBREV PROP VAL)")
394 394
395(defmacro abbrev-with-wrapper-hook (var &rest body)
396 "Run BODY wrapped with the VAR hook.
397VAR is a special hook: its functions are called with one argument which
398is the \"original\" code (the BODY), so the hook function can wrap the
399original function, can call it several times, or even not call it at all.
400VAR is normally a symbol (a variable) in which case it is treated like a hook,
401with a buffer-local and a global part. But it can also be an arbitrary expression.
402This is similar to an `around' advice."
403 (declare (indent 1) (debug t))
404 ;; We need those two gensyms because CL's lexical scoping is not available
405 ;; for function arguments :-(
406 (let ((funs (make-symbol "funs"))
407 (global (make-symbol "global")))
408 ;; Since the hook is a wrapper, the loop has to be done via
409 ;; recursion: a given hook function will call its parameter in order to
410 ;; continue looping.
411 `(labels ((runrestofhook (,funs ,global)
412 ;; `funs' holds the functions left on the hook and `global'
413 ;; holds the functions left on the global part of the hook
414 ;; (in case the hook is local).
415 (lexical-let ((funs ,funs)
416 (global ,global))
417 (if (consp funs)
418 (if (eq t (car funs))
419 (runrestofhook (append global (cdr funs)) nil)
420 (funcall (car funs)
421 (lambda () (runrestofhook (cdr funs) global))))
422 ;; Once there are no more functions on the hook, run
423 ;; the original body.
424 ,@body))))
425 (runrestofhook ,var
426 ;; The global part of the hook, if any.
427 ,(if (symbolp var)
428 `(if (local-variable-p ',var)
429 (default-value ',var)))))))
430
431
432;;; Code that used to be implemented in src/abbrev.c 395;;; Code that used to be implemented in src/abbrev.c
433 396
434(defvar abbrev-table-name-list '(fundamental-mode-abbrev-table 397(defvar abbrev-table-name-list '(fundamental-mode-abbrev-table
@@ -799,7 +762,7 @@ Effective when explicitly called even when `abbrev-mode' is nil.
799Returns the abbrev symbol, if expansion took place." 762Returns the abbrev symbol, if expansion took place."
800 (interactive) 763 (interactive)
801 (run-hooks 'pre-abbrev-expand-hook) 764 (run-hooks 'pre-abbrev-expand-hook)
802 (abbrev-with-wrapper-hook abbrev-expand-functions 765 (with-wrapper-hook abbrev-expand-functions ()
803 (destructuring-bind (&optional sym name wordstart wordend) 766 (destructuring-bind (&optional sym name wordstart wordend)
804 (abbrev--before-point) 767 (abbrev--before-point)
805 (when sym 768 (when sym
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 9b48c497eba..0edd6556dbf 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -647,17 +647,11 @@ considered."
647 ;; Maybe a `let' varlist or something. 647 ;; Maybe a `let' varlist or something.
648 nil 648 nil
649 ;; Else, we assume that a function name is expected. 649 ;; Else, we assume that a function name is expected.
650 'fboundp))))) 650 'fboundp))))))
651 (ol (make-overlay beg end nil nil t)))
652 (overlay-put ol 'field 'completion)
653 (let ((completion-annotate-function 651 (let ((completion-annotate-function
654 (unless (eq predicate 'fboundp) 652 (unless (eq predicate 'fboundp)
655 (lambda (str) (if (fboundp (intern-soft str)) " <f>")))) 653 (lambda (str) (if (fboundp (intern-soft str)) " <f>")))))
656 (minibuffer-completion-table obarray) 654 (completion-in-region beg end obarray predicate))))
657 (minibuffer-completion-predicate predicate))
658 (unwind-protect
659 (call-interactively 'minibuffer-complete)
660 (delete-overlay ol)))))
661 655
662;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e 656;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
663;;; lisp.el ends here 657;;; lisp.el ends here
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 40d36500525..223817ddc75 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1022,10 +1022,33 @@ variables.")
1022 (ding)) 1022 (ding))
1023 (exit-minibuffer)) 1023 (exit-minibuffer))
1024 1024
1025;;; Key bindings. 1025(defvar completion-in-region-functions nil
1026 1026 "Wrapper hook around `complete-in-region'.
1027(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map 1027The functions on this special hook are called with 5 arguments:
1028 'minibuffer-local-filename-must-match-map "23.1") 1028 NEXT-FUN START END COLLECTION PREDICATE.
1029NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE)
1030that performs the default operation. The other four argument are like
1031the ones passed to `complete-in-region'. The functions on this hook
1032are expected to perform completion on START..END using COLLECTION
1033and PREDICATE, either by calling NEXT-FUN or by doing it themselves.")
1034
1035(defun completion-in-region (start end collection &optional predicate)
1036 "Complete the text between START and END using COLLECTION.
1037Point needs to be somewhere between START and END."
1038 ;; FIXME: some callers need to setup completion-ignore-case,
1039 ;; completion-ignored-extensions. The latter can be embedded in the
1040 ;; completion tables, but the first cannot (actually, maybe it should).
1041 (assert (<= start (point)) (<= (point) end))
1042 ;; FIXME: undisplay the *Completions* buffer once the completion is done.
1043 (with-wrapper-hook
1044 completion-in-region-functions (start end collection predicate)
1045 (let ((minibuffer-completion-table collection)
1046 (minibuffer-completion-predicate predicate)
1047 (ol (make-overlay start end nil nil t)))
1048 (overlay-put ol 'field 'completion)
1049 (unwind-protect
1050 (call-interactively 'minibuffer-complete)
1051 (delete-overlay ol)))))
1029 1052
1030(let ((map minibuffer-local-map)) 1053(let ((map minibuffer-local-map))
1031 (define-key map "\C-g" 'abort-recursive-edit) 1054 (define-key map "\C-g" 'abort-recursive-edit)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 65b48f49fa9..387aa106a43 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -513,22 +513,18 @@ Same as `pcomplete' but using the standard completion UI."
513 (directory-file-name f)) 513 (directory-file-name f))
514 pcomplete-seen)))))) 514 pcomplete-seen))))))
515 515
516 (let ((ol (make-overlay beg (point) nil nil t)) 516 (completion-in-region
517 (minibuffer-completion-table 517 beg (point)
518 ;; Add a space at the end of completion. Use a terminator-regexp 518 ;; Add a space at the end of completion. Use a terminator-regexp
519 ;; that never matches since the terminator cannot appear 519 ;; that never matches since the terminator cannot appear
520 ;; within the completion field anyway. 520 ;; within the completion field anyway.
521 (if (zerop (length pcomplete-termination-string)) 521 (if (zerop (length pcomplete-termination-string))
522 table 522 table
523 (apply-partially 'completion-table-with-terminator 523 (apply-partially 'completion-table-with-terminator
524 (cons pcomplete-termination-string 524 (cons pcomplete-termination-string
525 "\\`a\\`") 525 "\\`a\\`")
526 table))) 526 table))
527 (minibuffer-completion-predicate pred)) 527 pred))))
528 (overlay-put ol 'field 'pcomplete)
529 (unwind-protect
530 (call-interactively 'minibuffer-complete)
531 (delete-overlay ol))))))
532 528
533;;; Pcomplete's native UI. 529;;; Pcomplete's native UI.
534 530
diff --git a/lisp/simple.el b/lisp/simple.el
index 60d47e733cd..87e65eebce8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6479,6 +6479,7 @@ saving the value of `buffer-invisibility-spec' and setting it to nil."
6479 (setq buffer-invisibility-spec nil))) 6479 (setq buffer-invisibility-spec nil)))
6480 6480
6481;; Partial application of functions (similar to "currying"). 6481;; Partial application of functions (similar to "currying").
6482;; This function is here rather than in subr.el because it uses CL.
6482(defun apply-partially (fun &rest args) 6483(defun apply-partially (fun &rest args)
6483 "Return a function that is a partial application of FUN to ARGS. 6484 "Return a function that is a partial application of FUN to ARGS.
6484ARGS is a list of the first N arguments to pass to FUN. 6485ARGS is a list of the first N arguments to pass to FUN.
@@ -6487,6 +6488,52 @@ the first N arguments are fixed at the values with which this function
6487was called." 6488was called."
6488 (lexical-let ((fun fun) (args1 args)) 6489 (lexical-let ((fun fun) (args1 args))
6489 (lambda (&rest args2) (apply fun (append args1 args2))))) 6490 (lambda (&rest args2) (apply fun (append args1 args2)))))
6491
6492;; This function is here rather than in subr.el because it uses CL.
6493(defmacro with-wrapper-hook (var args &rest body)
6494 "Run BODY wrapped with the VAR hook.
6495VAR is a special hook: its functions are called with a first argument
6496which is the \"original\" code (the BODY), so the hook function can wrap
6497the original function, or call it any number of times (including not calling
6498it at all). This is similar to an `around' advice.
6499VAR is normally a symbol (a variable) in which case it is treated like
6500a hook, with a buffer-local and a global part. But it can also be an
6501arbitrary expression.
6502ARGS is a list of variables which will be passed as additional arguments
6503to each function, after the inital argument, and which the first argument
6504expects to receive when called."
6505 (declare (indent 2) (debug t))
6506 ;; We need those two gensyms because CL's lexical scoping is not available
6507 ;; for function arguments :-(
6508 (let ((funs (make-symbol "funs"))
6509 (global (make-symbol "global"))
6510 (argssym (make-symbol "args")))
6511 ;; Since the hook is a wrapper, the loop has to be done via
6512 ;; recursion: a given hook function will call its parameter in order to
6513 ;; continue looping.
6514 `(labels ((runrestofhook (,funs ,global ,argssym)
6515 ;; `funs' holds the functions left on the hook and `global'
6516 ;; holds the functions left on the global part of the hook
6517 ;; (in case the hook is local).
6518 (lexical-let ((funs ,funs)
6519 (global ,global))
6520 (if (consp funs)
6521 (if (eq t (car funs))
6522 (apply 'runrestofhook
6523 (append global (cdr funs)) nil ,argssym)
6524 (apply (car funs)
6525 (lambda (&rest args)
6526 (runrestofhook (cdr funs) global args))
6527 ,argssym))
6528 ;; Once there are no more functions on the hook, run
6529 ;; the original body.
6530 (apply (lambda ,args ,@body) ,argssym)))))
6531 (runrestofhook ,var
6532 ;; The global part of the hook, if any.
6533 ,(if (symbolp var)
6534 `(if (local-variable-p ',var)
6535 (default-value ',var)))
6536 (list ,@args)))))
6490 6537
6491;; Minibuffer prompt stuff. 6538;; Minibuffer prompt stuff.
6492 6539