Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-props.el @ 136:b980b6286996 r20-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b2
author cvs
date Mon, 13 Aug 2007 09:31:12 +0200
parents
children 6608ceec7cf8
comparison
equal deleted inserted replaced
135:4636a6841cd6 136:b980b6286996
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)