From: Stefan Monnier Date: Sun, 2 May 2010 05:56:30 +0000 (-0400) Subject: New hook filter-buffer-substring-functions. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~308 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8f92b8ad07a0af0d0fe7784feaa56cf1ff5b16f9;p=emacs.git 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'. --- 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. * Lisp changes in Emacs 24.1 +** buffer-substring-filters is obsoleted by filter-buffer-substring-functions. + ** New completion style `substring'. ** Image API diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 86b73ddd292..a7414aa2586 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2010-05-02 Stefan Monnier + * 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'. + Use a mode-line spec rather than a static string in Semantic. * cedet/semantic/util-modes.el: (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]." (reset-this-command-lengths) (restore-overriding-map)) +;; This function is here rather than in subr.el because it uses CL. +(defmacro with-wrapper-hook (var args &rest body) + "Run BODY wrapped with the VAR hook. +VAR is a special hook: its functions are called with a first argument +which is the \"original\" code (the BODY), so the hook function can wrap +the original function, or call it any number of times (including not calling +it at all). This is similar to an `around' advice. +VAR is normally a symbol (a variable) in which case it is treated like +a hook, with a buffer-local and a global part. But it can also be an +arbitrary expression. +ARGS is a list of variables which will be passed as additional arguments +to each function, after the initial argument, and which the first argument +expects to receive when called." + (declare (indent 2) (debug t)) + ;; We need those two gensyms because CL's lexical scoping is not available + ;; for function arguments :-( + (let ((funs (make-symbol "funs")) + (global (make-symbol "global")) + (argssym (make-symbol "args"))) + ;; Since the hook is a wrapper, the loop has to be done via + ;; recursion: a given hook function will call its parameter in order to + ;; continue looping. + `(labels ((runrestofhook (,funs ,global ,argssym) + ;; `funs' holds the functions left on the hook and `global' + ;; holds the functions left on the global part of the hook + ;; (in case the hook is local). + (lexical-let ((funs ,funs) + (global ,global)) + (if (consp funs) + (if (eq t (car funs)) + (runrestofhook + (append global (cdr funs)) nil ,argssym) + (apply (car funs) + (lambda (&rest ,argssym) + (runrestofhook (cdr funs) global ,argssym)) + ,argssym)) + ;; Once there are no more functions on the hook, run + ;; the original body. + (apply (lambda ,args ,@body) ,argssym))))) + (runrestofhook ,var + ;; The global part of the hook, if any. + ,(if (symbolp var) + `(if (local-variable-p ',var) + (default-value ',var))) + (list ,@args))))) + +(defvar filter-buffer-substring-functions nil + "Wrapper hook around `filter-buffer-substring'. +The functions on this special hook are called with 4 arguments: + NEXT-FUN BEG END DELETE +NEXT-FUN is a function of 3 arguments (BEG END DELETE) +that performs the default operation. The other 3 arguments are like +the ones passed to `filter-buffer-substring'.") + (defvar buffer-substring-filters nil "List of filter functions for `filter-buffer-substring'. Each 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 return value of `filter-buffer-substring'. If this variable is nil, no filtering is performed.") +(make-obsolete-variable 'buffer-substring-filters + 'filter-buffer-substring-functions "24.1") -(defun filter-buffer-substring (beg end &optional delete noprops) +(defun filter-buffer-substring (beg end &optional delete) "Return the buffer substring between BEG and END, after filtering. -The buffer substring is passed through each of the filter -functions in `buffer-substring-filters', and the value from the -last filter function is returned. If `buffer-substring-filters' -is nil, the buffer substring is returned unaltered. +The filtering is performed by `filter-buffer-substring-functions'. If DELETE is non-nil, the text between BEG and END is deleted from the buffer. -If NOPROPS is non-nil, final string returned does not include -text properties, while the string passed to the filters still -includes text properties from the buffer text. - -Point is temporarily set to BEG before calling -`buffer-substring-filters', in case the functions need to know -where the text came from. - This function should be used instead of `buffer-substring', `buffer-substring-no-properties', or `delete-and-extract-region' when you want to allow filtering to take place. For example, -major or minor modes can use `buffer-substring-filters' to +major or minor modes can use `filter-buffer-substring-functions' to extract characters that are special to a buffer, and should not be copied into other buffers." - (cond - ((or delete buffer-substring-filters) - (save-excursion - (goto-char beg) - (let ((string (if delete (delete-and-extract-region beg end) - (buffer-substring beg end)))) - (dolist (filter buffer-substring-filters) - (setq string (funcall filter string))) - (if noprops - (set-text-properties 0 (length string) nil string)) - string))) - (noprops - (buffer-substring-no-properties beg end)) - (t - (buffer-substring beg end)))) + (with-wrapper-hook filter-buffer-substring-functions (beg end delete) + (cond + ((or delete buffer-substring-filters) + (save-excursion + (goto-char beg) + (let ((string (if delete (delete-and-extract-region beg end) + (buffer-substring beg end)))) + (dolist (filter buffer-substring-filters) + (setq string (funcall filter string))) + string))) + (t + (buffer-substring beg end))))) ;;;; Window system cut and paste hooks. @@ -6505,52 +6547,6 @@ the first N arguments are fixed at the values with which this function was called." (lexical-let ((fun fun) (args1 args)) (lambda (&rest args2) (apply fun (append args1 args2))))) - -;; This function is here rather than in subr.el because it uses CL. -(defmacro with-wrapper-hook (var args &rest body) - "Run BODY wrapped with the VAR hook. -VAR is a special hook: its functions are called with a first argument -which is the \"original\" code (the BODY), so the hook function can wrap -the original function, or call it any number of times (including not calling -it at all). This is similar to an `around' advice. -VAR is normally a symbol (a variable) in which case it is treated like -a hook, with a buffer-local and a global part. But it can also be an -arbitrary expression. -ARGS is a list of variables which will be passed as additional arguments -to each function, after the initial argument, and which the first argument -expects to receive when called." - (declare (indent 2) (debug t)) - ;; We need those two gensyms because CL's lexical scoping is not available - ;; for function arguments :-( - (let ((funs (make-symbol "funs")) - (global (make-symbol "global")) - (argssym (make-symbol "args"))) - ;; Since the hook is a wrapper, the loop has to be done via - ;; recursion: a given hook function will call its parameter in order to - ;; continue looping. - `(labels ((runrestofhook (,funs ,global ,argssym) - ;; `funs' holds the functions left on the hook and `global' - ;; holds the functions left on the global part of the hook - ;; (in case the hook is local). - (lexical-let ((funs ,funs) - (global ,global)) - (if (consp funs) - (if (eq t (car funs)) - (runrestofhook - (append global (cdr funs)) nil ,argssym) - (apply (car funs) - (lambda (&rest ,argssym) - (runrestofhook (cdr funs) global ,argssym)) - ,argssym)) - ;; Once there are no more functions on the hook, run - ;; the original body. - (apply (lambda ,args ,@body) ,argssym))))) - (runrestofhook ,var - ;; The global part of the hook, if any. - ,(if (symbolp var) - `(if (local-variable-p ',var) - (default-value ',var))) - (list ,@args))))) ;; Minibuffer prompt stuff.