procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

New hook filter-buffer-substring-functions.

Browse source 
* 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'.
This commit is contained in:
Stefan Monnier 2010-05-02 01:56:30 -04:00
parent 672eb71041
commit 8f92b8ad07
3 changed files with 78 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
etc/NEWS
View file

@ -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

5
lisp/ChangeLog
View file

@ -1,5 +1,10 @@
2010-05-02 Stefan Monnier <monnier@iro.umontreal.ca>
* 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...

146
lisp/simple.el
View file

@ -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.