mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Add yank-handled-properties; use it for font-lock-face' and category'

Browse source 
properties, instead of hard-coding these properties' special handling.

* lisp/simple.el (yank-handled-properties): New defcustom.
(yank-excluded-properties): Add font-lock-face and category.
(yank): Doc fix.

* lisp/subr.el (remove-yank-excluded-properties): Obey
yank-handled-properties.  The special handling of font-lock-face
and category is now done this way, instead of being hard-coded.
(insert-for-yank-1): Remove font-lock-face handling.
(yank-handle-font-lock-face-property)
(yank-handle-category-property): New function.
This commit is contained in:
Chong Yidong 2012-08-18 13:11:38 +08:00
parent 6a09a33b55
commit 2170b1bdd5
4 changed files with 112 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

4
etc/NEWS
View file

@ -160,6 +160,10 @@ The PCL-CVS commands are still available via the keyboard.
* Editing Changes in Emacs 24.3
** New option `yank-handled-properties' allows processing of text
properties on yanked text, in more ways that are more general than
just removing them, as done by `yank-excluded-properties'.
** New option `delete-trailing-lines' specifies whether the M-x
delete-trailing-whitespace command should delete trailing lines at the
end of the buffer. It defaults to t.

13
lisp/ChangeLog
View file

@ -1,3 +1,16 @@
2012-08-18 Chong Yidong <cyd@gnu.org>
* simple.el (yank-handled-properties): New defcustom.
(yank-excluded-properties): Add font-lock-face and category.
(yank): Doc fix.
* subr.el (remove-yank-excluded-properties): Obey
yank-handled-properties. The special handling of font-lock-face
and category is now done this way, instead of being hard-coded.
(insert-for-yank-1): Remove font-lock-face handling.
(yank-handle-font-lock-face-property)
(yank-handle-category-property): New function.
2012-08-17 Glenn Morris <rgm@gnu.org>
* mail/rmailout.el (rmail-output-read-file-name):

45
lisp/simple.el
View file

@ -3474,16 +3474,36 @@ The argument is used for internal purposes; do not supply one."
;; Yanking.
(defcustom yank-handled-properties
'((font-lock-face . yank-handle-font-lock-face-property)
(category . yank-handle-category-property))
"List of special text property handling conditions for yanking.
Each element should have the form (PROP . FUN), where PROP is a
property symbol and FUN is a function. When the `yank' command
inserts text into the buffer, it scans the inserted text for
stretches of text that have `eq' values of the text property
PROP; for each such stretch of text, FUN is called with three
arguments: the property's value in that text, and the start and
end positions of the text.
This is done prior to removing the properties specified by
`yank-excluded-properties'."
:group 'killing
:version "24.3")
;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
'(read-only invisible intangible field mouse-face help-echo local-map keymap
yank-handler follow-link fontified)
'(category field follow-link fontified font-lock-face help-echo
intangible invisible keymap local-map mouse-face read-only
yank-handler)
"Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
which means to discard all text properties."
which means to discard all text properties.
See also `yank-handled-properties'."
:type '(choice (const :tag "All" t) (repeat symbol))
:group 'killing
:version "22.1")
:version "24.3")
(defvar yank-window-start nil)
(defvar yank-undo-function nil
@ -3535,15 +3555,16 @@ doc string for `insert-for-yank-1', which see."
(defun yank (&optional arg)
"Reinsert (\"paste\") the last stretch of killed text.
More precisely, reinsert the stretch of killed text most recently
killed OR yanked. Put point at end, and set mark at beginning.
With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
With argument N, reinsert the Nth most recently killed stretch of killed
text.
More precisely, reinsert the most recent kill, which is the
stretch of killed text most recently killed OR yanked. Put point
at the end, and set mark at the beginning without activating it.
With just \\[universal-argument] as argument, put point at beginning, and mark at end.
With argument N, reinsert the Nth most recent kill.
When this command inserts killed text into the buffer, it honors
`yank-excluded-properties' and `yank-handler' as described in the
doc string for `insert-for-yank-1', which see.
When this command inserts text into the buffer, it honors the
`yank-handled-properties' and `yank-excluded-properties'
variables, and the `yank-handler' text property. See
`insert-for-yank-1' for details.
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")

129
lisp/subr.el
View file

@ -2805,35 +2805,24 @@ if it's an autoloaded macro."
;;;; Support for yanking and text properties.
(defvar yank-handled-properties)
(defvar yank-excluded-properties)
(defun remove-yank-excluded-properties (start end)
"Remove `yank-excluded-properties' between START and END positions.
Replaces `category' properties with their defined properties."
"Process text properties between START and END, inserted for a `yank'.
Perform the handling specified by `yank-handled-properties', then
remove properties specified by `yank-excluded-properties'."
(let ((inhibit-read-only t))
;; Replace any `category' property with the properties it stands
;; for. This is to remove `mouse-face' properties that are placed
;; on categories in *Help* buffers' buttons. See
;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
;; for the details.
(unless (memq yank-excluded-properties '(t nil))
(save-excursion
(goto-char start)
(while (< (point) end)
(let ((cat (get-text-property (point) 'category))
run-end)
(setq run-end
(next-single-property-change (point) 'category nil end))
(when cat
(let (run-end2 original)
(remove-list-of-text-properties (point) run-end '(category))
(while (< (point) run-end)
(setq run-end2 (next-property-change (point) nil run-end))
(setq original (text-properties-at (point)))
(set-text-properties (point) run-end2 (symbol-plist cat))
(add-text-properties (point) run-end2 original)
(goto-char run-end2))))
(goto-char run-end)))))
(dolist (handler yank-handled-properties)
(let ((prop (car handler))
(fun (cdr handler))
(run-start start))
(while (< run-start end)
(let ((value (get-text-property run-start prop))
(run-end (next-single-property-change
run-start prop nil end)))
(funcall fun value run-start run-end)
(setq run-start run-end)))))
(if (eq yank-excluded-properties t)
(set-text-properties start end nil)
(remove-list-of-text-properties start end yank-excluded-properties))))
@ -2851,29 +2840,31 @@ See `insert-for-yank-1' for more details."
(insert-for-yank-1 string))
(defun insert-for-yank-1 (string)
"Insert STRING at point, stripping some text properties.
"Insert STRING at point for the `yank' command.
This function is like `insert', except it honors the variables
`yank-handled-properties' and `yank-excluded-properties', and the
`yank-handler' text property.
Strip text properties from the inserted text according to
`yank-excluded-properties'. Otherwise just like (insert STRING).
Properties listed in `yank-handled-properties' are processed,
then those listed in `yank-excluded-properties' are discarded.
If STRING has a non-nil `yank-handler' property on the first character,
the normal insert behavior is modified in various ways. The value of
the yank-handler property must be a list with one to four elements
with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
When FUNCTION is present and non-nil, it is called instead of `insert'
to insert the string. FUNCTION takes one argument--the object to insert.
If PARAM is present and non-nil, it replaces STRING as the object
passed to FUNCTION (or `insert'); for example, if FUNCTION is
`yank-rectangle', PARAM may be a list of strings to insert as a
rectangle.
If NOEXCLUDE is present and non-nil, the normal removal of the
If STRING has a non-nil `yank-handler' property on its first
character, the normal insert behavior is altered. The value of
the `yank-handler' property must be a list of one to four
elements, of the form (FUNCTION PARAM NOEXCLUDE UNDO).
FUNCTION, if non-nil, should be a function of one argument, an
object to insert; it is called instead of `insert'.
PARAM, if present and non-nil, replaces STRING as the argument to
FUNCTION or `insert'; e.g. if FUNCTION is `yank-rectangle', PARAM
may be a list of strings to insert as a rectangle.
If NOEXCLUDE is present and non-nil, the normal removal of
`yank-excluded-properties' is not performed; instead FUNCTION is
responsible for removing those properties. This may be necessary
if FUNCTION adjusts point before or after inserting the object.
If UNDO is present and non-nil, it is a function that will be called
responsible for the removal. This may be necessary if FUNCTION
adjusts point before or after inserting the object.
UNDO, if present and non-nil, should be a function to be called
by `yank-pop' to undo the insertion of the current object. It is
called with two arguments, the start and end of the current region.
FUNCTION may set `yank-undo-function' to override the UNDO value."
given two arguments, the start and end of the region. FUNCTION
may set `yank-undo-function' to override UNDO."
(let* ((handler (and (stringp string)
(get-text-property 0 'yank-handler string)))
(param (or (nth 1 handler) string))
@ -2882,7 +2873,7 @@ If UNDO is present and non-nil, it is a function that will be called
end)
(setq yank-undo-function t)
(if (nth 0 handler) ;; FUNCTION
(if (nth 0 handler) ; FUNCTION
(funcall (car handler) param)
(insert param))
(setq end (point))
@ -2891,34 +2882,17 @@ If UNDO is present and non-nil, it is a function that will be called
;; following text property changes.
(setq inhibit-read-only t)
;; What should we do with `font-lock-face' properties?
(if font-lock-defaults
;; No, just wipe them.
(remove-list-of-text-properties opoint end '(font-lock-face))
;; Convert them to `face'.
(save-excursion
(goto-char opoint)
(while (< (point) end)
(let ((face (get-text-property (point) 'font-lock-face))
run-end)
(setq run-end
(next-single-property-change (point) 'font-lock-face nil end))
(when face
(remove-text-properties (point) run-end '(font-lock-face nil))
(put-text-property (point) run-end 'face face))
(goto-char run-end)))))
(unless (nth 2 handler) ;; NOEXCLUDE
(remove-yank-excluded-properties opoint (point)))
(unless (nth 2 handler) ; NOEXCLUDE
(remove-yank-excluded-properties opoint end))
;; If last inserted char has properties, mark them as rear-nonsticky.
(if (and (> end opoint)
(text-properties-at (1- end)))
(put-text-property (1- end) end 'rear-nonsticky t))
(if (eq yank-undo-function t) ;; not set by FUNCTION
(setq yank-undo-function (nth 3 handler))) ;; UNDO
(if (nth 4 handler) ;; COMMAND
(if (eq yank-undo-function t) ; not set by FUNCTION
(setq yank-undo-function (nth 3 handler))) ; UNDO
(if (nth 4 handler) ; COMMAND
(setq this-command (nth 4 handler)))))
(defun insert-buffer-substring-no-properties (buffer &optional start end)
@ -2944,6 +2918,27 @@ Strip text properties from the inserted text according to
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
(defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
START and END denote the start and end of the text to act on.
Do nothing if FACE is nil."
(and face
(null font-lock-defaults)
(put-text-property start end 'face face)))
;; This removes `mouse-face' properties in *Help* buffer buttons:
;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
(defun yank-handle-category-property (category start end)
"Apply property category CATEGORY's properties between START and END."
(when category
(let ((start2 start))
(while (< start2 end)
(let ((end2 (next-property-change start2 nil end))
(original (text-properties-at start2)))
(set-text-properties start2 end2 (symbol-plist category))
(add-text-properties start2 end2 original)
(setq start2 end2))))))
;;;; Synchronous shell commands.