|
136
|
1 ;;; w3-props.el --- Additional text property stuff
|
|
|
2 ;; Author: wmperry
|
|
|
3 ;; Created: 1997/04/20 19:19:14
|
|
|
4 ;; Version: 1.1
|
|
|
5 ;; Keywords: faces
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
|
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
|
|
|
10 ;;;
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12 ;;;
|
|
|
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
14 ;;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;;; any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;;; Boston, MA 02111-1307, USA.
|
|
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28
|
|
|
29 ;;; Additional text property functions.
|
|
|
30
|
|
|
31 ;; The following three text property functions are not generally available (and
|
|
|
32 ;; it's not certain that they should be) so they are inlined for speed.
|
|
|
33 ;; The case for `fillin-text-property' is simple; it may or not be generally
|
|
|
34 ;; useful. (Since it is used here, it is useful in at least one place.;-)
|
|
|
35 ;; However, the case for `append-text-property' and `prepend-text-property' is
|
|
|
36 ;; more complicated. Should they remove duplicate property values or not? If
|
|
|
37 ;; so, should the first or last duplicate item remain? Or the one that was
|
|
|
38 ;; added? In our implementation, the first duplicate remains.
|
|
|
39
|
|
|
40 (defsubst fillin-text-property (start end setprop markprop value &optional object)
|
|
|
41 "Fill in one property of the text from START to END.
|
|
|
42 Arguments PROP and VALUE specify the property and value to put where none are
|
|
|
43 already in place. Therefore existing property values are not overwritten.
|
|
|
44 Optional argument OBJECT is the string or buffer containing the text."
|
|
|
45 (let ((start (text-property-any start end markprop nil object)) next)
|
|
|
46 (while start
|
|
|
47 (setq next (next-single-property-change start markprop object end))
|
|
|
48 (put-text-property start next setprop value object)
|
|
|
49 (put-text-property start next markprop value object)
|
|
|
50 (setq start (text-property-any next end markprop nil object)))))
|
|
|
51
|
|
|
52 (if (not (fboundp 'unique))
|
|
|
53 (defsubst unique (list)
|
|
|
54 "Uniquify LIST, deleting elements using `delq'.
|
|
|
55 Return the list with subsequent duplicate items removed by side effects."
|
|
|
56 (let ((list list))
|
|
|
57 (while list
|
|
|
58 (setq list (setcdr list (delq (car list) (cdr list))))))
|
|
|
59 list))
|
|
|
60
|
|
|
61 ;; A generalisation of `facemenu-add-face' for any property, but without the
|
|
|
62 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
|
|
|
63 ;; treatment of `default'. Uses `unique' to remove duplicate property values.
|
|
|
64 (defsubst prepend-text-property (start end prop value &optional object)
|
|
|
65 "Prepend to one property of the text from START to END.
|
|
|
66 Arguments PROP and VALUE specify the property and value to prepend to the value
|
|
|
67 already in place. The resulting property values are always lists, and unique.
|
|
|
68 Optional argument OBJECT is the string or buffer containing the text."
|
|
|
69 (let ((val (if (listp value) value (list value))) next prev)
|
|
|
70 (while (/= start end)
|
|
|
71 (setq next (next-single-property-change start prop object end)
|
|
|
72 prev (get-text-property start prop object))
|
|
|
73 (put-text-property
|
|
|
74 start next prop
|
|
|
75 (unique (append val (if (listp prev) prev (list prev))))
|
|
|
76 object)
|
|
|
77 (setq start next))))
|
|
|
78
|
|
|
79 (defsubst append-text-property (start end prop value &optional object)
|
|
|
80 "Append to one property of the text from START to END.
|
|
|
81 Arguments PROP and VALUE specify the property and value to append to the value
|
|
|
82 already in place. The resulting property values are always lists, and unique.
|
|
|
83 Optional argument OBJECT is the string or buffer containing the text."
|
|
|
84 (let ((val (if (listp value) value (list value))) next prev)
|
|
|
85 (while (/= start end)
|
|
|
86 (setq next (next-single-property-change start prop object end)
|
|
|
87 prev (get-text-property start prop object))
|
|
|
88 (put-text-property
|
|
|
89 start next prop
|
|
|
90 (unique (append (if (listp prev) prev (list prev)) val))
|
|
|
91 object)
|
|
|
92 (setq start next))))
|
|
|
93
|
|
|
94 (provide 'w3-props)
|
