aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKim F. Storm2002-04-29 21:06:51 +0000
committerKim F. Storm2002-04-29 21:06:51 +0000
commit8ed59ad5707cdec33064f749565811ec1b076bf9 (patch)
tree97ff05847e96d8ee07a7083c091a63c6c33fdb8b
parent66e0fd2b95803e4005f5a0de0e2ec17102447eee (diff)
downloademacs-8ed59ad5707cdec33064f749565811ec1b076bf9.tar.gz
emacs-8ed59ad5707cdec33064f749565811ec1b076bf9.zip
(remove-yank-excluded-properties): New helper function.
(insert-for-yank, insert-buffer-substring-as-yank): Use it.
-rw-r--r--lisp/subr.el58
1 files changed, 27 insertions, 31 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index 12c8272782c..02efa92cfa7 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1276,39 +1276,39 @@ for the sake of consistency."
1276 1276
1277(defvar yank-excluded-properties) 1277(defvar yank-excluded-properties)
1278 1278
1279(defun remove-yank-excluded-properties (start end)
1280 "Remove `yank-excluded-properties' between START and END positions.
1281Replaces `category' properties with their defined properties."
1282 (let ((inhibit-read-only t))
1283 ;; Replace any `category' property with the properties it stands for.
1284 (unless (memq yank-excluded-properties '(t nil))
1285 (save-excursion
1286 (goto-char start)
1287 (while (< (point) end)
1288 (let ((cat (get-text-property (point) 'category))
1289 run-end)
1290 (when cat
1291 (setq run-end
1292 (next-single-property-change (point) 'category nil end))
1293 (remove-list-of-text-properties (point) run-end '(category))
1294 (add-text-properties (point) run-end (symbol-plist cat))
1295 (goto-char (or run-end end)))
1296 (setq run-end
1297 (next-single-property-change (point) 'category nil end))
1298 (goto-char (or run-end end))))))
1299 (if (eq yank-excluded-properties t)
1300 (set-text-properties start end nil)
1301 (remove-list-of-text-properties start end
1302 yank-excluded-properties))))
1303
1279(defun insert-for-yank (&rest strings) 1304(defun insert-for-yank (&rest strings)
1280 "Insert STRINGS at point, stripping some text properties. 1305 "Insert STRINGS at point, stripping some text properties.
1281Strip text properties from the inserted text 1306Strip text properties from the inserted text
1282according to `yank-excluded-properties'. 1307according to `yank-excluded-properties'.
1283Otherwise just like (insert STRINGS...)." 1308Otherwise just like (insert STRINGS...)."
1284 (let ((opoint (point))) 1309 (let ((opoint (point)))
1285
1286 (apply 'insert strings) 1310 (apply 'insert strings)
1287 1311 (remove-yank-excluded-properties opoint (point))))
1288 (let ((inhibit-read-only t)
1289 (end (point)))
1290
1291 ;; Replace any `category' property with the properties it stands for.
1292 (unless (memq yank-excluded-properties '(t nil))
1293 (save-excursion
1294 (goto-char opoint)
1295 (while (< (point) end)
1296 (let ((cat (get-text-property (point) 'category))
1297 run-end)
1298 (when cat
1299 (setq run-end
1300 (next-single-property-change (point) 'category nil end))
1301 (remove-list-of-text-properties (point) run-end '(category))
1302 (add-text-properties (point) run-end (symbol-plist cat))
1303 (goto-char (or run-end end)))
1304 (setq run-end
1305 (next-single-property-change (point) 'category nil end))
1306 (goto-char (or run-end end))))))
1307
1308 (if (eq yank-excluded-properties t)
1309 (set-text-properties opoint end nil)
1310 (remove-list-of-text-properties opoint end
1311 yank-excluded-properties)))))
1312 1312
1313(defun insert-buffer-substring-no-properties (buf &optional start end) 1313(defun insert-buffer-substring-no-properties (buf &optional start end)
1314 "Insert before point a substring of buffer BUFFER, without text properties. 1314 "Insert before point a substring of buffer BUFFER, without text properties.
@@ -1328,11 +1328,7 @@ beginning and the end of BUFFER. Strip text properties from the
1328inserted text according to `yank-excluded-properties'." 1328inserted text according to `yank-excluded-properties'."
1329 (let ((opoint (point))) 1329 (let ((opoint (point)))
1330 (insert-buffer-substring buf start end) 1330 (insert-buffer-substring buf start end)
1331 (let ((inhibit-read-only t)) 1331 (remove-yank-excluded-properties opoint (point))))
1332 (if (eq yank-excluded-properties t)
1333 (set-text-properties opoint (point) nil)
1334 (remove-list-of-text-properties opoint (point)
1335 yank-excluded-properties)))))
1336 1332
1337 1333
1338;; Synchronous shell commands. 1334;; Synchronous shell commands.