From 2170b1bdd500484349deec2d946119e6a653e198 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 18 Aug 2012 13:11:38 +0800 Subject: [PATCH] Add yank-handled-properties; use it for `font-lock-face' and `category' 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. --- etc/NEWS | 4 ++ lisp/ChangeLog | 13 +++++ lisp/simple.el | 47 ++++++++++++----- lisp/subr.el | 133 ++++++++++++++++++++++++------------------------- 4 files changed, 115 insertions(+), 82 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index a6f6822ab48..fa8a9bd30d0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 84a8ec18507..ec89b3784d9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2012-08-18 Chong Yidong + + * 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 * mail/rmailout.el (rmail-output-read-file-name): diff --git a/lisp/simple.el b/lisp/simple.el index 76243a202bc..1080757f7d2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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. - -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. +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 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") diff --git a/lisp/subr.el b/lisp/subr.el index 1e367a155d0..74afd59f8d5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -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. - -Strip text properties from the inserted text according to -`yank-excluded-properties'. Otherwise just like (insert STRING). - -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 + "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. + +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 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. -- 2.39.5