aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2010-05-02 01:56:30 -0400
committerStefan Monnier2010-05-02 01:56:30 -0400
commit8f92b8ad07a0af0d0fe7784feaa56cf1ff5b16f9 (patch)
treed1b60d77f176d041484308c6a2b159246034f39b
parent672eb71041ab30c82e9c17dfc8dfd7dec96f6169 (diff)
downloademacs-8f92b8ad07a0af0d0fe7784feaa56cf1ff5b16f9.tar.gz
emacs-8f92b8ad07a0af0d0fe7784feaa56cf1ff5b16f9.zip
New hook filter-buffer-substring-functions.
* simple.el (with-wrapper-hook): Move. (buffer-substring-filters): Mark obsolete. (filter-buffer-substring-functions): New variable. (buffer-substring-filters): Use it. Remove unused arg `noprops'.
-rw-r--r--etc/NEWS2
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/simple.el146
3 files changed, 78 insertions, 75 deletions
diff --git a/etc/NEWS b/etc/NEWS
index e4288684818..6fa940143bb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -181,6 +181,8 @@ Secret Service API requires D-Bus for communication.
181 181
182* Lisp changes in Emacs 24.1 182* Lisp changes in Emacs 24.1
183 183
184** buffer-substring-filters is obsoleted by filter-buffer-substring-functions.
185
184** New completion style `substring'. 186** New completion style `substring'.
185 187
186** Image API 188** Image API
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 86b73ddd292..a7414aa2586 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
12010-05-02 Stefan Monnier <monnier@iro.umontreal.ca> 12010-05-02 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * simple.el (with-wrapper-hook): Move.
4 (buffer-substring-filters): Mark obsolete.
5 (filter-buffer-substring-functions): New variable.
6 (buffer-substring-filters): Use it. Remove unused arg `noprops'.
7
3 Use a mode-line spec rather than a static string in Semantic. 8 Use a mode-line spec rather than a static string in Semantic.
4 * cedet/semantic/util-modes.el: 9 * cedet/semantic/util-modes.el:
5 (semantic-minor-modes-format): New var to replace... 10 (semantic-minor-modes-format): New var to replace...
diff --git a/lisp/simple.el b/lisp/simple.el
index cc70409ccd4..37ad0d81ca0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2688,6 +2688,60 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
2688 (reset-this-command-lengths) 2688 (reset-this-command-lengths)
2689 (restore-overriding-map)) 2689 (restore-overriding-map))
2690 2690
2691;; This function is here rather than in subr.el because it uses CL.
2692(defmacro with-wrapper-hook (var args &rest body)
2693 "Run BODY wrapped with the VAR hook.
2694VAR is a special hook: its functions are called with a first argument
2695which is the \"original\" code (the BODY), so the hook function can wrap
2696the original function, or call it any number of times (including not calling
2697it at all). This is similar to an `around' advice.
2698VAR is normally a symbol (a variable) in which case it is treated like
2699a hook, with a buffer-local and a global part. But it can also be an
2700arbitrary expression.
2701ARGS is a list of variables which will be passed as additional arguments
2702to each function, after the initial argument, and which the first argument
2703expects to receive when called."
2704 (declare (indent 2) (debug t))
2705 ;; We need those two gensyms because CL's lexical scoping is not available
2706 ;; for function arguments :-(
2707 (let ((funs (make-symbol "funs"))
2708 (global (make-symbol "global"))
2709 (argssym (make-symbol "args")))
2710 ;; Since the hook is a wrapper, the loop has to be done via
2711 ;; recursion: a given hook function will call its parameter in order to
2712 ;; continue looping.
2713 `(labels ((runrestofhook (,funs ,global ,argssym)
2714 ;; `funs' holds the functions left on the hook and `global'
2715 ;; holds the functions left on the global part of the hook
2716 ;; (in case the hook is local).
2717 (lexical-let ((funs ,funs)
2718 (global ,global))
2719 (if (consp funs)
2720 (if (eq t (car funs))
2721 (runrestofhook
2722 (append global (cdr funs)) nil ,argssym)
2723 (apply (car funs)
2724 (lambda (&rest ,argssym)
2725 (runrestofhook (cdr funs) global ,argssym))
2726 ,argssym))
2727 ;; Once there are no more functions on the hook, run
2728 ;; the original body.
2729 (apply (lambda ,args ,@body) ,argssym)))))
2730 (runrestofhook ,var
2731 ;; The global part of the hook, if any.
2732 ,(if (symbolp var)
2733 `(if (local-variable-p ',var)
2734 (default-value ',var)))
2735 (list ,@args)))))
2736
2737(defvar filter-buffer-substring-functions nil
2738 "Wrapper hook around `filter-buffer-substring'.
2739The functions on this special hook are called with 4 arguments:
2740 NEXT-FUN BEG END DELETE
2741NEXT-FUN is a function of 3 arguments (BEG END DELETE)
2742that performs the default operation. The other 3 arguments are like
2743the ones passed to `filter-buffer-substring'.")
2744
2691(defvar buffer-substring-filters nil 2745(defvar buffer-substring-filters nil
2692 "List of filter functions for `filter-buffer-substring'. 2746 "List of filter functions for `filter-buffer-substring'.
2693Each function must accept a single argument, a string, and return 2747Each function must accept a single argument, a string, and return
@@ -2697,46 +2751,34 @@ the next. The return value of the last function is used as the
2697return value of `filter-buffer-substring'. 2751return value of `filter-buffer-substring'.
2698 2752
2699If this variable is nil, no filtering is performed.") 2753If this variable is nil, no filtering is performed.")
2754(make-obsolete-variable 'buffer-substring-filters
2755 'filter-buffer-substring-functions "24.1")
2700 2756
2701(defun filter-buffer-substring (beg end &optional delete noprops) 2757(defun filter-buffer-substring (beg end &optional delete)
2702 "Return the buffer substring between BEG and END, after filtering. 2758 "Return the buffer substring between BEG and END, after filtering.
2703The buffer substring is passed through each of the filter 2759The filtering is performed by `filter-buffer-substring-functions'.
2704functions in `buffer-substring-filters', and the value from the
2705last filter function is returned. If `buffer-substring-filters'
2706is nil, the buffer substring is returned unaltered.
2707 2760
2708If DELETE is non-nil, the text between BEG and END is deleted 2761If DELETE is non-nil, the text between BEG and END is deleted
2709from the buffer. 2762from the buffer.
2710 2763
2711If NOPROPS is non-nil, final string returned does not include
2712text properties, while the string passed to the filters still
2713includes text properties from the buffer text.
2714
2715Point is temporarily set to BEG before calling
2716`buffer-substring-filters', in case the functions need to know
2717where the text came from.
2718
2719This function should be used instead of `buffer-substring', 2764This function should be used instead of `buffer-substring',
2720`buffer-substring-no-properties', or `delete-and-extract-region' 2765`buffer-substring-no-properties', or `delete-and-extract-region'
2721when you want to allow filtering to take place. For example, 2766when you want to allow filtering to take place. For example,
2722major or minor modes can use `buffer-substring-filters' to 2767major or minor modes can use `filter-buffer-substring-functions' to
2723extract characters that are special to a buffer, and should not 2768extract characters that are special to a buffer, and should not
2724be copied into other buffers." 2769be copied into other buffers."
2725 (cond 2770 (with-wrapper-hook filter-buffer-substring-functions (beg end delete)
2726 ((or delete buffer-substring-filters) 2771 (cond
2727 (save-excursion 2772 ((or delete buffer-substring-filters)
2728 (goto-char beg) 2773 (save-excursion
2729 (let ((string (if delete (delete-and-extract-region beg end) 2774 (goto-char beg)
2730 (buffer-substring beg end)))) 2775 (let ((string (if delete (delete-and-extract-region beg end)
2731 (dolist (filter buffer-substring-filters) 2776 (buffer-substring beg end))))
2732 (setq string (funcall filter string))) 2777 (dolist (filter buffer-substring-filters)
2733 (if noprops 2778 (setq string (funcall filter string)))
2734 (set-text-properties 0 (length string) nil string)) 2779 string)))
2735 string))) 2780 (t
2736 (noprops 2781 (buffer-substring beg end)))))
2737 (buffer-substring-no-properties beg end))
2738 (t
2739 (buffer-substring beg end))))
2740 2782
2741 2783
2742;;;; Window system cut and paste hooks. 2784;;;; Window system cut and paste hooks.
@@ -6505,52 +6547,6 @@ the first N arguments are fixed at the values with which this function
6505was called." 6547was called."
6506 (lexical-let ((fun fun) (args1 args)) 6548 (lexical-let ((fun fun) (args1 args))
6507 (lambda (&rest args2) (apply fun (append args1 args2))))) 6549 (lambda (&rest args2) (apply fun (append args1 args2)))))
6508
6509;; This function is here rather than in subr.el because it uses CL.
6510(defmacro with-wrapper-hook (var args &rest body)
6511 "Run BODY wrapped with the VAR hook.
6512VAR is a special hook: its functions are called with a first argument
6513which is the \"original\" code (the BODY), so the hook function can wrap
6514the original function, or call it any number of times (including not calling
6515it at all). This is similar to an `around' advice.
6516VAR is normally a symbol (a variable) in which case it is treated like
6517a hook, with a buffer-local and a global part. But it can also be an
6518arbitrary expression.
6519ARGS is a list of variables which will be passed as additional arguments
6520to each function, after the initial argument, and which the first argument
6521expects to receive when called."
6522 (declare (indent 2) (debug t))
6523 ;; We need those two gensyms because CL's lexical scoping is not available
6524 ;; for function arguments :-(
6525 (let ((funs (make-symbol "funs"))
6526 (global (make-symbol "global"))
6527 (argssym (make-symbol "args")))
6528 ;; Since the hook is a wrapper, the loop has to be done via
6529 ;; recursion: a given hook function will call its parameter in order to
6530 ;; continue looping.
6531 `(labels ((runrestofhook (,funs ,global ,argssym)
6532 ;; `funs' holds the functions left on the hook and `global'
6533 ;; holds the functions left on the global part of the hook
6534 ;; (in case the hook is local).
6535 (lexical-let ((funs ,funs)
6536 (global ,global))
6537 (if (consp funs)
6538 (if (eq t (car funs))
6539 (runrestofhook
6540 (append global (cdr funs)) nil ,argssym)
6541 (apply (car funs)
6542 (lambda (&rest ,argssym)
6543 (runrestofhook (cdr funs) global ,argssym))
6544 ,argssym))
6545 ;; Once there are no more functions on the hook, run
6546 ;; the original body.
6547 (apply (lambda ,args ,@body) ,argssym)))))
6548 (runrestofhook ,var
6549 ;; The global part of the hook, if any.
6550 ,(if (symbolp var)
6551 `(if (local-variable-p ',var)
6552 (default-value ',var)))
6553 (list ,@args)))))
6554 6550
6555;; Minibuffer prompt stuff. 6551;; Minibuffer prompt stuff.
6556 6552